diff -r 000000000000 -r 02cd6b52f378 dummy_foundation/lib/XML/Handler/XMLWriter.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/dummy_foundation/lib/XML/Handler/XMLWriter.pm Thu May 28 10:10:03 2009 +0100 @@ -0,0 +1,313 @@ +# +# Copyright (C) 1999 Ken MacLeod +# Portions derived from code in XML::Writer by David Megginson +# XML::Handler::XMLWriter is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# $Id: XMLWriter.pm,v 1.2 1999/12/22 21:15:00 kmacleod Exp $ +# + +use strict; + +package XML::Handler::XMLWriter; +use XML::Handler::Subs; + +use vars qw{ $VERSION @ISA $escapes }; + +# will be substituted by make-rel script +$VERSION = "0.07"; + +@ISA = qw{ XML::Handler::Subs }; + +$escapes = { '&' => '&', + '<' => '<', + '>' => '>', + '"' => '"' + }; + +sub start_document { + my ($self, $document) = @_; + + $self->SUPER::start_document($document); + + # create a temporary Output_ in case we're creating a standard + # output file that we'll delete later. + if (!$self->{AsString} && !defined($self->{Output})) { + require IO::File; + import IO::File; + $self->{Output_} = new IO::File(">-"); + } elsif (defined($self->{Output})) { + $self->{Output_} = $self->{Output}; + } + + if ($self->{AsString}) { + $self->{Strings} = []; + } + + $self->print("\n"); + + # FIXME support Doctype declarations +} + +sub end_document { + my ($self, $document) = @_; + + if (defined($self->{Output_})) { + $self->{Output_}->print("\n"); + delete $self->{Output_}; + } + + my $string = undef; + if (defined($self->{AsString})) { + push @{$self->{Strings}}, "\n"; + $string = join('', @{$self->{Strings}}); + delete $self->{Strings}; + } + + $self->SUPER::end_document($document); + + return($string); +} + +sub start_element { + my ($self, $element) = @_; + + if ($self->SUPER::start_element($element) == 0) { + $self->print_start_element($element); + } +} + +sub print_start_element { + my ($self, $element) = @_; + + my $output = "<$element->{Name}"; + if (defined($element->{Attributes})) { + foreach my $name (sort keys %{$element->{Attributes}}) { + my $esc_value = $element->{Attributes}{$name}; + $esc_value =~ s/([\&\<\>\"])/$escapes->{$1}/ge; + $output .= " $name=\"$esc_value\""; + } + } + + if ($self->{Newlines}) { + $output .= "\n"; + } + + $output .= ">"; + + $self->print($output); +} + +sub end_element { + my ($self, $element) = @_; + + if ($self->SUPER::end_element($element) == 0) { + $self->print_end_element($element); + } +} + +sub print_end_element { + my ($self, $element) = @_; + + my $output = "{Name}" + . ($self->{Newlines} ? "\n" : "") . ">"; + + $self->print($output); +} +sub characters { + my ($self, $characters) = @_; + + my $output = $characters->{Data}; + + $output =~ s/([\&\<\>])/$escapes->{$1}/ge; + + $self->print($output); +} + +sub processing_instruction { + my ($self, $pi) = @_; + + my $nl = ($#{$self->{Names}} == -1) ? "\n" : ""; + + my $output; + if ($self->{IsSGML}) { + $output = "{Data}>\n"; + } else { + if ($pi->{Data}) { + $output = "{Target} $pi->{Data}?>$nl"; + } else { + $output = "{Target}?>$nl"; + } + } + + $self->print($output); +} + +sub ignorable_whitespace { + my ($self, $whitespace) = @_; + + $self->print($whitespace->{Data}); +} + +sub comment { + my ($self, $comment) = @_; + + my $nl = ($#{$self->{Names}} == -1) ? "\n" : ""; + + my $output = "$nl"; + + $self->print($output); +} + +sub print { + my ($self, $output) = @_; + + $self->{Output_}->print($output) + if (defined($self->{Output_})); + + push(@{$self->{Strings}}, $output) + if (defined($self->{AsString})); +} + +1; + +__END__ + +=head1 NAME + +XML::Handler::XMLWriter - a PerlSAX handler for writing readable XML + +=head1 SYNOPSIS + + use XML::Parser::PerlSAX; + use XML::Handler::XMLWriter; + + $my_handler = XML::Handler::XMLWriter->new( I ); + + XML::Parser::PerlSAX->new->parse(Source => { SystemId => 'REC-xml-19980210.xml' }, + Handler => $my_handler); + +=head1 DESCRIPTION + +C is a PerlSAX handler for writing readable +XML (in contrast to Canonical XML, for example). +XML::Handler::XMLWriter can be used with a parser to reformat XML, +with XML::DOM or XML::Grove to write out XML, or with other PerlSAX +modules that generate events. + +C is intended to be used with PerlSAX event +generators and does not perform any checking itself (for example, +matching start and end element events). If you want to generate XML +directly from your Perl code, use the XML::Writer module. XML::Writer +has an easy to use interface and performs many checks to make sure +that the XML you generate is well-formed. + +C is a subclass of C. +C can be further subclassed to alter it's +behavior or to add element-specific handling. In the subclass, each +time an element starts, a method by that name prefixed with `s_' is +called with the element to be processed. Each time an element ends, a +method with that name prefixed with `e_' is called. Any special +characters in the element name are replaced by underscores. If there +isn't a start or end method for an element, the default action is to +write the start or end tag. Start and end methods can use the +`C' and `C' methods to +print start or end tags. Subclasses can call the `C' method +to write additional output. + +Subclassing XML::Handler::XMLWriter in this way is similar to +XML::Parser's Stream style. + +XML::Handler::Subs maintains a stack of element names, +`C<$self->{Names}', and a stack of element nodes, `C<$self->{Nodes}>' +that can be used by subclasses. The current element is pushed on the +stacks before calling an element-name start method and popped off the +stacks after calling the element-name end method. + +See XML::Handler::Subs for additional methods. + +In addition to the standard PerlSAX handler methods (see PerlSAX for +descriptions), XML::Handler::XMLWriter supports the following methods: + +=over 4 + +=item new( I ) + +Creates and returns a new instance of XML::Handler::XMLWriter with the +given I. Options may be changed at any time by modifying +them directly in the hash returned. I can be a list of key, +value pairs or a hash. The following I are supported: + +=over 4 + +=item Output + +An IO::Handle or one of it's subclasses (such as IO::File), if this +parameter is not present and the AsString option is not used, the +module will write to standard output. + +=item AsString + +Return the generated XML as a string from the `C' method of +the PerlSAX event generator. + +=item Newlines + +A true or false value; if this parameter is present and its value is +true, then the module will insert an extra newline before the closing +delimiter of start, end, and empty tags to guarantee that the document +does not end up as a single, long line. If the paramter is not +present, the module will not insert the newlines. + +=item IsSGML + +A true or false value; if this parameter is present and its value is +true, then the module will generate SGML rather than XML. + +=back + +=item print_start_element($element) + +Print a start tag for `C<$element>'. This is the default action for +the PerlSAX `C' handler, but subclasses may use this +if they define a start method for an element. + +=item print_end_element($element) + +Prints an end tag for `C<$element>'. This is the default action for +the PerlSAX `C' handler, but subclasses may use this +if they define a start method for an element. + +=item print($output) + +Write `C<$output>' to Output and/or append it to the string to be +returned. Subclasses may use this to write additional output. + +=back + +=head1 TODO + +=over 4 + +=item * + +An Elements option that provides finer control over newlines than the +Newlines option, where you can choose before and after newline for +element start and end tags. Inspired by the Python XMLWriter. + +=item * + +Support Doctype and XML declarations. + +=back + +=head1 AUTHOR + +Ken MacLeod, ken@bitsko.slc.ut.us +This module is partially derived from XML::Writer by David Megginson. + +=head1 SEE ALSO + +perl(1), PerlSAX.pod(3) + +=cut