#
# Used by test scripts to compare 2 DOM subtrees.
# 
# Usage:
#
# my $cmp = new CmpDOM;
# $node1->equals ($node2, $cmp) or 
#   print "Difference found! Context:" . $cmp->context . "\n";
#
use strict;

package CmpDOM;

use XML::DOM;
use Carp;

sub new
{
    my %args = (SkipReadOnly => 0, Context => []);
    bless \%args, $_[0];
}

sub pushContext
{
    my ($self, $str) = @_;
    push @{$self->{Context}}, $str;
#print ":: " . $self->context . "\n";
}

sub popContext
{
    pop @{$_[0]->{Context}};
}

sub skipReadOnly
{
    my $self = shift;
    my $prev = $self->{SkipReadOnly};
    if (@_ > 0)
    {
	$self->{SkipReadOnly} = shift;
    }
    $prev;
}

sub sameType
{
    my ($self, $x, $y) = @_;

    return 1 if (ref ($x) eq ref ($y));

    $self->fail ("wrong type " . ref($x) . " != " . ref($y));
}

sub sameReadOnly
{
    my ($self, $x, $y) = @_;
    return 1 if $self->{SkipReadOnly};

    my $result = 1;
    if (not defined $x)
    {
	$result = 0 if defined $y;
    }
    else
    {
	if (not defined $y)
	{
	    $result = 0;
	}
	elsif ($x != $y)
	{
	    $result = 0;
	}
    }
    return 1 if ($result == 1);

    $self->fail ("ReadOnly $x != $y");
}

sub fail
{
    my ($self, $str) = @_;
    $self->pushContext ($str);
    0;
}

sub context
{
    my $self = shift;
    join (", ", @{$self->{Context}});
}

package XML::DOM::NamedNodeMap;

sub equals
{
    my ($self, $other, $cmp) = @_;

    return 0 unless $cmp->sameType ($self, $other);

    # sanity checks
    my $n1 = int (keys %$self);
    my $n2 = int (keys %$other);
    return $cmp->fail("same keys length") unless $n1 == $n2;

    return $cmp->fail("#1 value length") unless ($n1-1 == $self->getLength);
    return $cmp->fail("#2 value length") unless ($n2-1 == $other->getLength);

    my $i = 0;
    my $ov = $other->getValues;
    for my $n (@{$self->getValues})
    {
	$cmp->pushContext ($n->getNodeName);
	return 0 unless $n->equals ($ov->[$i], $cmp);
	$i++;
	$cmp->popContext;
    }
    return 0 unless $cmp->sameReadOnly ($self->isReadOnly,
					$other->isReadOnly);
    1;
}

package XML::DOM::NodeList;

sub equals
{
    my ($self, $other, $cmp) = @_;
    return 0 unless $cmp->sameType ($self, $other);

    return $cmp->fail("wrong length") 
	unless $self->getLength == $other->getLength;

    my $i = 0;
    for my $n (@$self)
    {
	$cmp->pushContext ("[$i]");
	return 0 unless $n->equals ($other->[$i], $cmp);
	$i++;
	$cmp->popContext;
    }
    1;
}

package XML::DOM::Node;

sub get_prop_byname
{
    my ($self, $propname) = @_;
    my $pkg = ref ($self);

    no strict 'refs';
    my $hfields = \ %{"$pkg\::HFIELDS"};
    $self->[$hfields->{$propname}];
}

sub equals
{
    my ($self, $other, $cmp) = @_;
    return 0 unless $cmp->sameType ($self, $other);

    my $hasKids = $self->hasChildNodes;
    return $cmp->fail("hasChildNodes") unless $hasKids == $other->hasChildNodes;

    if ($hasKids)
    {
	$cmp->pushContext ("C");
	return 0 unless $self->[_C]->equals ($other->[_C], $cmp);
	$cmp->popContext;
    }
    return 0 unless $cmp->sameReadOnly ($self->isReadOnly,
					$other->isReadOnly);

    for my $prop (@{$self->getCmpProps})
    {
	$cmp->pushContext ($prop);	
	my $p1 = $self->get_prop_byname ($prop);
	my $p2 = $other->get_prop_byname ($prop);
	if (ref ($p1))
	{
	    return 0 unless $p1->equals ($p2, $cmp);
	}
	elsif (! defined ($p1))
	{
	    return 0 if defined $p2;
	}
	else
	{
	    return $cmp->fail("$p1 !=  $p2") unless $p1 eq $p2;
	}
	$cmp->popContext;
    }
    1;
}

sub getCmpProps
{
    return [];
}

package XML::DOM::Attr;

sub getCmpProps
{
    ['Name', 'Specified'];
}

package XML::DOM::ProcessingInstruction;

sub getCmpProps
{
    ['Target', 'Data'];
}

package XML::DOM::Notation;

sub getCmpProps
{
    return ['Name', 'Base', 'SysId', 'PubId'];
}

package XML::DOM::Entity;

sub getCmpProps
{
    return ['NotationName', 'Parameter', 'Value', 'SysId', 'PubId'];
}

package XML::DOM::EntityReference;

sub getCmpProps
{
    return ['EntityName', 'Parameter'];
}

package XML::DOM::AttDef;

sub getCmpProps
{
    return ['Name', 'Type', 'Required', 'Implied', 'Quote', 'Default', 'Fixed'];
}

package XML::DOM::AttlistDecl;

sub getCmpProps
{
    return ['ElementName', 'A'];
}

package XML::DOM::ElementDecl;

sub getCmpProps
{
    return ['Name', 'Model'];
}

package XML::DOM::Element;

sub getCmpProps
{
    return ['TagName', 'A'];
}

package XML::DOM::CharacterData;

sub getCmpProps
{
    return ['Data'];
}

package XML::DOM::XMLDecl;

sub getCmpProps
{
    return ['Version', 'Encoding', 'Standalone'];
}

package XML::DOM::DocumentType;

sub getCmpProps
{
    return ['Entities', 'Notations', 'Name', 'SysId', 'PubId', 'Internal'];
}

package XML::DOM::Document;

sub getCmpProps
{
    return ['XmlDecl', 'Doctype'];
}

1;