dummy_foundation/lib/XML/Handler/CanonXMLWriter.pm
changeset 0 02cd6b52f378
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/dummy_foundation/lib/XML/Handler/CanonXMLWriter.pm	Thu May 28 10:10:03 2009 +0100
@@ -0,0 +1,180 @@
+#
+# Copyright (C) 1998, 1999 Ken MacLeod
+# XML::Handler::CanonXMLWriter is free software; you can redistribute
+# it and/or modify it under the same terms as Perl itself.
+#
+# $Id: CanonXMLWriter.pm,v 1.2 1999/12/22 21:15:00 kmacleod Exp $
+#
+
+use strict;
+
+package XML::Handler::CanonXMLWriter;
+use vars qw{ $VERSION %char_entities };
+
+# will be substituted by make-rel script
+$VERSION = "0.07";
+
+%char_entities = (
+    "\x09" => '	',
+    "\x0a" => '
',
+    "\x0d" => '
',
+    '&' => '&',
+    '<' => '&lt;',
+    '>' => '&gt;',
+    '"' => '&quot;',
+);
+
+sub new {
+    my ($class, %args) = @_;
+
+    my $self = \%args;
+    return bless $self, $class;
+}
+
+sub start_document {
+    my $self = shift; my $document = shift;
+
+    $self->{'_text_array'} = [];
+}
+
+sub end_document {
+    my $self = shift; my $document = shift;
+
+    if (defined $self->{IOHandle}) {
+	return ();
+    } else {
+	my $text = join ('', @{$self->{'_text_array'}});
+	undef $self->{'_text_array'};
+	return $text;
+    }
+}
+
+sub start_element {
+    my $self = shift; my $element = shift;
+
+    $self->_print('<' . $element->{Name});
+    my $key;
+    my $attrs = $element->{Attributes};
+    foreach $key (sort keys %$attrs) {
+	$self->_print(" $key=\"" . $self->_escape($attrs->{$key}) . '"');
+    }
+    $self->_print('>');
+}
+
+sub end_element {
+    my $self = shift; my $element = shift;
+
+    $self->_print('</' . $element->{Name} . '>');
+}
+
+sub characters {
+    my $self = shift; my $characters = shift;
+
+    $self->_print($self->_escape($characters->{Data}));
+}
+
+sub ignorable_whitespace {
+    my $self = shift; my $characters = shift;
+
+    $self->_print($self->_escape($characters->{Data}));
+}
+
+sub processing_instruction {
+    my $self = shift; my $pi = shift;
+
+    $self->_print('<?' . $pi->{Target} . ' ' . $pi->{Data} . '?>');
+}
+
+sub entity {
+    # entities don't occur in text
+    return ();
+}
+
+sub comment {
+    my $self = shift; my $comment = shift;
+
+    if ($self->{PrintComments}) {
+	$self->_print('<!--' . $comment->{Data} . '-->');
+    } else {
+	return ();
+    }
+}
+
+sub _print {
+    my $self = shift; my $string = shift;
+
+    if (defined $self->{IOHandle}) {
+	$self->{IOHandle}->print($string);
+	return ();
+    } else {
+	push @{$self->{'_text_array'}}, $string;
+    }
+}
+
+sub _escape {
+    my $self = shift; my $string = shift;
+
+    $string =~ s/([\x09\x0a\x0d&<>"])/$char_entities{$1}/ge;
+    return $string;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+XML::Handler::CanonXMLWriter - output XML in canonical XML format
+
+=head1 SYNOPSIS
+
+ use XML::Handler::CanonXMLWriter;
+
+ $writer = XML::Handler::CanonXMLWriter OPTIONS;
+ $parser->parse(Handler => $writer);
+
+=head1 DESCRIPTION
+
+C<XML::Handler::CanonXMLWriter> is a PerlSAX handler that will return
+a string or write a stream of canonical XML for an XML instance and it's
+content.
+
+C<XML::Handler::CanonXMLWriter> objects hold the options used for
+writing the XML objects.  Options can be supplied when the the object
+is created,
+
+    $writer = new XML::Handler::CanonXMLWriter PrintComments => 1;
+
+or modified at any time before calling the parser's `C<parse()>' method:
+
+    $writer->{PrintComments} = 0;
+
+=head1 OPTIONS
+
+=over 4
+
+=item IOHandle
+
+IOHandle contains a handle for writing the canonical XML to.  If an
+IOHandle is not provided, the canonical XML string will be returned
+from `C<parse()>'.
+
+=item PrintComments
+
+By default comments are not written to the output.  Setting comment to
+a true value will include comments in the output.
+
+=back
+
+=head1 AUTHOR
+
+Ken MacLeod, ken@bitsko.slc.ut.us
+
+=head1 SEE ALSO
+
+perl(1), PerlSAX
+
+James Clark's Canonical XML definition
+<http://www.jclark.com/xml/canonxml.html>
+
+=cut