dummy_foundation/lib/XML/Handler/XMLWriter.pm
changeset 0 02cd6b52f378
--- /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 = { '&' => '&',
+	     '<' => '&lt;',
+	     '>' => '&gt;',
+	     '"' => '&quot;'
+	 };
+
+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("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\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 = "</$element->{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 = "<?$pi->{Data}>\n";
+    } else {
+	if ($pi->{Data}) {
+	    $output = "<?$pi->{Target} $pi->{Data}?>$nl";
+	} else {
+	    $output = "<?$pi->{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 = "<!-- $comment->{Data} -->$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<OPTIONS> );
+
+ XML::Parser::PerlSAX->new->parse(Source => { SystemId => 'REC-xml-19980210.xml' },
+                                  Handler => $my_handler);
+
+=head1 DESCRIPTION
+
+C<XML::Handler::XMLWriter> 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<XML::Handler::XMLWriter> 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<XML::Handler::XMLWriter> is a subclass of C<XML::Handler::Subs>.
+C<XML::Handler::XMLWriter> 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<print_start_element()>' and `C<print_end_element()>' methods to
+print start or end tags.  Subclasses can call the `C<print()>' 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<OPTIONS> )
+
+Creates and returns a new instance of XML::Handler::XMLWriter with the
+given I<OPTIONS>.  Options may be changed at any time by modifying
+them directly in the hash returned.  I<OPTIONS> can be a list of key,
+value pairs or a hash.  The following I<OPTIONS> 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<parse()>' 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<start_element()>' 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<end_element()>' 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