source: trunk/gsdl/perllib/cpan/XML/XPath/Expr.pm@ 7909

Last change on this file since 7909 was 7909, checked in by mdewsnip, 20 years ago

CPAN module for processing XPath expressions.
  • Property svn:keywords set to Author Date Id Revision
File size: 18.3 KB
Line 
1# $Id: Expr.pm 7909 2004-08-06 05:11:55Z mdewsnip $
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;
Note: See TracBrowser for help on using the repository browser.