1# $Id: Expr.pm,v 1.20 2003/01/26 19:33:24 matt Exp $
2
3package XML::XPath::Expr;
4use strict;
5
6sub new {
7    my $class = shift;
8    my ($pp) = @_;
9    bless { predicates => [], pp => $pp }, $class;
10}
11
12sub as_string {
13    my $self = shift;
14    local $^W; # Use of uninitialized value! grrr
15    my $string = "(" . $self->{lhs}->as_string;
16    $string .= " " . $self->{op} . " " if defined $self->{op};
17    $string .= $self->{rhs}->as_string if defined $self->{rhs};
18    $string .= ")";
19    foreach my $predicate (@{$self->{predicates}}) {
20        $string .= "[" . $predicate->as_string . "]";
21    }
22    return $string;
23}
24
25sub as_xml {
26    my $self = shift;
27    local $^W; # Use of uninitialized value! grrr
28    my $string;
29    if (defined $self->{op}) {
30        $string .= $self->op_xml();
31    }
32    else {
33        $string .= $self->{lhs}->as_xml();
34    }
35    foreach my $predicate (@{$self->{predicates}}) {
36        $string .= "<Predicate>\n" . $predicate->as_xml() . "</Predicate>\n";
37    }
38    return $string;
39}
40
41sub op_xml {
42    my $self = shift;
43    my $op = $self->{op};
44
45    my $tag;
46    for ($op) {
47        /^or$/    && do {
48                    $tag = "Or";
49                };
50        /^and$/    && do {
51                    $tag = "And";
52                };
53        /^=$/    && do {
54                    $tag = "Equals";
55                };
56        /^!=$/    && do {
57                    $tag = "NotEquals";
58                };
59        /^<=$/    && do {
60                    $tag = "LessThanOrEquals";
61                };
62        /^>=$/    && do {
63                    $tag = "GreaterThanOrEquals";
64                };
65        /^>$/    && do {
66                    $tag = "GreaterThan";
67                };
68        /^<$/    && do {
69                    $tag = "LessThan";
70                };
71        /^\+$/    && do {
72                    $tag = "Plus";
73                };
74        /^-$/    && do {
75                    $tag = "Minus";
76                };
77        /^div$/    && do {
78                    $tag = "Div";
79                };
80        /^mod$/    && do {
81                    $tag = "Mod";
82                };
83        /^\*$/    && do {
84                    $tag = "Multiply";
85                };
86        /^\|$/    && do {
87                    $tag = "Union";
88                };
89    }
90
91    return "<$tag>\n" . $self->{lhs}->as_xml() . $self->{rhs}->as_xml() . "</$tag>\n";
92}
93
94sub set_lhs {
95    my $self = shift;
96    $self->{lhs} = $_[0];
97}
98
99sub set_op {
100    my $self = shift;
101    $self->{op} = $_[0];
102}
103
104sub set_rhs {
105    my $self = shift;
106    $self->{rhs} = $_[0];
107}
108
109sub push_predicate {
110    my $self = shift;
111
112    die "Only 1 predicate allowed on FilterExpr in W3C XPath 1.0"
113            if @{$self->{predicates}};
114
115    push @{$self->{predicates}}, $_[0];
116}
117
118sub get_lhs { $_[0]->{lhs}; }
119sub get_rhs { $_[0]->{rhs}; }
120sub get_op { $_[0]->{op}; }
121
122sub evaluate {
123    my $self = shift;
124    my $node = shift;
125
126    # If there's an op, result is result of that op.
127    # If no op, just resolve Expr
128
129#    warn "Evaluate Expr: ", $self->as_string, "\n";
130
131    my $results;
132
133    if ($self->{op}) {
134        die ("No RHS of ", $self->as_string) unless $self->{rhs};
135        $results = $self->op_eval($node);
136    }
137    else {
138        $results = $self->{lhs}->evaluate($node);
139    }
140
141    if (my @predicates = @{$self->{predicates}}) {
142        if (!$results->isa('XML::XPath::NodeSet')) {
143            die "Can't have predicates execute on object type: " . ref($results);
144        }
145
146        # filter initial nodeset by each predicate
147        foreach my $predicate (@{$self->{predicates}}) {
148            $results = $self->filter_by_predicate($results, $predicate);
149        }
150    }
151
152    return $results;
153}
154
155sub op_eval {
156    my $self = shift;
157    my $node = shift;
158
159    my $op = $self->{op};
160
161    for ($op) {
162        /^or$/    && do {
163                    return op_or($node, $self->{lhs}, $self->{rhs});
164                };
165        /^and$/    && do {
166                    return op_and($node, $self->{lhs}, $self->{rhs});
167                };
168        /^=$/    && do {
169                    return op_equals($node, $self->{lhs}, $self->{rhs});
170                };
171        /^!=$/    && do {
172                    return op_nequals($node, $self->{lhs}, $self->{rhs});
173                };
174        /^<=$/    && do {
175                    return op_le($node, $self->{lhs}, $self->{rhs});
176                };
177        /^>=$/    && do {
178                    return op_ge($node, $self->{lhs}, $self->{rhs});
179                };
180        /^>$/    && do {
181                    return op_gt($node, $self->{lhs}, $self->{rhs});
182                };
183        /^<$/    && do {
184                    return op_lt($node, $self->{lhs}, $self->{rhs});
185                };
186        /^\+$/    && do {
187                    return op_plus($node, $self->{lhs}, $self->{rhs});
188                };
189        /^-$/    && do {
190                    return op_minus($node, $self->{lhs}, $self->{rhs});
191                };
192        /^div$/    && do {
193                    return op_div($node, $self->{lhs}, $self->{rhs});
194                };
195        /^mod$/    && do {
196                    return op_mod($node, $self->{lhs}, $self->{rhs});
197                };
198        /^\*$/    && do {
199                    return op_mult($node, $self->{lhs}, $self->{rhs});
200                };
201        /^\|$/    && do {
202                    return op_union($node, $self->{lhs}, $self->{rhs});
203                };
204
205        die "No such operator, or operator unimplemented in ", $self->as_string, "\n";
206    }
207}
208
209# Operators
210
211use XML::XPath::Boolean;
212
213sub op_or {
214    my ($node, $lhs, $rhs) = @_;
215    if($lhs->evaluate($node)->to_boolean->value) {
216        return XML::XPath::Boolean->True;
217    }
218    else {
219        return $rhs->evaluate($node)->to_boolean;
220    }
221}
222
223sub op_and {
224    my ($node, $lhs, $rhs) = @_;
225    if( ! $lhs->evaluate($node)->to_boolean->value ) {
226        return XML::XPath::Boolean->False;
227    }
228    else {
229        return $rhs->evaluate($node)->to_boolean;
230    }
231}
232
233sub op_equals {
234    my ($node, $lhs, $rhs) = @_;
235
236    my $lh_results = $lhs->evaluate($node);
237    my $rh_results = $rhs->evaluate($node);
238
239    if ($lh_results->isa('XML::XPath::NodeSet') &&
240            $rh_results->isa('XML::XPath::NodeSet')) {
241        # True if and only if there is a node in the
242        # first set and a node in the second set such
243        # that the result of performing the comparison
244        # on the string-values of the two nodes is true.
245        foreach my $lhnode ($lh_results->get_nodelist) {
246            foreach my $rhnode ($rh_results->get_nodelist) {
247                if ($lhnode->string_value eq $rhnode->string_value) {
248                    return XML::XPath::Boolean->True;
249                }
250            }
251        }
252        return XML::XPath::Boolean->False;
253    }
254    elsif (($lh_results->isa('XML::XPath::NodeSet') ||
255            $rh_results->isa('XML::XPath::NodeSet')) &&
256            (!$lh_results->isa('XML::XPath::NodeSet') ||
257             !$rh_results->isa('XML::XPath::NodeSet'))) {
258        # (that says: one is a nodeset, and one is not a nodeset)
259
260        my ($nodeset, $other);
261        if ($lh_results->isa('XML::XPath::NodeSet')) {
262            $nodeset = $lh_results;
263            $other = $rh_results;
264        }
265        else {
266            $nodeset = $rh_results;
267            $other = $lh_results;
268        }
269
270        # True if and only if there is a node in the
271        # nodeset such that the result of performing
272        # the comparison on <type>(string_value($node))
273        # is true.
274        if ($other->isa('XML::XPath::Number')) {
275            foreach my $node ($nodeset->get_nodelist) {
276                if ($node->string_value == $other->value) {
277                    return XML::XPath::Boolean->True;
278                }
279            }
280        }
281        elsif ($other->isa('XML::XPath::Literal')) {
282            foreach my $node ($nodeset->get_nodelist) {
283                if ($node->string_value eq $other->value) {
284                    return XML::XPath::Boolean->True;
285                }
286            }
287        }
288        elsif ($other->isa('XML::XPath::Boolean')) {
289            if ($nodeset->to_boolean->value == $other->value) {
290                return XML::XPath::Boolean->True;
291            }
292        }
293
294        return XML::XPath::Boolean->False;
295    }
296    else { # Neither is a nodeset
297        if ($lh_results->isa('XML::XPath::Boolean') ||
298            $rh_results->isa('XML::XPath::Boolean')) {
299            # if either is a boolean
300            if ($lh_results->to_boolean->value == $rh_results->to_boolean->value) {
301                return XML::XPath::Boolean->True;
302            }
303            return XML::XPath::Boolean->False;
304        }
305        elsif ($lh_results->isa('XML::XPath::Number') ||
306                $rh_results->isa('XML::XPath::Number')) {
307            # if either is a number
308            local $^W; # 'number' might result in undef
309            if ($lh_results->to_number->value == $rh_results->to_number->value) {
310                return XML::XPath::Boolean->True;
311            }
312            return XML::XPath::Boolean->False;
313        }
314        else {
315            if ($lh_results->to_literal->value eq $rh_results->to_literal->value) {
316                return XML::XPath::Boolean->True;
317            }
318            return XML::XPath::Boolean->False;
319        }
320    }
321}
322
323sub op_nequals {
324    my ($node, $lhs, $rhs) = @_;
325    if (op_equals($node, $lhs, $rhs)->value) {
326        return XML::XPath::Boolean->False;
327    }
328    return XML::XPath::Boolean->True;
329}
330
331sub op_le {
332    my ($node, $lhs, $rhs) = @_;
333    op_gt($node, $rhs, $lhs);
334}
335
336sub op_ge {
337    my ($node, $lhs, $rhs) = @_;
338
339    my $lh_results = $lhs->evaluate($node);
340    my $rh_results = $rhs->evaluate($node);
341
342    if ($lh_results->isa('XML::XPath::NodeSet') &&
343        $rh_results->isa('XML::XPath::NodeSet')) {
344
345        foreach my $lhnode ($lh_results->get_nodelist) {
346            foreach my $rhnode ($rh_results->get_nodelist) {
347                my $lhNum = XML::XPath::Number->new($lhnode->string_value);
348                my $rhNum = XML::XPath::Number->new($rhnode->string_value);
349                if ($lhNum->value >= $rhNum->value) {
350                    return XML::XPath::Boolean->True;
351                }
352            }
353        }
354        return XML::XPath::Boolean->False;
355    }
356    elsif (($lh_results->isa('XML::XPath::NodeSet') ||
357            $rh_results->isa('XML::XPath::NodeSet')) &&
358            (!$lh_results->isa('XML::XPath::NodeSet') ||
359             !$rh_results->isa('XML::XPath::NodeSet'))) {
360        # (that says: one is a nodeset, and one is not a nodeset)
361
362        my ($nodeset, $other);
363        my ($true, $false);
364        if ($lh_results->isa('XML::XPath::NodeSet')) {
365            $nodeset = $lh_results;
366            $other = $rh_results;
367            # we do this because unlike ==, these ops are direction dependant
368            ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
369        }
370        else {
371            $nodeset = $rh_results;
372            $other = $lh_results;
373            # ditto above comment
374            ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
375        }
376
377        # True if and only if there is a node in the
378        # nodeset such that the result of performing
379        # the comparison on <type>(string_value($node))
380        # is true.
381        foreach my $node ($nodeset->get_nodelist) {
382            if ($node->to_number->value >= $other->to_number->value) {
383                return $true;
384            }
385        }
386        return $false;
387    }
388    else { # Neither is a nodeset
389        if ($lh_results->isa('XML::XPath::Boolean') ||
390            $rh_results->isa('XML::XPath::Boolean')) {
391            # if either is a boolean
392            if ($lh_results->to_boolean->to_number->value
393                    >= $rh_results->to_boolean->to_number->value) {
394                return XML::XPath::Boolean->True;
395            }
396        }
397        else {
398            if ($lh_results->to_number->value >= $rh_results->to_number->value) {
399                return XML::XPath::Boolean->True;
400            }
401        }
402        return XML::XPath::Boolean->False;
403    }
404}
405
406sub op_gt {
407    my ($node, $lhs, $rhs) = @_;
408
409    my $lh_results = $lhs->evaluate($node);
410    my $rh_results = $rhs->evaluate($node);
411
412    if ($lh_results->isa('XML::XPath::NodeSet') &&
413        $rh_results->isa('XML::XPath::NodeSet')) {
414
415        foreach my $lhnode ($lh_results->get_nodelist) {
416            foreach my $rhnode ($rh_results->get_nodelist) {
417                my $lhNum = XML::XPath::Number->new($lhnode->string_value);
418                my $rhNum = XML::XPath::Number->new($rhnode->string_value);
419                if ($lhNum->value > $rhNum->value) {
420                    return XML::XPath::Boolean->True;
421                }
422            }
423        }
424        return XML::XPath::Boolean->False;
425    }
426    elsif (($lh_results->isa('XML::XPath::NodeSet') ||
427            $rh_results->isa('XML::XPath::NodeSet')) &&
428            (!$lh_results->isa('XML::XPath::NodeSet') ||
429             !$rh_results->isa('XML::XPath::NodeSet'))) {
430        # (that says: one is a nodeset, and one is not a nodeset)
431
432        my ($nodeset, $other);
433        my ($true, $false);
434        if ($lh_results->isa('XML::XPath::NodeSet')) {
435            $nodeset = $lh_results;
436            $other = $rh_results;
437            # we do this because unlike ==, these ops are direction dependant
438            ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
439        }
440        else {
441            $nodeset = $rh_results;
442            $other = $lh_results;
443            # ditto above comment
444            ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
445        }
446
447        # True if and only if there is a node in the
448        # nodeset such that the result of performing
449        # the comparison on <type>(string_value($node))
450        # is true.
451        foreach my $node ($nodeset->get_nodelist) {
452            if ($node->to_number->value > $other->to_number->value) {
453                return $true;
454            }
455        }
456        return $false;
457    }
458    else { # Neither is a nodeset
459        if ($lh_results->isa('XML::XPath::Boolean') ||
460            $rh_results->isa('XML::XPath::Boolean')) {
461            # if either is a boolean
462            if ($lh_results->to_boolean->value > $rh_results->to_boolean->value) {
463                return XML::XPath::Boolean->True;
464            }
465        }
466        else {
467            if ($lh_results->to_number->value > $rh_results->to_number->value) {
468                return XML::XPath::Boolean->True;
469            }
470        }
471        return XML::XPath::Boolean->False;
472    }
473}
474
475sub op_lt {
476    my ($node, $lhs, $rhs) = @_;
477    op_gt($node, $rhs, $lhs);
478}
479
480sub op_plus {
481    my ($node, $lhs, $rhs) = @_;
482    my $lh_results = $lhs->evaluate($node);
483    my $rh_results = $rhs->evaluate($node);
484
485    my $result =
486        $lh_results->to_number->value
487            +
488        $rh_results->to_number->value
489            ;
490    return XML::XPath::Number->new($result);
491}
492
493sub op_minus {
494    my ($node, $lhs, $rhs) = @_;
495    my $lh_results = $lhs->evaluate($node);
496    my $rh_results = $rhs->evaluate($node);
497
498    my $result =
499        $lh_results->to_number->value
500            -
501        $rh_results->to_number->value
502            ;
503    return XML::XPath::Number->new($result);
504}
505
506sub op_div {
507    my ($node, $lhs, $rhs) = @_;
508    my $lh_results = $lhs->evaluate($node);
509    my $rh_results = $rhs->evaluate($node);
510
511    my $result = eval {
512        $lh_results->to_number->value
513            /
514        $rh_results->to_number->value
515            ;
516    };
517    if ($@) {
518        # assume divide by zero
519        # This is probably a terrible way to handle this!
520        # Ah well... who wants to live forever...
521        return XML::XPath::Literal->new('Infinity');
522    }
523    return XML::XPath::Number->new($result);
524}
525
526sub op_mod {
527    my ($node, $lhs, $rhs) = @_;
528    my $lh_results = $lhs->evaluate($node);
529    my $rh_results = $rhs->evaluate($node);
530
531    my $result =
532        $lh_results->to_number->value
533            %
534        $rh_results->to_number->value
535            ;
536    return XML::XPath::Number->new($result);
537}
538
539sub op_mult {
540    my ($node, $lhs, $rhs) = @_;
541    my $lh_results = $lhs->evaluate($node);
542    my $rh_results = $rhs->evaluate($node);
543
544    my $result =
545        $lh_results->to_number->value
546            *
547        $rh_results->to_number->value
548            ;
549    return XML::XPath::Number->new($result);
550}
551
552sub op_union {
553    my ($node, $lhs, $rhs) = @_;
554    my $lh_result = $lhs->evaluate($node);
555    my $rh_result = $rhs->evaluate($node);
556
557    if ($lh_result->isa('XML::XPath::NodeSet') &&
558            $rh_result->isa('XML::XPath::NodeSet')) {
559        my %found;
560        my $results = XML::XPath::NodeSet->new;
561        foreach my $lhnode ($lh_result->get_nodelist) {
562            $found{"$lhnode"}++;
563            $results->push($lhnode);
564        }
565        foreach my $rhnode ($rh_result->get_nodelist) {
566            $results->push($rhnode)
567                    unless exists $found{"$rhnode"};
568        }
569                $results->sort;
570        return $results;
571    }
572    die "Both sides of a union must be Node Sets\n";
573}
574
575sub filter_by_predicate {
576    my $self = shift;
577    my ($nodeset, $predicate) = @_;
578
579    # See spec section 2.4, paragraphs 2 & 3:
580    # For each node in the node-set to be filtered, the predicate Expr
581    # is evaluated with that node as the context node, with the number
582    # of nodes in the node set as the context size, and with the
583    # proximity position of the node in the node set with respect to
584    # the axis as the context position.
585
586    if (!ref($nodeset)) { # use ref because nodeset has a bool context
587        die "No nodeset!!!";
588    }
589
590#    warn "Filter by predicate: $predicate\n";
591
592    my $newset = XML::XPath::NodeSet->new();
593
594    for(my $i = 1; $i <= $nodeset->size; $i++) {
595        # set context set each time 'cos a loc-path in the expr could change it
596        $self->{pp}->set_context_set($nodeset);
597        $self->{pp}->set_context_pos($i);
598        my $result = $predicate->evaluate($nodeset->get_node($i));
599        if ($result->isa('XML::XPath::Boolean')) {
600            if ($result->value) {
601                $newset->push($nodeset->get_node($i));
602            }
603        }
604        elsif ($result->isa('XML::XPath::Number')) {
605            if ($result->value == $i) {
606                $newset->push($nodeset->get_node($i));
607            }
608        }
609        else {
610            if ($result->to_boolean->value) {
611                $newset->push($nodeset->get_node($i));
612            }
613        }
614    }
615
616    return $newset;
617}
618
6191;
620