1#!/usr/local/bin/perl -w 2# 3# Copyright 1999 Clark Cooper <coopercc@netheaven.com> 4# All rights reserved. 5# 6# This program is free software; you can redistribute it and/or 7# modify it under the same terms as Perl itself. 8# 9# $Revision: 1.1.1.1 $ 10# 11# $Date: 2003/07/27 11:07:11 $ 12# 13# This program take an XML document (either on standard input or 14# from a filename supplied as an argument) and generates corresponding 15# canonical XML document on the standard output. The definition of 16# "Canonical XML" that I'm using is taken from the working draft 17# published by W3C on 19-Jan-2000: 18# 19# http://www.w3.org/TR/2000/WD-xml-c14n-20000119.html 20# 21# The latest version of this document is at: 22# 23# http://www.w3.org/TR/xml-c14n 24# 25 26use XML::Parser; 27 28my $indoctype = 0; 29my $inroot = 0; 30my $p = new XML::Parser(ErrorContext => 2, 31 Namespaces => 1, 32 ParseParamEnt => 1, 33 Handlers => {Start => \&sthndl, 34 End => \&endhndl, 35 Char => \&chrhndl, 36 Proc => \&proc, 37 Doctype => sub {$indoctype = 1}, 38 DoctypeFin => sub {$indoctype = 0} 39 } 40 ); 41 42my $file = shift; 43if (defined $file) { 44 $p->parsefile($file); 45} 46else { 47 $p->parse(*STDIN); 48} 49 50################ 51## End main 52################ 53 54sub sthndl { 55 my $xp = shift; 56 my $el = shift; 57 58 $inroot = 1 unless $inroot; 59 my $ns_index = 1; 60 61 my $elns = $xp->namespace($el); 62 if (defined $elns) { 63 my $pfx = 'n' . $ns_index++; 64 print "<$pfx:$el xmlns:$pfx=\"$elns\""; 65 } 66 else { 67 print "<$el"; 68 } 69 70 if (@_) { 71 for (my $i = 0; $i < @_; $i += 2) { 72 my $nm = $_[$i]; 73 my $ns = $xp->namespace($nm); 74 $_[$i] = defined($ns) ? "$ns\01$nm" : "\01$nm"; 75 } 76 77 my %atts = @_; 78 my @ids = sort keys %atts; 79 foreach my $id (@ids) { 80 my ($ns, $nm) = split(/\01/, $id); 81 my $val = $xp->xml_escape($atts{$id}, '"', "\x9", "\xA", "\xD"); 82 if (length($ns)) { 83 my $pfx = 'n' . $ns_index++; 84 print " $pfx:$nm=\"$val\" xmlns:$pfx=\"$ns\""; 85 } 86 else { 87 print " $nm=\"$val\""; 88 } 89 } 90 } 91 92 print '>'; 93} # End sthndl 94 95sub endhndl { 96 my ($xp, $el) = @_; 97 98 my $nm = $xp->namespace($el) ? "n1:$el" : $el; 99 print "</$nm>"; 100 if ($xp->depth == 0) { 101 $inroot = 0; 102 print "\n"; 103 } 104} # End endhndl 105 106sub chrhndl { 107 my ($xp, $data) = @_; 108 109 print $xp->xml_escape($data, '>', "\xD"); 110} # End chrhndl 111 112sub proc { 113 my ($xp, $target, $data) = @_; 114 115 unless ($indoctype) { 116 print "<?$target $data?>"; 117 print "\n" unless $inroot; 118 } 119} 120 121# Tell emacs that this is really a perl script 122#Local Variables: 123#Mode: perl 124#End: 125