1 #

     2 # Copyright (C) 1998, 1999 Ken MacLeod

     3 # XML::Handler::CanonXMLWriter is free software; you can redistribute

     4 # it and/or modify it under the same terms as Perl itself.

     5 #

     6 # $Id: CanonXMLWriter.pm,v 1.2 1999/12/22 21:15:00 kmacleod Exp $

     7 #

     8 

     9 use strict;

    10 

    11 package XML::Handler::CanonXMLWriter;

    12 use vars qw{ $VERSION %char_entities };

    13 

    14 # will be substituted by make-rel script

    15 $VERSION = "0.07";

    16 

    17 %char_entities = (

    18     "\x09" => '	',

    19     "\x0a" => '
',

    20     "\x0d" => '
',

    21     '&' => '&',

    22     '<' => '&lt;',

    23     '>' => '>',

    24     '"' => '"',

    25 );

    26 

    27 sub new {

    28     my ($class, %args) = @_;

    29 

    30     my $self = \%args;

    31     return bless $self, $class;

    32 }

    33 

    34 sub start_document {

    35     my $self = shift; my $document = shift;

    36 

    37     $self->{'_text_array'} = [];

    38 }

    39 

    40 sub end_document {

    41     my $self = shift; my $document = shift;

    42 

    43     if (defined $self->{IOHandle}) {

    44 	return ();

    45     } else {

    46 	my $text = join ('', @{$self->{'_text_array'}});

    47 	undef $self->{'_text_array'};

    48 	return $text;

    49     }

    50 }

    51 

    52 sub start_element {

    53     my $self = shift; my $element = shift;

    54 

    55     $self->_print('<' . $element->{Name});

    56     my $key;

    57     my $attrs = $element->{Attributes};

    58     foreach $key (sort keys %$attrs) {

    59 	$self->_print(" $key=\"" . $self->_escape($attrs->{$key}) . '"');

    60     }

    61     $self->_print('>');

    62 }

    63 

    64 sub end_element {

    65     my $self = shift; my $element = shift;

    66 

    67     $self->_print('</' . $element->{Name} . '>');

    68 }

    69 

    70 sub characters {

    71     my $self = shift; my $characters = shift;

    72 

    73     $self->_print($self->_escape($characters->{Data}));

    74 }

    75 

    76 sub ignorable_whitespace {

    77     my $self = shift; my $characters = shift;

    78 

    79     $self->_print($self->_escape($characters->{Data}));

    80 }

    81 

    82 sub processing_instruction {

    83     my $self = shift; my $pi = shift;

    84 

    85     $self->_print('<?' . $pi->{Target} . ' ' . $pi->{Data} . '?>');

    86 }

    87 

    88 sub entity {

    89     # entities don't occur in text

    90     return ();

    91 }

    92 

    93 sub comment {

    94     my $self = shift; my $comment = shift;

    95 

    96     if ($self->{PrintComments}) {

    97 	$self->_print('<!--' . $comment->{Data} . '-->');

    98     } else {

    99 	return ();

   100     }

   101 }

   102 

   103 sub _print {

   104     my $self = shift; my $string = shift;

   105 

   106     if (defined $self->{IOHandle}) {

   107 	$self->{IOHandle}->print($string);

   108 	return ();

   109     } else {

   110 	push @{$self->{'_text_array'}}, $string;

   111     }

   112 }

   113 

   114 sub _escape {

   115     my $self = shift; my $string = shift;

   116 

   117     $string =~ s/([\x09\x0a\x0d&<>"])/$char_entities{$1}/ge;

   118     return $string;

   119 }

   120 

   121 1;

   122 

   123 __END__

   124 

   125 =head1 NAME

   126 

   127 XML::Handler::CanonXMLWriter - output XML in canonical XML format

   128 

   129 =head1 SYNOPSIS

   130 

   131  use XML::Handler::CanonXMLWriter;

   132 

   133  $writer = XML::Handler::CanonXMLWriter OPTIONS;

   134  $parser->parse(Handler => $writer);

   135 

   136 =head1 DESCRIPTION

   137 

   138 C<XML::Handler::CanonXMLWriter> is a PerlSAX handler that will return

   139 a string or write a stream of canonical XML for an XML instance and it's

   140 content.

   141 

   142 C<XML::Handler::CanonXMLWriter> objects hold the options used for

   143 writing the XML objects.  Options can be supplied when the the object

   144 is created,

   145 

   146     $writer = new XML::Handler::CanonXMLWriter PrintComments => 1;

   147 

   148 or modified at any time before calling the parser's `C<parse()>' method:

   149 

   150     $writer->{PrintComments} = 0;

   151 

   152 =head1 OPTIONS

   153 

   154 =over 4

   155 

   156 =item IOHandle

   157 

   158 IOHandle contains a handle for writing the canonical XML to.  If an

   159 IOHandle is not provided, the canonical XML string will be returned

   160 from `C<parse()>'.

   161 

   162 =item PrintComments

   163 

   164 By default comments are not written to the output.  Setting comment to

   165 a true value will include comments in the output.

   166 

   167 =back

   168 

   169 =head1 AUTHOR

   170 

   171 Ken MacLeod, ken@bitsko.slc.ut.us

   172 

   173 =head1 SEE ALSO

   174 

   175 perl(1), PerlSAX

   176 

   177 James Clark's Canonical XML definition

   178 <http://www.jclark.com/xml/canonxml.html>

   179 

   180 =cut