#!/usr/bin/perl
#Copyright Massachusetts Institute of technology, 2003.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium
#This file is PUBLIC DOMAIN.

# XPathCompileTree.pm -- Object definitions for populating an algae parse tree.
# 
# $Id: XPathCompileTree.pm,v 1.11 2005/12/01 14:58:18 eric Exp $

use strict;
package W3C::XML::XPathCompileTree;
use W3C::Util::Exception;
require Exporter;
@W3C::XML::XPathCompileTree::ISA = qw(Exporter);

use vars qw(@EXPORT_OK
	    $DefaultPrecedence $MAX_PREC $LEFT $RIGHT);
@EXPORT_OK = qw($DefaultPrecedence $MAX_PREC $LEFT $RIGHT
		BEFORE_XPATH FIRST_IN_XPATH LAST_IN_XPATH AFTER_XPATH);

use constant BEFORE_XPATH => 1;
use constant FIRST_IN_XPATH => 0;
use constant LAST_IN_XPATH => 2;
use constant AFTER_XPATH => 3;

my $FIRST_IN_XPATH = FIRST_IN_XPATH;

($LEFT, $RIGHT) = (1, 2);
$MAX_PREC = 9;
my $MAX_PREC = $MAX_PREC;
$DefaultPrecedence = {
    '||' => [9, $LEFT],
    '^' => [8, $LEFT],
    '.' => [7, $LEFT],
    '&&' => [7, $LEFT],
    '<' => [5, $LEFT],
    '<=' => [5, $LEFT],
    '>' => [5, $LEFT],
    '>=' => [5, $LEFT],
    '==' => [5, $LEFT],
    '+' => [3, $RIGHT],
    '-' => [3, $RIGHT],
    '*' => [2, $LEFT],
    '/' => [2, $LEFT],
    '!' => [1, $RIGHT],
    NEG => [1, $RIGHT],
};
my $DefaultPrecedence = $DefaultPrecedence;

# Each class corresponds to a production in the XPathParser grammar.

#                    Action
#                    /    \
#        DelayedAction    ImmediateAction _____________________________
#           /     \        |    \     \       \    \     \             \
# TriplesAction  FwRule  Attach Clear Collect Host Flags NamespaceDecl Slurp
#   /     \
# Ask    Assert
@W3C::XML::XPathCompileTree::Test::ISA = qw(W3C::XML::XPathCompileTree::Base);
@W3C::XML::XPathCompileTree::NodeTest::ISA = qw(W3C::XML::XPathCompileTree::Test);
@W3C::XML::XPathCompileTree::AttributeTest::ISA = qw(W3C::XML::XPathCompileTree::Test);

sub main::_defaultPrec {
    my ($ob, %flags) = @_;
    if (!exists $flags{-parentPrec}) {
	$flags{-parentPrec} = $MAX_PREC;
    }
    if (!exists $flags{-precTable}) {
	$flags{-precTable} = $DefaultPrecedence;
	$flags{-parentPrec} = $MAX_PREC+1;
    }
    return ($ob, %flags);
}

# EvalFailure Exceptions
# These exceptions simply imply that the conjunction in which they were called
# fails. Eg, adding 5 to a bNode.

@W3C::XML::SafeEvaluationException::ISA = qw(W3C::Util::Exception);
@W3C::XML::UnsafeEvaluationException::ISA = qw(W3C::Util::Exception);

package W3C::XML::FailureOnTypeException;
@W3C::XML::FailureOnTypeException::ISA = qw(W3C::XML::SafeEvaluationException);
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-expect') if (!exists $self->{-expect});
    $self->missingParm('-got') if (!exists $self->{-got});
    $self->fillInStackTrace;
    return $self;
}

sub getSpecificMessage {return 'Safe failure: expected: '.$_[0]->getExpect.' got: '.$_[0]->getGot();}
sub getExpect {return $_[0]->{-expect}}
sub getGot {return $_[0]->{-got}}

package W3C::XML::ExtensionsNotSupportedException;
@W3C::XML::ExtensionsNotSupportedException::ISA = qw(W3C::XML::UnsafeEvaluationException);
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-uris') if (!exists $self->{-uris});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {
    my ($self) = @_;
    my $uris = $self->getUris;
    my $urisStr = join (', ', map {"<$_>"} @$uris);
    return "Unsafe failure: require unsupported profiles: $urisStr";
}
sub getUris {return $_[0]->{-uris}}

### NodeSet ###
package W3C::XML::XPathCompileTree::NodeSet;
use W3C::Util::Exception;
sub new {
    my ($proto, @nodes) = @_;
    my $class = ref($proto) || $proto;
    my $self = {Nodes => [@nodes], NodeHash => {}};
    bless ($self, $class);
    return $self;
}
sub addNodes {
    my ($self, @nodes) = @_;
    foreach my $node (@nodes) {
	if (!exists $self->{NodeHash}{$node}) {
	    $self->{NodeHash}{$node} = @{$self->{Nodes}};
	    push (@{$self->{Nodes}}, $node);
	}
    }
}
sub getNodes {
    my ($self, $node) = @_;
    return @{$self->{Nodes}};
}
sub toString {
    my ($self, %flags) = @_;
    my @ret = ("[$self:");
    foreach my $node (@{$self->{Nodes}}) {
	push (@ret, '  '.$node->toString(%flags));
    }
    push (@ret, ']');
    return wantarray ? @ret : join ("\n", @ret);
}

### The whole XPath structure ###

package W3C::XML::XPathCompileTree::Base;
use W3C::Util::Exception;
sub new {
    my ($proto, @baseParms) = @_;
    my $class = ref($proto) || $proto;
    $baseParms[0] || &throw();
    my $self = {Parser => $baseParms[0]};
    bless ($self, $class);
    return $self;
}
sub test {
    my ($self, $nodeSet) = @_;
    &throw(new W3C::Util::MethodNotImplementedException(-object => $_[0], -function => 'W3C::XML::XPathCompileTree::Base::test'));
}
sub toString {
    &throw(new W3C::Util::MethodNotImplementedException(-object => $_[0], -function => 'W3C::XML::XPathCompileTree::Base::toString'));
}

package W3C::XML::XPathCompileTree::AbsoluteLocationPath;
@W3C::XML::XPathCompileTree::AbsoluteLocationPath::ISA = qw(W3C::XML::XPathCompileTree::Base);
sub new {
    my ($proto, $pathOpt, @baseParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@baseParms);
    $self->{Path} = $pathOpt;
    return $self;
}
sub test {
    my ($self, $nodeSet) = @_;
    my $ret = new W3C::XML::XPathCompileTree::NodeSet();
    foreach my $startNode ($nodeSet->getNodes()) {
	my $rootNode = $startNode->getDocumentElement()->getParentNode();
	if ($self->{Path}) {
	    my $pathNodes = $self->{Path}->test(new W3C::XML::XPathCompileTree::NodeSet($rootNode));
	    $ret->addNodes($pathNodes->getNodes());
	} else {
	    $ret->addNodes($rootNode);
	}
    }
    return $ret;
}
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    my $pathStr = $self->{Path} ? $self->{Path}->toString(%flags) : '';
    return "/$pathStr";
}

package W3C::XML::XPathCompileTree::Test;
use W3C::Util::Exception;
sub new {
    my ($proto, @baseParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@baseParms);
    return $self;
}

package W3C::XML::XPathCompileTree::RelativeLocationPath;
@W3C::XML::XPathCompileTree::RelativeLocationPath::ISA = qw(W3C::XML::XPathCompileTree::Base);
sub new {
    my ($proto, $rel, $step, @testParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@testParms);
    $self->{Rel} = $rel;
    $self->{Step} = $step;
    return $self;
}
sub test {
    my ($self, $nodeSet) = @_;
    return $self->{Step}->test($self->{Rel}->test($nodeSet));
}
sub create {
    my ($self, $node, $where) = @_;
    my ($ret, $last) = $self->{Rel}->create($node, $where);
    $last = $self->{Step}->create($last, $FIRST_IN_XPATH);
    return ($ret, $last);
}
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{Rel}->toString(%flags).'/'.$self->{Step}->toString(%flags);
}

package W3C::XML::XPathCompileTree::Step;
@W3C::XML::XPathCompileTree::Step::ISA = qw(W3C::XML::XPathCompileTree::Base);
sub new {
    my ($proto, $axis, $test, $predicates, @testParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@testParms);
    $self->{Axis} = $axis;
    $self->{Test} = $test;
    $self->{Predicates} = $predicates;
    return $self;
}
sub test {
    my ($self, $nodeSet) = @_;
    return $self->{Axis}->testWithPredicates($nodeSet, $self->{Test}, $self->{Predicates});
}
sub create {
    my ($self, $node, $where) = @_;
    return $self->{Axis}->createWithPredicates($node, $self->{Test}, $self->{Predicates}, $where);
}
sub assign {
    my ($self, $node, $value) = @_;
    return $self->{Axis}->assignWithPredicates($node, $self->{Test}, $self->{Predicates}, $value);
}
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{Axis}->toString(%flags).'::'.$self->{Test}->toString(%flags).join('', map {'['.$_->toString(%flags).']'} @{$self->{Predicates}});
}

package W3C::XML::XPathCompileTree::AxisSpecifier;
@W3C::XML::XPathCompileTree::AxisSpecifier::ISA = qw(W3C::XML::XPathCompileTree::Base);
@W3C::XML::XPathCompileTree::AncestorAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::AncestorOrSelfAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::AttributeAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::ChildAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::DescendantAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::DescendantOrSelfAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::FollowingAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::FollowingsiblingAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::NamespaceAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::ParentAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::PrecedingAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::PrecedingsiblingAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);
@W3C::XML::XPathCompileTree::SelfAxis::ISA = qw(W3C::XML::XPathCompileTree::AxisSpecifier);

# Return the appropriate subclass of AxisSpecifier
sub factory { # static
    my ($name, $parser) = @_;
    return $name eq 'ancestor' ? new W3C::XML::XPathCompileTree::AncestorAxis($name, $parser) : 
	$name eq 'ancestor-or-self' ? new W3C::XML::XPathCompileTree::AncestorOrSeflAxis($name, $parser) :
	$name eq 'attribute' ? new W3C::XML::XPathCompileTree::AttributeAxis($name, $parser) : 
	$name eq 'child' ? new W3C::XML::XPathCompileTree::ChildAxis($name, $parser) : 
	$name eq 'descendant' ? new W3C::XML::XPathCompileTree::DescendantAxis($name, $parser) : 
	$name eq 'descendant-or-self' ? new W3C::XML::XPathCompileTree::DescendantOrSelfAxis($name, $parser) : 
	$name eq 'following' ? new W3C::XML::XPathCompileTree::FollowingAxis($name, $parser) : 
	$name eq 'following-sibling' ? new W3C::XML::XPathCompileTree::FollowingsiblingAxis($name, $parser) : 
	$name eq 'namespace' ? new W3C::XML::XPathCompileTree::NamespaceAxis($name, $parser) : 
	$name eq 'parent' ? new W3C::XML::XPathCompileTree::ParentAxis($name, $parser) : 
	$name eq 'preceding' ? new W3C::XML::XPathCompileTree::PrecedingAxis($name, $parser) : 
	$name eq 'preceding-sibling' ? new W3C::XML::XPathCompileTree::PrecedingsiblingAxis($name, $parser) : 
	$name eq 'self' ? new W3C::XML::XPathCompileTree::SelfAxis($name, $parser) : 
	&throw (new W3C::Util::Exception(-message => "unknown axis name \"$name\""));
}

sub W3C::XML::XPathCompileTree::AncestorAxis::toString {'ancestor'}
sub W3C::XML::XPathCompileTree::AncestorOrSelfAxis::toString {'ancestor-or-self'}
sub W3C::XML::XPathCompileTree::AttributeAxis::toString {'attribute'}
sub W3C::XML::XPathCompileTree::ChildAxis::toString {'child'}
sub W3C::XML::XPathCompileTree::DescendantAxis::toString {'descendant'}
sub W3C::XML::XPathCompileTree::DescendantOrSelfAxis::toString {'descendant-or-self'}
sub W3C::XML::XPathCompileTree::FollowingAxis::toString {'following'}
sub W3C::XML::XPathCompileTree::FollowingsiblingAxis::toString {'following-sibling'}
sub W3C::XML::XPathCompileTree::NamespaceAxis::toString {'namespace'}
sub W3C::XML::XPathCompileTree::ParentAxis::toString {'parent'}
sub W3C::XML::XPathCompileTree::PrecedingAxis::toString {'preceding'}
sub W3C::XML::XPathCompileTree::PrecedingsiblingAxis::toString {'preceding-sibling'}
sub W3C::XML::XPathCompileTree::SelfAxis::toString {'self'}

sub W3C::XML::XPathCompileTree::ChildAxis::testWithPredicates {
    my ($self, $nodeSet, $test, $predicates) = @_;
    my @startNodes = $nodeSet->getNodes();
    my $ret = new W3C::XML::XPathCompileTree::NodeSet();
    foreach my $startNode (@startNodes) {
	my $ordinal = 0;
      child:
	for (my $childNode = $startNode->getFirstChild(); 
	     $childNode; 
	     $childNode = $childNode->getNextSibling()) {
	    if ($test->testMatches($childNode)) {
		$ordinal++;
		foreach my $predicate (@$predicates) {
		    if (!$predicate->testPredicate($childNode, $ordinal)) {
			next child;
		    }
		}
		$ret->addNodes($childNode);
	    }
	}
    }
    return $ret;
}
sub W3C::XML::XPathCompileTree::ChildAxis::createWithPredicates {
    my ($self, $node, $test, $predicates, $before) = @_;
    my $doc = $node->getOwnerDocument();
    my $element = $test->createNode($doc);
    if ($before) {
	$node->getParentNode->insertBefore($element, $node);
	$before = 0; # nested elements will not be before this one.
    } else {
	if ($node->hasChildNodes()) {
	    $node->insertBefore($element, $node->getFirstChild());
	} else {
	    $node->appendChild($element);
	}
    }
    foreach my $predicate (@$predicates) {
	$predicate->set($element);
    }
    return ($element, $element);
}

sub W3C::XML::XPathCompileTree::AttributeAxis::testWithPredicates {
    my ($self, $nodeSet, $test, $predicates) = @_;
    my @startNodes = $nodeSet->getNodes();
    my $ret = new W3C::XML::XPathCompileTree::NodeSet();
    foreach my $startNode (@startNodes) {
	my $ordinal = 0;
      child:
	if (my $nodeMap = $startNode->getAttributes()) {
	    my $length = $nodeMap->getLength();
	    for (my $i = 0; $i < $length; $i++) {
		my $attribute = $nodeMap->item($i);
		if ($test->testMatches($attribute)) {
		    foreach my $predicate (@$predicates) {
			if (!$predicate->testPredicate($attribute, $ordinal)) {
			    next child;
			}
		    }
		    $ret->addNodes($attribute);
		    $ordinal++;
		}
	    }
	}
    }
    return $ret;
}

sub W3C::XML::XPathCompileTree::AttributeAxis::assignWithPredicates {
    my ($self, $element, $test, $predicates, $value) = @_;
    # Wipe out existing attribute.
    my $nodeMap = $element->getAttributes();
    my $length = $nodeMap->getLength();
    for (my $i = 0; $i < $length; $i++) {
	my $attribute = $nodeMap->item($i);
	if ($test->testMatches($attribute)) {
	    $element->removeAttributeNode($attribute);
	    last;
	}
    }
    my $doc = $element->getOwnerDocument();
    my $attribute = $doc->createAttribute($test->getName(), $value);
    $element->setAttributeNode($attribute);
    return $attribute;
}

sub W3C::XML::XPathCompileTree::DescendantOrSelfAxis::testWithPredicates {
    my ($self, $nodeSet, $test, $predicates) = @_;
    my @startNodes = $nodeSet->getNodes();
    my $ret = new W3C::XML::XPathCompileTree::NodeSet();
    foreach my $startNode (@startNodes) {
	my $ordinal = 0;
	if ($test->isa('W3C::XML::XPathCompileTree::NameTest') || 
	    $test->isa('W3C::XML::XPathCompileTree::NodeType')) {
	    if (($test->isa('W3C::XML::XPathCompileTree::NameTest') && 
		 $test->getName() eq $startNode->getNodeName()) || 
		($test->isa('W3C::XML::XPathCompileTree::NodeType') && 
		 ($test->getType eq 'node' && 
		  $startNode->getNodeType == $startNode->ELEMENT_NODE)) || 
		($test->getType eq 'attribute' && 
		 $startNode->getNodeType == $startNode->ATTRIBUTE_NODE)) {
		foreach my $predicate (@$predicates) {
		    if (!$predicate->testPredicate($startNode, $ordinal)) {
			next;
		    }
		}
		$ret->addNodes($startNode);
		$ordinal++;
	    }
	    for (my $childNode = $startNode->getFirstChild(); 
		 $childNode; 
		 $childNode = $childNode->getNextSibling()) {
		$ret->addNodes($self->testWithPredicates(new W3C::XML::XPathCompileTree::NodeSet($childNode), $test, $predicates)->getNodes());
	    }
	} else {
	    &throw();
	}
    }
    return $ret;
}

package W3C::XML::XPathCompileTree::NodeTest;
@W3C::XML::XPathCompileTree::NodeTest::ISA = qw(W3C::XML::XPathCompileTree::Base);
sub new {
    my ($proto, $value, @testParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@testParms);
    $self->{Value} = $value;
    return $self;
}

@W3C::XML::XPathCompileTree::NameTest::ISA = qw(W3C::XML::XPathCompileTree::NodeTest);
@W3C::XML::XPathCompileTree::NodeType::ISA = qw(W3C::XML::XPathCompileTree::NodeTest);
package W3C::XML::XPathCompileTree::NodeType;use W3C::Util::Exception;
sub createNode {
    my ($self, $doc) = @_;
    return $self->getType eq 'text' ? $doc->createTextNode($self->{Literal}) : 
	die "not implemented";
}
sub testMatches {
    my ($self, $node) = @_;
    return $self->getType eq 'node' ? $node->getNodeType() == $node->ELEMENT_NODE : 
	$self->getType eq 'text' ? $node->getNodeType() == $node->TEXT_NODE : 
	&throw(new W3C::Util::NotImplementedException(-object => $self, -function => $self->getType()));
}

@W3C::XML::XPathCompileTree::PI::ISA = qw(W3C::XML::XPathCompileTree::NodeTest);

package W3C::XML::XPathCompileTree::NameTest;
sub testMatches {
    my ($self, $node) = @_;
    return ($node->getNodeType() == $node->ELEMENT_NODE || $node->getNodeType() == $node->ATTRIBUTE_NODE) && 
	($self->{Value} eq '*' || $self->{Value} eq $node->getNodeName());
}
sub createNode {
    my ($self, $doc) = @_;
    return $doc->createElement($self->getName());
}

sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{Value}
}
sub getName {
    my ($self) = @_;
    return $self->{Value};
}

package W3C::XML::XPathCompileTree::NodeType;
# Note: literal is a departer from XPath used in the XPath creation syntax
sub new {
    my ($proto, $value, $literal, @testParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($value, @testParms);
    $self->{Literal} = $literal;
    return $self;
}
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    my $literalStr = $self->{Literal} ? "\"$self->{Literal}\"" : '';
    return "$self->{Value}($literalStr)";
}
sub getType {
    my ($self) = @_;
    return $self->{Value};
}

package W3C::XML::XPathCompileTree::PrimaryExpr;
@W3C::XML::XPathCompileTree::PrimaryExpr::ISA = qw(W3C::XML::XPathCompileTree::Base);
@W3C::XML::XPathCompileTree::VariableReference::ISA = qw(W3C::XML::XPathCompileTree::PrimaryExpr);
@W3C::XML::XPathCompileTree::Literal::ISA = qw(W3C::XML::XPathCompileTree::PrimaryExpr);
@W3C::XML::XPathCompileTree::Number::ISA = qw(W3C::XML::XPathCompileTree::PrimaryExpr);

sub new {
    my ($proto, $value, @testParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@testParms);
    $self->{Value} = $value;
    return $self;
}
sub get {
    my ($self) = @_;
    return $self->{Value};
}

package W3C::XML::XPathCompileTree::Literal;
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return "\"$self->{Value}\"";
}
sub testPredicate {
    my ($self, $node, $ordinal) = @_;
    return $ordinal eq $self->{Value}-1;
}
sub testConstant {
    my ($self, $node) = @_;
    my $testValue = defined $node->getNodeValue() ? $node->getNodeValue() : $node->getNodeName();
    return $node->getNodeValue() eq $self->{Value};
}

package W3C::XML::XPathCompileTree::Number;
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{Value};
}
sub testPredicate {
    my ($self, $node, $ordinal) = @_;
    return $ordinal == $self->{Value};
}

package W3C::XML::XPathCompileTree::BinaryExpr;
@W3C::XML::XPathCompileTree::BinaryExpr::ISA = qw(W3C::XML::XPathCompileTree::Base);

sub new {
    my ($proto, $l, $r, @testParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@testParms);
    $self->{L} = $l;
    $self->{R} = $r;
    return $self;
}

package W3C::XML::XPathCompileTree::OrExpr;
@W3C::XML::XPathCompileTree::OrExpr::ISA = qw(W3C::XML::XPathCompileTree::BinaryExpr);
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{L}->toString(%flags).' or '.$self->{R}->toString(%flags);
}
sub testPredicate {
    my ($self, $node, $ordinal) = @_;
    return $self->{L}->testPredicate($node, $ordinal) || $self->{R}->testPredicate($node, $ordinal);
}

package W3C::XML::XPathCompileTree::AndExpr;
@W3C::XML::XPathCompileTree::AndExpr::ISA = qw(W3C::XML::XPathCompileTree::BinaryExpr);
sub set {
    my ($self, $node) = @_;
    $self->{L}->set($node);
    return $self->{R}->set($node);
}
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{L}->toString(%flags).' and '.$self->{R}->toString(%flags);
}
sub testPredicate {
    my ($self, $node, $ordinal) = @_;
    return $self->{L}->testPredicate($node, $ordinal) && $self->{R}->testPredicate($node, $ordinal);
}

package W3C::XML::XPathCompileTree::RelationalExpr;
@W3C::XML::XPathCompileTree::RelationalExpr::ISA = qw(W3C::XML::XPathCompileTree::Base);
@W3C::XML::XPathCompileTree::EqExpr::ISA = qw(W3C::XML::XPathCompileTree::RelationalExpr);

sub new {
    my ($proto, $eqExpr, $relExpr, @testParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@testParms);
    $self->{EqExpr} = $eqExpr;
    $self->{RelExpr} = $relExpr;
    return $self;
}
sub set {
    my ($self, $node) = @_;
    return $self->{EqExpr}->assign($node, $self->{RelExpr}->get());
}

package W3C::XML::XPathCompileTree::EqExpr;
sub toString {
    my ($self, %flags) = &main::_defaultPrec(@_);
    return $self->{EqExpr}->toString(%flags).'='.$self->{RelExpr}->toString(%flags);
}
sub testPredicate {
    my ($self, $node, $ordinal) = @_;
    foreach my $checkMe ($self->{EqExpr}->test(new W3C::XML::XPathCompileTree::NodeSet($node))->getNodes()) {
	if ($self->{RelExpr}->testConstant($checkMe)) {
	    return 1;
	}
    }
    return 0;
}

######################################################################
package XML::DOM::Node;
######################################################################

sub getLineage
{
    my ($self) = @_;
    my @ret;

    # skip self ("getLineage" implies only parents are returned).
    for (my $node = $self->[_Parent]; $node; $node = $node->[_Parent]) {
	unshift (@ret, $node);
    }

    @ret;
}

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

    my @selfLineage = ($self->getLineage(), $self);
    my @cmpLineage = ($cmp->getLineage(), $cmp);

    # Find depth of last common ancestor.
    my $splitDetph;
    for ($splitDetph = 0; 
	 $selfLineage[$splitDetph] == $cmpLineage[$splitDetph] && 
	 $splitDetph < @selfLineage - 1; 
	 $splitDetph++) {}

    ($selfLineage[$splitDetph], $cmpLineage[$splitDetph]);
}

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

    if ($self == $cmp) {
	return 0;
    }

    my ($aNode, $bNode) = $self->deviatingAncestors($cmp);
    do {
	$aNode = $aNode->getNextSibling();
	if ($aNode == $bNode) {
	    return -1;
	}
    } while ($aNode);
    return 1;
}

######################################################################
package XML::DOM::Range;
######################################################################
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };

BEGIN
{
    import XML::DOM::CharacterData qw( :DEFAULT :Fields );
    import XML::DOM::Node qw( :DEFAULT :Fields );
    XML::DOM::def_fields ("RangeStart RangeEnd", "XML::DOM::Text");
}

use XML::DOM::DOMException;
use Carp;

use W3C::Util::Exception;
sub new
{
    my ($class, $doc, $data, $start, $end, $parent) = @_;
    my $self = bless [], $class;

    if ($start < 1 || $end > length($data)+1) {
	&throw(new W3C::Util::Exception(-message => "range: $start to $end not valid for \"$data\""));
    }

    $self->[_Doc] = $doc;
    $self->[_Data] = $data;
    $self->[_RangeStart] = $start;
    $self->[_RangeEnd] = $end;
    $self->setParentNode($parent);
    $self;
}

sub startOffset
{
    my ($self) = @_;
    $self->[_RangeStart];
}

sub endOffset
{
    my ($self) = @_;
    $self->[_RangeEnd];
}

sub print
{
    my ($self, $FILE) = @_;
    my $l = substr($self->getData, 0, $self->[_RangeStart]-1);
    my $m = substr($self->getData, $self->[_RangeStart]-1, $self->[_RangeEnd] - $self->[_RangeStart]);
    my $r = substr($self->getData, $self->[_RangeEnd]-1);
    $FILE->print (XML::DOM::encodeText ("$l | $m | $r", '<&>"'));
}

######################################################################
package XML::DOM::Document;
######################################################################
use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };

BEGIN
{
    import XML::DOM::Node qw( :DEFAULT :Fields );
    XML::DOM::def_fields ("Doctype XmlDecl", "XML::DOM::Node");
}

use Carp;
use XML::DOM::NodeList;
use XML::DOM::DOMException;

sub createRangeNode
{
    new XML::DOM::Range (@_);
}


1;

__END__

=head1 NAME

W3C::XML::XPathCompileTree - RDF query objects

=head1 SYNOPSIS

  # in a parser...
  use W3C::XML::XPathCompileTree;
  my $t1 = new W3C::XML::XPathCompileTree::Decl([$p1, $s1, $o1], 
				$constraints1, $self);
  my $t2 = new W3C::XML::XPathCompileTree::Decl([$p2, $s2, $o2], 
				$constraints2, $self);
  my $conj = new W3C::XML::XPathCompileTree::Conjunction($t1, $t2, $self)

=head1 DESCRIPTION

Parsers generate XPathCompileTrees and hand them to the XPath2 object. XPath2
calls the compile tree to perforn queries/assertions/rules.

This module is part of the W3C::XML CPAN module.

=head1 METHODS

    $atomDictionary, $namespaceHandler, 
	$sources, $rdfApp, $sourceAttrib, $flags

=head2 immediateEvaluate($resultSet)

Perform compile-time evaluations.

no return value

=head2 delayedEvaluate($resultSet)

Perform post-compile-time (pass 2) evaluations. This is for query languages
that require a second pass to do things like resolve namespace prefixes that
are declared after a dependent qname is first used.

no return value

=head2 val($triple, $premise, $row)

Perform the query evaluation. I don't remember what the hell the $premise is,
but it sure looks important.

returns an interned RDF Atom

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

W3C::XML::XPath2(1) W3C::XML::XPathParser(1) W3C::XML::Atom(1) perl(1).

=cut
