package XML::XPath::Step;
use XML::XPath::Parser;
use XML::XPath::Node;
use strict;
sub test_qname () { 0; } sub test_ncwild () { 1; } sub test_any () { 2; }
sub test_attr_qname () { 3; } sub test_attr_ncwild () { 4; } sub test_attr_any () { 5; }
sub test_nt_comment () { 6; } sub test_nt_text () { 7; } sub test_nt_pi () { 8; } sub test_nt_node () { 9; }
sub new {
my $class = shift;
my ($pp, $axis, $test, $literal) = @_;
my $axis_method = "axis_$axis";
$axis_method =~ tr/-/_/;
my $self = {
pp => $pp, axis => $axis,
axis_method => $axis_method,
test => $test,
literal => $literal,
predicates => [],
};
bless $self, $class;
}
sub as_string {
my $self = shift;
my $string = $self->{axis} . "::";
my $test = $self->{test};
if ($test == test_nt_pi) {
$string .= 'processing-instruction(';
if ($self->{literal}->value) {
$string .= $self->{literal}->as_string;
}
$string .= ")";
}
elsif ($test == test_nt_comment) {
$string .= 'comment()';
}
elsif ($test == test_nt_text) {
$string .= 'text()';
}
elsif ($test == test_nt_node) {
$string .= 'node()';
}
elsif ($test == test_ncwild || $test == test_attr_ncwild) {
$string .= $self->{literal} . ':*';
}
else {
$string .= $self->{literal};
}
foreach (@{$self->{predicates}}) {
next unless defined $_;
$string .= "[" . $_->as_string . "]";
}
return $string;
}
sub as_xml {
my $self = shift;
my $string = "<Step>\n";
$string .= "<Axis>" . $self->{axis} . "</Axis>\n";
my $test = $self->{test};
$string .= "<Test>";
if ($test == test_nt_pi) {
$string .= '<processing-instruction';
if ($self->{literal}->value) {
$string .= '>';
$string .= $self->{literal}->as_string;
$string .= '</processing-instruction>';
}
else {
$string .= '/>';
}
}
elsif ($test == test_nt_comment) {
$string .= '<comment/>';
}
elsif ($test == test_nt_text) {
$string .= '<text/>';
}
elsif ($test == test_nt_node) {
$string .= '<node/>';
}
elsif ($test == test_ncwild || $test == test_attr_ncwild) {
$string .= '<namespace-prefix>' . $self->{literal} . '</namespace-prefix>';
}
else {
$string .= '<nametest>' . $self->{literal} . '</nametest>';
}
$string .= "</Test>\n";
foreach (@{$self->{predicates}}) {
next unless defined $_;
$string .= "<Predicate>\n" . $_->as_xml() . "</Predicate>\n";
}
$string .= "</Step>\n";
return $string;
}
sub evaluate {
my $self = shift;
my $from = shift;
$self->{pp}->set_context_set($from);
my $initial_nodeset = XML::XPath::NodeSet->new();
for(my $i = 1; $i <= $from->size; $i++) {
$self->{pp}->set_context_pos($i);
$initial_nodeset->append($self->evaluate_node($from->get_node($i)));
}
$self->{pp}->set_context_set(undef);
$initial_nodeset->sort;
return $initial_nodeset;
}
sub evaluate_node {
my $self = shift;
my $context = shift;
my $method = $self->{axis_method};
my $results = XML::XPath::NodeSet->new();
no strict 'refs';
eval {
$method->($self, $context, $results);
};
if ($@) {
die "axis $method not implemented [$@]\n";
}
foreach my $predicate (@{$self->{predicates}}) {
$results = $self->filter_by_predicate($results, $predicate);
}
return $results;
}
sub axis_ancestor {
my $self = shift;
my ($context, $results) = @_;
my $parent = $context->getParentNode;
START:
return $results unless $parent;
if (node_test($self, $parent)) {
$results->push($parent);
}
$parent = $parent->getParentNode;
goto START;
}
sub axis_ancestor_or_self {
my $self = shift;
my ($context, $results) = @_;
START:
return $results unless $context;
if (node_test($self, $context)) {
$results->push($context);
}
$context = $context->getParentNode;
goto START;
}
sub axis_attribute {
my $self = shift;
my ($context, $results) = @_;
foreach my $attrib (@{$context->getAttributes}) {
if ($self->test_attribute($attrib)) {
$results->push($attrib);
}
}
}
sub axis_child {
my $self = shift;
my ($context, $results) = @_;
foreach my $node (@{$context->getChildNodes}) {
if (node_test($self, $node)) {
$results->push($node);
}
}
}
sub axis_descendant {
my $self = shift;
my ($context, $results) = @_;
my @stack = $context->getChildNodes;
while (@stack) {
my $node = pop @stack;
if (node_test($self, $node)) {
$results->unshift($node);
}
push @stack, $node->getChildNodes;
}
}
sub axis_descendant_or_self {
my $self = shift;
my ($context, $results) = @_;
my @stack = ($context);
while (@stack) {
my $node = pop @stack;
if (node_test($self, $node)) {
$results->unshift($node);
}
push @stack, $node->getChildNodes;
}
}
sub axis_following {
my $self = shift;
my ($context, $results) = @_;
START:
my $parent = $context->getParentNode;
return $results unless $parent;
while ($context = $context->getNextSibling) {
axis_descendant_or_self($self, $context, $results);
}
$context = $parent;
goto START;
}
sub axis_following_sibling {
my $self = shift;
my ($context, $results) = @_;
while ($context = $context->getNextSibling) {
if (node_test($self, $context)) {
$results->push($context);
}
}
}
sub axis_namespace {
my $self = shift;
my ($context, $results) = @_;
return $results unless $context->isElementNode;
foreach my $ns (@{$context->getNamespaces}) {
if ($self->test_namespace($ns)) {
$results->push($ns);
}
}
}
sub axis_parent {
my $self = shift;
my ($context, $results) = @_;
my $parent = $context->getParentNode;
return $results unless $parent;
if (node_test($self, $parent)) {
$results->push($parent);
}
}
sub axis_preceding {
my $self = shift;
my ($context, $results) = @_;
START:
my $parent = $context->getParentNode;
return $results unless $parent;
while ($context = $context->getPreviousSibling) {
axis_descendant_or_self($self, $context, $results);
}
$context = $parent;
goto START;
}
sub axis_preceding_sibling {
my $self = shift;
my ($context, $results) = @_;
while ($context = $context->getPreviousSibling) {
if (node_test($self, $context)) {
$results->push($context);
}
}
}
sub axis_self {
my $self = shift;
my ($context, $results) = @_;
if (node_test($self, $context)) {
$results->push($context);
}
}
sub node_test {
my $self = shift;
my $node = shift;
my $test = $self->{test};
return 1 if $test == test_nt_node;
if ($test == test_any) {
return 1 if $node->isElementNode && defined $node->getName;
}
local $^W;
if ($test == test_ncwild) {
return unless $node->isElementNode;
my $match_ns = $self->{pp}->get_namespace($self->{literal}, $node);
if (my $node_nsnode = $node->getNamespace()) {
return 1 if $match_ns eq $node_nsnode->getValue;
}
}
elsif ($test == test_qname) {
return unless $node->isElementNode;
if ($self->{literal} =~ /:/) {
my ($prefix, $name) = split(':', $self->{literal}, 2);
my $match_ns = $self->{pp}->get_namespace($prefix, $node);
if (my $node_nsnode = $node->getNamespace()) {
return 1 if ($match_ns eq $node_nsnode->getValue) &&
($name eq $node->getLocalName);
}
}
else {
return 1 if $node->getName eq $self->{literal};
}
}
elsif ($test == test_nt_text) {
return 1 if $node->isTextNode;
}
elsif ($test == test_nt_comment) {
return 1 if $node->isCommentNode;
}
elsif ($test == test_nt_pi) {
return unless $node->isPINode;
if (my $val = $self->{literal}->value) {
return 1 if $node->getTarget eq $val;
}
else {
return 1;
}
}
return; }
sub test_attribute {
my $self = shift;
my $node = shift;
my $test = $self->{test};
return 1 if ($test == test_attr_any) || ($test == test_nt_node);
if ($test == test_attr_ncwild) {
my $match_ns = $self->{pp}->get_namespace($self->{literal}, $node);
if (my $node_nsnode = $node->getNamespace()) {
return 1 if $match_ns eq $node_nsnode->getValue;
}
}
elsif ($test == test_attr_qname) {
if ($self->{literal} =~ /:/) {
my ($prefix, $name) = split(':', $self->{literal}, 2);
my $match_ns = $self->{pp}->get_namespace($prefix, $node);
if (my $node_nsnode = $node->getNamespace()) {
return 1 if ($match_ns eq $node_nsnode->getValue) &&
($name eq $node->getLocalName);
}
}
else {
return 1 if $node->getName eq $self->{literal};
}
}
return; }
sub test_namespace {
my $self = shift;
my $node = shift;
my $test = $self->{test};
return 1 if $test == test_any;
if ($test == test_any) {
return 1;
}
elsif ($self->{literal} eq $node->getExpanded) {
return 1;
}
return;
}
sub filter_by_predicate {
my $self = shift;
my ($nodeset, $predicate) = @_;
if (!ref($nodeset)) { die "No nodeset!!!";
}
my $newset = XML::XPath::NodeSet->new();
for(my $i = 1; $i <= $nodeset->size; $i++) {
$self->{pp}->set_context_set($nodeset);
$self->{pp}->set_context_pos($i);
my $result = $predicate->evaluate($nodeset->get_node($i));
if ($result->isa('XML::XPath::Boolean')) {
if ($result->value) {
$newset->push($nodeset->get_node($i));
}
}
elsif ($result->isa('XML::XPath::Number')) {
if ($result->value == $i) {
$newset->push($nodeset->get_node($i));
}
}
else {
if ($result->to_boolean->value) {
$newset->push($nodeset->get_node($i));
}
}
}
return $newset;
}
1;