deprecated/buildtools/buildsystemtools/lib/XML/Handler/CanonXMLWriter.pm
author lorewang
Wed, 17 Nov 2010 11:24:29 +0800
changeset 685 39f7ecf8fbc7
parent 655 3f65fd25dfd4
permissions -rw-r--r--
pull from trunk
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
655
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     1
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     2
# Copyright (C) 1998, 1999 Ken MacLeod
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     3
# XML::Handler::CanonXMLWriter is free software; you can redistribute
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     4
# it and/or modify it under the same terms as Perl itself.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     5
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     6
# $Id: CanonXMLWriter.pm,v 1.2 1999/12/22 21:15:00 kmacleod Exp $
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     7
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     8
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     9
use strict;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    10
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    11
package XML::Handler::CanonXMLWriter;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    12
use vars qw{ $VERSION %char_entities };
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    13
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    14
# will be substituted by make-rel script
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    15
$VERSION = "0.07";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    16
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    17
%char_entities = (
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    18
    "\x09" => '	',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    19
    "\x0a" => '
',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    20
    "\x0d" => '
',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    21
    '&' => '&',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    22
    '<' => '&lt;',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    23
    '>' => '&gt;',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    24
    '"' => '&quot;',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    25
);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    26
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    27
sub new {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    28
    my ($class, %args) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    29
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    30
    my $self = \%args;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    31
    return bless $self, $class;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    32
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    33
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    34
sub start_document {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    35
    my $self = shift; my $document = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    36
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    37
    $self->{'_text_array'} = [];
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    38
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    39
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    40
sub end_document {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    41
    my $self = shift; my $document = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    42
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    43
    if (defined $self->{IOHandle}) {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    44
	return ();
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    45
    } else {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    46
	my $text = join ('', @{$self->{'_text_array'}});
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    47
	undef $self->{'_text_array'};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    48
	return $text;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    49
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    50
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    51
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    52
sub start_element {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    53
    my $self = shift; my $element = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    54
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    55
    $self->_print('<' . $element->{Name});
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    56
    my $key;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    57
    my $attrs = $element->{Attributes};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    58
    foreach $key (sort keys %$attrs) {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    59
	$self->_print(" $key=\"" . $self->_escape($attrs->{$key}) . '"');
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    60
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    61
    $self->_print('>');
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    62
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    63
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    64
sub end_element {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    65
    my $self = shift; my $element = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    66
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    67
    $self->_print('</' . $element->{Name} . '>');
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    68
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    69
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    70
sub characters {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    71
    my $self = shift; my $characters = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    72
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    73
    $self->_print($self->_escape($characters->{Data}));
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    74
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    75
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    76
sub ignorable_whitespace {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    77
    my $self = shift; my $characters = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    78
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    79
    $self->_print($self->_escape($characters->{Data}));
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    80
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    81
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    82
sub processing_instruction {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    83
    my $self = shift; my $pi = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    84
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    85
    $self->_print('<?' . $pi->{Target} . ' ' . $pi->{Data} . '?>');
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    86
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    87
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    88
sub entity {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    89
    # entities don't occur in text
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    90
    return ();
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    91
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    92
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    93
sub comment {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    94
    my $self = shift; my $comment = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    95
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    96
    if ($self->{PrintComments}) {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    97
	$self->_print('<!--' . $comment->{Data} . '-->');
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    98
    } else {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    99
	return ();
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   100
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   101
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   102
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   103
sub _print {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   104
    my $self = shift; my $string = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   105
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   106
    if (defined $self->{IOHandle}) {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   107
	$self->{IOHandle}->print($string);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   108
	return ();
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   109
    } else {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   110
	push @{$self->{'_text_array'}}, $string;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   111
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   112
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   113
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   114
sub _escape {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   115
    my $self = shift; my $string = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   116
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   117
    $string =~ s/([\x09\x0a\x0d&<>"])/$char_entities{$1}/ge;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   118
    return $string;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   119
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   120
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   121
1;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   122
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   123
__END__
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   124
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   125
=head1 NAME
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   126
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   127
XML::Handler::CanonXMLWriter - output XML in canonical XML format
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   128
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   129
=head1 SYNOPSIS
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   130
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   131
 use XML::Handler::CanonXMLWriter;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   132
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   133
 $writer = XML::Handler::CanonXMLWriter OPTIONS;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   134
 $parser->parse(Handler => $writer);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   135
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   136
=head1 DESCRIPTION
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   137
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   138
C<XML::Handler::CanonXMLWriter> is a PerlSAX handler that will return
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   139
a string or write a stream of canonical XML for an XML instance and it's
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   140
content.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   141
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   142
C<XML::Handler::CanonXMLWriter> objects hold the options used for
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   143
writing the XML objects.  Options can be supplied when the the object
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   144
is created,
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   145
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   146
    $writer = new XML::Handler::CanonXMLWriter PrintComments => 1;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   147
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   148
or modified at any time before calling the parser's `C<parse()>' method:
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   149
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   150
    $writer->{PrintComments} = 0;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   151
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   152
=head1 OPTIONS
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   153
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   154
=over 4
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   155
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   156
=item IOHandle
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   157
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   158
IOHandle contains a handle for writing the canonical XML to.  If an
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   159
IOHandle is not provided, the canonical XML string will be returned
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   160
from `C<parse()>'.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   161
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   162
=item PrintComments
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   163
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   164
By default comments are not written to the output.  Setting comment to
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   165
a true value will include comments in the output.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   166
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   167
=back
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   168
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   169
=head1 AUTHOR
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   170
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   171
Ken MacLeod, ken@bitsko.slc.ut.us
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   172
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   173
=head1 SEE ALSO
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   174
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   175
perl(1), PerlSAX
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   176
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   177
James Clark's Canonical XML definition
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   178
<http://www.jclark.com/xml/canonxml.html>
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   179
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   180
=cut