4 # Compare two XML files for structural and content equivalence. Used for
10 use XML::NamespaceSupport;
12 package XML::Template;
14 my $parser = XML::DOM::Parser->new;
15 my $d1 = $parser->parsefile($ARGV[0]);
16 my $d2 = $parser->parsefile($ARGV[1]);
17 my $nsup1 = XML::NamespaceSupport->new;
18 my $nsup2 = XML::NamespaceSupport->new;
20 compare($d1, $d2, $nsup1, $nsup2);
23 my ($n1, $n2, $nsup1, $nsup2) = @_;
25 if ($n1->getNodeType != $n2->getNodeType) {
26 printf STDERR "Node types don't match (%u vs. %u)\n",
27 $n1->getNodeType, $n2->getNodeType;
34 if ($n1->getNodeType == XML::DOM::ELEMENT_NODE) {
35 process_namespaces($n1, $nsup1);
36 process_namespaces($n2, $nsup2);
39 my ($nsuri1, undef, $lname1) = $nsup1->process_element_name($n1->getNodeName);
40 my ($nsuri2, undef, $lname2) = $nsup2->process_element_name($n2->getNodeName);
42 # compare element names
43 unless ($nsuri1 eq $nsuri2 && $lname1 eq $lname2) {
44 print STDERR "$nsuri1/$lname1 != $nsuri2/$lname2\n";
49 my $attrs1 = $n1->getAttributes;
50 my $attrs2 = $n2->getAttributes;
52 # this will need some special care, since we ignore xmlns= attributes; defer
53 # to its own function so it's easier to do comparison both ways
54 compare_attr_list($attrs1, $attrs2, $nsup1, $nsup2) if (defined($attrs1));
55 compare_attr_list($attrs2, $attrs1, $nsup2, $nsup1) if (defined($attrs2));
57 # this element is ok, let's compare all children
58 my $c1 = $n1->getChildNodes;
59 my $c2 = $n2->getChildNodes;
61 if ($c1->getLength != $c2->getLength) {
62 print STDERR "$nsuri1/$lname1 has differing number of children\n";
65 for my $i (0..($c1->getLength-1)) {
66 compare($c1->item($i), $c2->item($i), $nsup1, $nsup2);
73 sub process_namespaces {
74 my ($node, $nsup) = @_;
76 my $attrs = $node->getAttributes;
77 return unless defined($attrs);
79 for my $attr ($attrs->getValues) {
80 my $name = $attr->getName;
81 if ($name =~ /^xmlns:(.*)$/) {
82 $nsup->declare_prefix($1, $attr->getValue);
87 sub compare_attr_list {
88 my ($attrs1, $attrs2, $nsup1, $nsup2);
90 for my $attr1 ($attrs1->getValues) {
91 my $name = $attr->getName;
92 next if ($name =~ /^xmlns:(.*)$/);
94 my ($nsuri1, undef, $lname1) = $nsup1->process_attribute_name($n1->getName);
96 if (!defined($attrs2)) {
97 # n2 has no attributes at all
98 print STDERR "Attribute $nsuri1/$lname1 exists on one side but not the other\n";
103 for my $attr2 ($attrs2->getValues) {
104 my ($nsuri2, undef, $lname2) = $nsup2->process_attribute_name($n2->getName);
106 if ($nsuri1 eq $nsuri2 && $lname1 eq $lname2) {
107 $attr2_found = $attr2;
112 if (!defined($attr2_found)) {
113 print STDERR "Attribute $nsuri1/$lname1 exists on one side but not the other\n";
117 if ($attr1->getValue ne $attr2->getValue) {
118 print STDERR "Attribute $nsuri1/$lname1 has differing values\n";