summaryrefslogtreecommitdiff
path: root/XPath/Expr.pm
diff options
context:
space:
mode:
Diffstat (limited to 'XPath/Expr.pm')
-rw-r--r--XPath/Expr.pm619
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;
View Lorry Controller Status