git.sesse.net Git - xml-template/blob - tests/xml-diff.pl

   1 #! /usr/bin/perl
   2
   3 #
   4 # Compare two XML files for structural and content equivalence. Used for
   5 # regression testing.
   6 #
   7
   8 use XML::DOM;
   9 use XML::Parser;
  10 use XML::NamespaceSupport;
  11 use Scalar::Util;
  12 package XML::Template;
  13
  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;
  19
  20 compare($d1, $d2, $nsup1, $nsup2);
  21
  22 sub compare {
  23         my ($n1, $n2, $nsup1, $nsup2) = @_;
  24
  25         if ($n1->getNodeType != $n2->getNodeType) {
  26                 printf STDERR "Node types don't match (%u vs. %u)\n",
  27                         $n1->getNodeType, $n2->getNodeType);
  28                 exit(1);
  29         }
  30
  31         $nsup1->push_context;
  32         $nsup2->push_context;
  33
  34         if ($n1->getNodeType == XML::DOM::ELEMENT_NODE) {
  35                 process_namespaces($n1, $nsup1);
  36                 process_namespaces($n2, $nsup2);
  37         }
  38
  39         my ($nsuri1, undef, $lname1) = $nsup1->process_element_name($n1->getNodeName);
  40         my ($nsuri2, undef, $lname2) = $nsup2->process_element_name($n2->getNodeName);
  41
  42         # compare element names
  43         unless ($nsuri1 eq $nsuri2 && $lname1 eq $lname2) {
  44                 print STDERR "$nsuri1/$lname1 != $nsuri2/$lname2\n";
  45                 exit(1);
  46         }
  47
  48         # compare attributes
  49         my $attrs1 = $n1->getAttributes;
  50         my $attrs2 = $n2->getAttributes;
  51
  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));
  56
  57         # this element is ok, let's compare all children
  58         my $c1 = $n1->getChildNodes;
  59         my $c2 = $n2->getChildNodes;
  60
  61         if ($c1->getLength != $c2->getLength) {
  62                 print STDERR "$nsuri1/$lname1 has differing number of children\n";
  63         }
  64
  65         for my $i (0..($c1->getLength-1)) {
  66                 compare($c1->item($i), $c2->item($i), $nsup1, $nsup2);
  67         }
  68
  69         $nsup1->pop_context;
  70         $nsup2->pop_context;
  71 }
  72
  73 sub process_namespaces {
  74         my ($node, $nsup) = @_;
  75
  76         my $attrs = $node->getAttributes;
  77         return unless defined($attrs);
  78
  79         for my $attr ($attrs->getValues) {
  80                 my $name = $attr->getName;
  81                 if ($name =~ /^xmlns:(.*)$/) {
  82                         $nsup->declare_prefix($1, $attr->getValue);
  83                 }
  84         }
  85 }
  86
  87 sub compare_attr_list {
  88         my ($attrs1, $attrs2, $nsup1, $nsup2);
  89
  90         for my $attr1 ($attrs1->getValues) {
  91                 my $name = $attr->getName;
  92                 next if ($name =~ /^xmlns:(.*)$/);
  93
  94                 my ($nsuri1, undef, $lname1) = $nsup1->process_attribute_name($n1->getName);
  95
  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";
  99                         exit(1);
 100                 }
 101
 102                 my $attr2_found;
 103                 for my $attr2 ($attrs2->getValues) {
 104                         my ($nsuri2, undef, $lname2) = $nsup2->process_attribute_name($n2->getName);
 105
 106                         if ($nsuri1 eq $nsuri2 && $lname1 eq $lname2) {
 107                                 $attr2_found = $attr2;
 108                                 last;
 109                         }
 110                 }
 111
 112                 if (!defined($attr2_found)) {
 113                         print STDERR "Attribute $nsuri1/$lname1 exists on one side but not the other\n";
 114                         last;
 115                 }
 116
 117                 if ($attr1->getValue ne $attr2->getValue) {
 118                         print STDERR "Attribute $nsuri1/$lname1 has differing values\n";
 119                 }
 120         }
 121 }