#
# Copyright (C) 1998, 1999 Ken MacLeod
# XML::Grove::AsCanonXML is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# $Id: AsCanonXML.pm,v 1.6 1999/08/17 18:36:20 kmacleod Exp $
#
use strict;
package XML::Grove::AsCanonXML;
use vars qw{%char_entities};
use Data::Grove::Visitor;
%char_entities = (
"\x09" => ' ',
"\x0a" => '
',
"\x0d" => '
',
'&' => '&',
'<' => '<',
'>' => '>',
'"' => '"',
);
sub new {
my $class = shift;
my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
return bless $self, $class;
}
sub as_canon_xml {
my $self = shift; my $object = shift; my $fh = shift;
if (defined $fh) {
return ();
} else {
return join('', $object->accept($self, $fh));
}
}
sub visit_document {
my $self = shift; my $document = shift;
return $document->children_accept($self, @_);
}
sub visit_element {
my $self = shift; my $element = shift; my $fh = shift;
my @return;
push @return, $self->_print($fh, '<' . $element->{Name});
my $key;
my $attrs = $element->{Attributes};
foreach $key (sort keys %$attrs) {
push @return, $self->_print($fh,
" $key=\"" . $self->_escape($attrs->{$key}) . '"');
}
push @return, $self->_print($fh, '>');
push @return, $element->children_accept($self, $fh, @_);
push @return, $self->_print($fh, '{Name} . '>');
return @return;
}
sub visit_entity {
# entities don't occur in text
return ();
}
sub visit_pi {
my $self = shift; my $pi = shift; my $fh = shift;
return $self->_print($fh, '{Target} . ' ' . $pi->{Data} . '?>');
}
sub visit_comment {
my $self = shift; my $comment = shift; my $fh = shift;
if ($self->{Comments}) {
return $self->_print($fh, '');
} else {
return ();
}
}
sub visit_characters {
my $self = shift; my $characters = shift; my $fh = shift;
return ($self->_print($fh, $self->_escape($characters->{Data})));
}
sub _print {
my $self = shift; my $fh = shift; my $string = shift;
if (defined $fh) {
$fh->print($string);
return ();
} else {
return ($string);
}
}
sub _escape {
my $self = shift; my $string = shift;
$string =~ s/([\x09\x0a\x0d&<>"])/$char_entities{$1}/ge;
return $string;
}
package XML::Grove;
sub as_canon_xml {
my $xml_object = shift;
return XML::Grove::AsCanonXML->new(@_)->as_canon_xml($xml_object);
}
1;
__END__
=head1 NAME
XML::Grove::AsCanonXML - output XML objects in canonical XML
=head1 SYNOPSIS
use XML::Grove::AsCanonXML;
# Using as_canon_xml method on XML::Grove objects:
$string = $xml_object->as_canon_xml( OPTIONS );
# Using an XML::Grove::AsCanonXML instance:
$writer = XML::Grove::AsCanonXML->new( OPTIONS );
$string = $writer->as_canon_xml($xml_object);
$writer->as_canon_xml($xml_object, $file_handle);
=head1 DESCRIPTION
C will return a string or write a stream of
canonical XML for an XML object and it's content (if any).
C objects hold the options used for writing
the XML objects. Options can be supplied when the the object is
created,
$writer = XML::Grove::AsCanonXML->new( Comments => 1 );
or modified at any time before writing an XML object by setting the
option directly in the `C<$writer>' hash.
=head1 OPTIONS
=over 4
=item Comments
By default comments are not written to the output. Setting comment to
TRUE will include comments in the output.
=back
=head1 AUTHOR
Ken MacLeod, ken@bitsko.slc.ut.us
=head1 SEE ALSO
perl(1), XML::Parser(3), XML::Grove(3).
James Clark's Canonical XML definition
=cut