diff options
Diffstat (limited to 'XPath/Expr.pm')
-rw-r--r-- | XPath/Expr.pm | 619 |
1 files changed, 619 insertions, 0 deletions
diff --git a/XPath/Expr.pm b/XPath/Expr.pm new file mode 100644 index 0000000..3cb4714 --- /dev/null +++ b/XPath/Expr.pm @@ -0,0 +1,619 @@ +# $Id: Expr.pm,v 1.20 2003/01/26 19:33:24 matt Exp $ + +package XML::XPath::Expr; +use strict; + +sub new { + my $class = shift; + my ($pp) = @_; + bless { predicates => [], pp => $pp }, $class; +} + +sub as_string { + my $self = shift; + local $^W; # Use of uninitialized value! grrr + my $string = "(" . $self->{lhs}->as_string; + $string .= " " . $self->{op} . " " if defined $self->{op}; + $string .= $self->{rhs}->as_string if defined $self->{rhs}; + $string .= ")"; + foreach my $predicate (@{$self->{predicates}}) { + $string .= "[" . $predicate->as_string . "]"; + } + return $string; +} + +sub as_xml { + my $self = shift; + local $^W; # Use of uninitialized value! grrr + my $string; + if (defined $self->{op}) { + $string .= $self->op_xml(); + } + else { + $string .= $self->{lhs}->as_xml(); + } + foreach my $predicate (@{$self->{predicates}}) { + $string .= "<Predicate>\n" . $predicate->as_xml() . "</Predicate>\n"; + } + return $string; +} + +sub op_xml { + my $self = shift; + my $op = $self->{op}; + + my $tag; + for ($op) { + /^or$/ && do { + $tag = "Or"; + }; + /^and$/ && do { + $tag = "And"; + }; + /^=$/ && do { + $tag = "Equals"; + }; + /^!=$/ && do { + $tag = "NotEquals"; + }; + /^<=$/ && do { + $tag = "LessThanOrEquals"; + }; + /^>=$/ && do { + $tag = "GreaterThanOrEquals"; + }; + /^>$/ && do { + $tag = "GreaterThan"; + }; + /^<$/ && do { + $tag = "LessThan"; + }; + /^\+$/ && do { + $tag = "Plus"; + }; + /^-$/ && do { + $tag = "Minus"; + }; + /^div$/ && do { + $tag = "Div"; + }; + /^mod$/ && do { + $tag = "Mod"; + }; + /^\*$/ && do { + $tag = "Multiply"; + }; + /^\|$/ && do { + $tag = "Union"; + }; + } + + return "<$tag>\n" . $self->{lhs}->as_xml() . $self->{rhs}->as_xml() . "</$tag>\n"; +} + +sub set_lhs { + my $self = shift; + $self->{lhs} = $_[0]; +} + +sub set_op { + my $self = shift; + $self->{op} = $_[0]; +} + +sub set_rhs { + my $self = shift; + $self->{rhs} = $_[0]; +} + +sub push_predicate { + my $self = shift; + + die "Only 1 predicate allowed on FilterExpr in W3C XPath 1.0" + if @{$self->{predicates}}; + + push @{$self->{predicates}}, $_[0]; +} + +sub get_lhs { $_[0]->{lhs}; } +sub get_rhs { $_[0]->{rhs}; } +sub get_op { $_[0]->{op}; } + +sub evaluate { + my $self = shift; + my $node = shift; + + # If there's an op, result is result of that op. + # If no op, just resolve Expr + +# warn "Evaluate Expr: ", $self->as_string, "\n"; + + my $results; + + if ($self->{op}) { + die ("No RHS of ", $self->as_string) unless $self->{rhs}; + $results = $self->op_eval($node); + } + else { + $results = $self->{lhs}->evaluate($node); + } + + if (my @predicates = @{$self->{predicates}}) { + if (!$results->isa('XML::XPath::NodeSet')) { + die "Can't have predicates execute on object type: " . ref($results); + } + + # filter initial nodeset by each predicate + foreach my $predicate (@{$self->{predicates}}) { + $results = $self->filter_by_predicate($results, $predicate); + } + } + + return $results; +} + +sub op_eval { + my $self = shift; + my $node = shift; + + my $op = $self->{op}; + + for ($op) { + /^or$/ && do { + return op_or($node, $self->{lhs}, $self->{rhs}); + }; + /^and$/ && do { + return op_and($node, $self->{lhs}, $self->{rhs}); + }; + /^=$/ && do { + return op_equals($node, $self->{lhs}, $self->{rhs}); + }; + /^!=$/ && do { + return op_nequals($node, $self->{lhs}, $self->{rhs}); + }; + /^<=$/ && do { + return op_le($node, $self->{lhs}, $self->{rhs}); + }; + /^>=$/ && do { + return op_ge($node, $self->{lhs}, $self->{rhs}); + }; + /^>$/ && do { + return op_gt($node, $self->{lhs}, $self->{rhs}); + }; + /^<$/ && do { + return op_lt($node, $self->{lhs}, $self->{rhs}); + }; + /^\+$/ && do { + return op_plus($node, $self->{lhs}, $self->{rhs}); + }; + /^-$/ && do { + return op_minus($node, $self->{lhs}, $self->{rhs}); + }; + /^div$/ && do { + return op_div($node, $self->{lhs}, $self->{rhs}); + }; + /^mod$/ && do { + return op_mod($node, $self->{lhs}, $self->{rhs}); + }; + /^\*$/ && do { + return op_mult($node, $self->{lhs}, $self->{rhs}); + }; + /^\|$/ && do { + return op_union($node, $self->{lhs}, $self->{rhs}); + }; + + die "No such operator, or operator unimplemented in ", $self->as_string, "\n"; + } +} + +# Operators + +use XML::XPath::Boolean; + +sub op_or { + my ($node, $lhs, $rhs) = @_; + if($lhs->evaluate($node)->to_boolean->value) { + return XML::XPath::Boolean->True; + } + else { + return $rhs->evaluate($node)->to_boolean; + } +} + +sub op_and { + my ($node, $lhs, $rhs) = @_; + if( ! $lhs->evaluate($node)->to_boolean->value ) { + return XML::XPath::Boolean->False; + } + else { + return $rhs->evaluate($node)->to_boolean; + } +} + +sub op_equals { + my ($node, $lhs, $rhs) = @_; + + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + if ($lh_results->isa('XML::XPath::NodeSet') && + $rh_results->isa('XML::XPath::NodeSet')) { + # True if and only if there is a node in the + # first set and a node in the second set such + # that the result of performing the comparison + # on the string-values of the two nodes is true. + foreach my $lhnode ($lh_results->get_nodelist) { + foreach my $rhnode ($rh_results->get_nodelist) { + if ($lhnode->string_value eq $rhnode->string_value) { + return XML::XPath::Boolean->True; + } + } + } + return XML::XPath::Boolean->False; + } + elsif (($lh_results->isa('XML::XPath::NodeSet') || + $rh_results->isa('XML::XPath::NodeSet')) && + (!$lh_results->isa('XML::XPath::NodeSet') || + !$rh_results->isa('XML::XPath::NodeSet'))) { + # (that says: one is a nodeset, and one is not a nodeset) + + my ($nodeset, $other); + if ($lh_results->isa('XML::XPath::NodeSet')) { + $nodeset = $lh_results; + $other = $rh_results; + } + else { + $nodeset = $rh_results; + $other = $lh_results; + } + + # True if and only if there is a node in the + # nodeset such that the result of performing + # the comparison on <type>(string_value($node)) + # is true. + if ($other->isa('XML::XPath::Number')) { + foreach my $node ($nodeset->get_nodelist) { + if ($node->string_value == $other->value) { + return XML::XPath::Boolean->True; + } + } + } + elsif ($other->isa('XML::XPath::Literal')) { + foreach my $node ($nodeset->get_nodelist) { + if ($node->string_value eq $other->value) { + return XML::XPath::Boolean->True; + } + } + } + elsif ($other->isa('XML::XPath::Boolean')) { + if ($nodeset->to_boolean->value == $other->value) { + return XML::XPath::Boolean->True; + } + } + + return XML::XPath::Boolean->False; + } + else { # Neither is a nodeset + if ($lh_results->isa('XML::XPath::Boolean') || + $rh_results->isa('XML::XPath::Boolean')) { + # if either is a boolean + if ($lh_results->to_boolean->value == $rh_results->to_boolean->value) { + return XML::XPath::Boolean->True; + } + return XML::XPath::Boolean->False; + } + elsif ($lh_results->isa('XML::XPath::Number') || + $rh_results->isa('XML::XPath::Number')) { + # if either is a number + local $^W; # 'number' might result in undef + if ($lh_results->to_number->value == $rh_results->to_number->value) { + return XML::XPath::Boolean->True; + } + return XML::XPath::Boolean->False; + } + else { + if ($lh_results->to_literal->value eq $rh_results->to_literal->value) { + return XML::XPath::Boolean->True; + } + return XML::XPath::Boolean->False; + } + } +} + +sub op_nequals { + my ($node, $lhs, $rhs) = @_; + if (op_equals($node, $lhs, $rhs)->value) { + return XML::XPath::Boolean->False; + } + return XML::XPath::Boolean->True; +} + +sub op_le { + my ($node, $lhs, $rhs) = @_; + op_gt($node, $rhs, $lhs); +} + +sub op_ge { + my ($node, $lhs, $rhs) = @_; + + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + if ($lh_results->isa('XML::XPath::NodeSet') && + $rh_results->isa('XML::XPath::NodeSet')) { + + foreach my $lhnode ($lh_results->get_nodelist) { + foreach my $rhnode ($rh_results->get_nodelist) { + my $lhNum = XML::XPath::Number->new($lhnode->string_value); + my $rhNum = XML::XPath::Number->new($rhnode->string_value); + if ($lhNum->value >= $rhNum->value) { + return XML::XPath::Boolean->True; + } + } + } + return XML::XPath::Boolean->False; + } + elsif (($lh_results->isa('XML::XPath::NodeSet') || + $rh_results->isa('XML::XPath::NodeSet')) && + (!$lh_results->isa('XML::XPath::NodeSet') || + !$rh_results->isa('XML::XPath::NodeSet'))) { + # (that says: one is a nodeset, and one is not a nodeset) + + my ($nodeset, $other); + my ($true, $false); + if ($lh_results->isa('XML::XPath::NodeSet')) { + $nodeset = $lh_results; + $other = $rh_results; + # we do this because unlike ==, these ops are direction dependant + ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); + } + else { + $nodeset = $rh_results; + $other = $lh_results; + # ditto above comment + ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); + } + + # True if and only if there is a node in the + # nodeset such that the result of performing + # the comparison on <type>(string_value($node)) + # is true. + foreach my $node ($nodeset->get_nodelist) { + if ($node->to_number->value >= $other->to_number->value) { + return $true; + } + } + return $false; + } + else { # Neither is a nodeset + if ($lh_results->isa('XML::XPath::Boolean') || + $rh_results->isa('XML::XPath::Boolean')) { + # if either is a boolean + if ($lh_results->to_boolean->to_number->value + >= $rh_results->to_boolean->to_number->value) { + return XML::XPath::Boolean->True; + } + } + else { + if ($lh_results->to_number->value >= $rh_results->to_number->value) { + return XML::XPath::Boolean->True; + } + } + return XML::XPath::Boolean->False; + } +} + +sub op_gt { + my ($node, $lhs, $rhs) = @_; + + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + if ($lh_results->isa('XML::XPath::NodeSet') && + $rh_results->isa('XML::XPath::NodeSet')) { + + foreach my $lhnode ($lh_results->get_nodelist) { + foreach my $rhnode ($rh_results->get_nodelist) { + my $lhNum = XML::XPath::Number->new($lhnode->string_value); + my $rhNum = XML::XPath::Number->new($rhnode->string_value); + if ($lhNum->value > $rhNum->value) { + return XML::XPath::Boolean->True; + } + } + } + return XML::XPath::Boolean->False; + } + elsif (($lh_results->isa('XML::XPath::NodeSet') || + $rh_results->isa('XML::XPath::NodeSet')) && + (!$lh_results->isa('XML::XPath::NodeSet') || + !$rh_results->isa('XML::XPath::NodeSet'))) { + # (that says: one is a nodeset, and one is not a nodeset) + + my ($nodeset, $other); + my ($true, $false); + if ($lh_results->isa('XML::XPath::NodeSet')) { + $nodeset = $lh_results; + $other = $rh_results; + # we do this because unlike ==, these ops are direction dependant + ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); + } + else { + $nodeset = $rh_results; + $other = $lh_results; + # ditto above comment + ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True); + } + + # True if and only if there is a node in the + # nodeset such that the result of performing + # the comparison on <type>(string_value($node)) + # is true. + foreach my $node ($nodeset->get_nodelist) { + if ($node->to_number->value > $other->to_number->value) { + return $true; + } + } + return $false; + } + else { # Neither is a nodeset + if ($lh_results->isa('XML::XPath::Boolean') || + $rh_results->isa('XML::XPath::Boolean')) { + # if either is a boolean + if ($lh_results->to_boolean->value > $rh_results->to_boolean->value) { + return XML::XPath::Boolean->True; + } + } + else { + if ($lh_results->to_number->value > $rh_results->to_number->value) { + return XML::XPath::Boolean->True; + } + } + return XML::XPath::Boolean->False; + } +} + +sub op_lt { + my ($node, $lhs, $rhs) = @_; + op_gt($node, $rhs, $lhs); +} + +sub op_plus { + my ($node, $lhs, $rhs) = @_; + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + my $result = + $lh_results->to_number->value + + + $rh_results->to_number->value + ; + return XML::XPath::Number->new($result); +} + +sub op_minus { + my ($node, $lhs, $rhs) = @_; + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + my $result = + $lh_results->to_number->value + - + $rh_results->to_number->value + ; + return XML::XPath::Number->new($result); +} + +sub op_div { + my ($node, $lhs, $rhs) = @_; + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + my $result = eval { + $lh_results->to_number->value + / + $rh_results->to_number->value + ; + }; + if ($@) { + # assume divide by zero + # This is probably a terrible way to handle this! + # Ah well... who wants to live forever... + return XML::XPath::Literal->new('Infinity'); + } + return XML::XPath::Number->new($result); +} + +sub op_mod { + my ($node, $lhs, $rhs) = @_; + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + my $result = + $lh_results->to_number->value + % + $rh_results->to_number->value + ; + return XML::XPath::Number->new($result); +} + +sub op_mult { + my ($node, $lhs, $rhs) = @_; + my $lh_results = $lhs->evaluate($node); + my $rh_results = $rhs->evaluate($node); + + my $result = + $lh_results->to_number->value + * + $rh_results->to_number->value + ; + return XML::XPath::Number->new($result); +} + +sub op_union { + my ($node, $lhs, $rhs) = @_; + my $lh_result = $lhs->evaluate($node); + my $rh_result = $rhs->evaluate($node); + + if ($lh_result->isa('XML::XPath::NodeSet') && + $rh_result->isa('XML::XPath::NodeSet')) { + my %found; + my $results = XML::XPath::NodeSet->new; + foreach my $lhnode ($lh_result->get_nodelist) { + $found{"$lhnode"}++; + $results->push($lhnode); + } + foreach my $rhnode ($rh_result->get_nodelist) { + $results->push($rhnode) + unless exists $found{"$rhnode"}; + } + $results->sort; + return $results; + } + die "Both sides of a union must be Node Sets\n"; +} + +sub filter_by_predicate { + my $self = shift; + my ($nodeset, $predicate) = @_; + + # See spec section 2.4, paragraphs 2 & 3: + # For each node in the node-set to be filtered, the predicate Expr + # is evaluated with that node as the context node, with the number + # of nodes in the node set as the context size, and with the + # proximity position of the node in the node set with respect to + # the axis as the context position. + + if (!ref($nodeset)) { # use ref because nodeset has a bool context + die "No nodeset!!!"; + } + +# warn "Filter by predicate: $predicate\n"; + + my $newset = XML::XPath::NodeSet->new(); + + for(my $i = 1; $i <= $nodeset->size; $i++) { + # set context set each time 'cos a loc-path in the expr could change it + $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; |