summaryrefslogtreecommitdiff
path: root/info/examples/lwc/ch7/SGMLS/Output.pm
diff options
context:
space:
mode:
Diffstat (limited to 'info/examples/lwc/ch7/SGMLS/Output.pm')
-rw-r--r--info/examples/lwc/ch7/SGMLS/Output.pm225
1 files changed, 225 insertions, 0 deletions
diff --git a/info/examples/lwc/ch7/SGMLS/Output.pm b/info/examples/lwc/ch7/SGMLS/Output.pm
new file mode 100644
index 0000000000..4758bfa80f
--- /dev/null
+++ b/info/examples/lwc/ch7/SGMLS/Output.pm
@@ -0,0 +1,225 @@
+package SGMLS::Output;
+use Carp;
+
+use Exporter;
+@ISA = Exporter;
+@EXPORT = qw(output push_output pop_output);
+
+$version = '$Id: Output.pm,v 1.6 1995/12/05 12:21:51 david Exp $';
+
+=head1 NAME
+
+SGMLS::Output - Stack-based Output Procedures
+
+=head1 SYNOPSIS
+
+ use SGMLS::Output;
+
+To print a string to the current output destination:
+
+ output($data);
+
+To push a new output level to the filehandle DATA:
+
+ push_output('handle',DATA);
+
+To push a new output level to the file "foo.data" (which will be
+opened and closed automatically):
+
+ push_output('file','foo.data');
+
+To push a new output level to a pipe to the shell command "sort":
+
+ push_output('pipe','sort');
+
+To push a new output level I<appending> to the file "foo.data":
+
+ push_output('append','foo.data');
+
+To push a new output level to an empty string:
+
+ push_output('string');
+
+To push a new output level appending to the string "David is ":
+
+ push_output('string',"David is ");
+
+To push a new output level to The Great Beyond:
+
+ push_output('nul');
+
+To revert to the previous output level:
+
+ pop_output();
+
+To revert to the previous output level, returning the contents of an
+output string:
+
+ $data = pop_output();
+
+=head1 DESCRIPTION
+
+This library allows redirectable, stack-based output to files, pipes,
+handles, strings, or nul. It is especially useful for packages like
+L<SGMLS>, since handlers for individual B<SGML> elements can
+temporarily change and restore the default output destination. It is
+also particularly useful for capturing the contents of an element (and
+its sub-elements) in a string.
+
+Example:
+
+ sgmls('<title>', sub{ push_output('string'); });
+ sgmls('</title>', sub{ $title = pop_output(); });
+
+In between, anything sent to B<output> (such as CDATA) will be
+accumulated in the string returned from B<pop_output()>.
+
+Example:
+
+ sgmls('<tei.header>', sub { push_output('nul'); });
+ sgmls('</tei.header>', sub { pop_output(); });
+
+All output will be ignored until the header has finished.
+
+
+=head1 AUTHOR AND COPYRIGHT
+
+Copyright 1994 and 1995 by David Megginson,
+C<dmeggins@aix1.uottawa.ca>. Distributed under the terms of the Gnu
+General Public License (version 2, 1991) -- see the file C<COPYING>
+which is included in the B<SGMLS.pm> distribution.
+
+
+=head1 SEE ALSO:
+
+L<SGMLS>.
+
+=cut
+
+#
+# Anonymous subroutines for handling different types of references.
+#
+$output_handle_sub = sub {
+ print $current_output_data @_;
+};
+
+$output_file_sub = sub {
+ print $current_output_data @_;
+};
+
+$output_string_sub = sub {
+ $current_output_data .= shift;
+ foreach (@_) {
+ $current_output_data .= $, . $_;
+ }
+ $current_output_data .= $\;
+};
+
+$output_nul_sub = sub {};
+
+#
+# Status variables
+#
+$current_output_type = 'handle';
+$current_output_data = STDOUT;
+$current_output_sub = $output_handle_sub;
+@output_stack = qw();
+
+#
+# Externally-visible functions
+#
+
+ # Send data to the output.
+sub output {
+ &{$current_output_sub}(@_);
+}
+
+ # Push a new output destination.
+sub push_output {
+ my ($type,$data) = @_;
+ push @output_stack, [$current_output_type,$current_output_data,
+ $current_output_sub];
+ SWITCH: {
+ $type eq 'handle' && do {
+ # Force unqualified filehandles into caller's package
+ my ($package) = caller;
+ $data =~ s/^[^':]+$/$package\:\:$&/;
+
+ $current_output_sub = $output_handle_sub;
+ $current_output_type = 'handle';
+ $current_output_data = $data;
+ last SWITCH;
+ };
+ $type eq 'file' && do {
+ $current_output_sub = $output_file_sub;
+ my $handle = new_handle();
+ open($handle,">$data") || croak "Cannot create file $data.\n";
+ $current_output_type = 'file';
+ $current_output_data = $handle;
+ last SWITCH;
+ };
+ $type eq 'pipe' && do {
+ $current_output_sub = $output_file_sub;
+ my $handle = new_handle();
+ open($handle,"|$data") || croak "Cannot open pipe to $data.\n";
+ $current_output_type = 'file';
+ $current_output_data = $handle;
+ last SWITCH;
+ };
+ $type eq 'append' && do {
+ $current_output_sub = $output_file_sub;
+ my $handle = new_handle();
+ open($handle,">>$data") || croak "Cannot append to file $data.\n";
+ $current_output_type = 'file';
+ $current_output_data = $handle;
+ last SWITCH;
+ };
+ $type eq 'string' && do {
+ $current_output_sub = $output_string_sub;
+ $current_output_type = 'string';
+ $current_output_data = $data;
+ last SWITCH;
+ };
+ $type eq 'nul' && do {
+ $current_output_sub = $output_nul_sub;
+ $current_output_type = 'nul';
+ $current_output_data = '';
+ last SWITCH;
+ };
+ croak "Unknown output type: $type.\n";
+ }
+}
+
+ # Pop the current output destination.
+sub pop_output {
+ my ($old_type,$old_data) = ($current_output_type,$current_output_data);
+ ($current_output_type,$current_output_data,$current_output_sub) =
+ @{pop @output_stack};
+ SWITCH: {
+ $old_type eq 'handle' && do {
+ return $old_data;
+ };
+ $old_type eq 'file' && do {
+ close($old_data);
+ return '';
+ };
+ $old_type eq 'string' && do {
+ return $old_data;
+ };
+ $old_type eq 'nul' && do {
+ return '';
+ };
+ croak "Unknown output type: $type.\n";
+ }
+}
+
+#
+# Local Utility functions.
+#
+$new_handle_counter = 1;
+
+sub new_handle {
+ return "IOHandle" . $new_handle_counter++;
+}
+
+1;