SGMLS::Output - Stack-based Output Procedures

SGMLSpm documentation Contained in the SGMLSpm distribution.

Index

Code Index:

NAME

Top

SGMLS::Output - Stack-based Output Procedures

SYNOPSIS

Top

  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 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();

DESCRIPTION

Top

This library allows redirectable, stack-based output to files, pipes, handles, strings, or nul. It is especially useful for packages like SGMLS, since handlers for individual 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 output (such as CDATA) will be accumulated in the string returned from 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.

AUTHOR AND COPYRIGHT

Top

Copyright 1994 and 1995 by David Megginson, dmeggins@aix1.uottawa.ca. Distributed under the terms of the Gnu General Public License (version 2, 1991) -- see the file COPYING which is included in the SGMLS.pm distribution.

SEE ALSO:

Top

SGMLS.

SGMLSpm documentation Contained in the SGMLSpm distribution. 
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 $';


#
# 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;