File Coverage

lib/HTML/Object/XPath/Expr.pm
Criterion Covered Total %
statement 131 297 44.1
branch 39 126 30.9
condition 14 53 26.4
subroutine 24 43 55.8
pod 34 34 100.0
total 242 553 43.7


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/XPath/Expr.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/05
7             ## Modified 2022/09/18
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTML::Object::XPath::Expr;
15             BEGIN
16             {
17 8     8   62 use strict;
  8         18  
  8         240  
18 8     8   57 use warnings;
  8         19  
  8         237  
19 8     8   43 use parent qw( Module::Generic );
  8         14  
  8         58  
20 8     8   511 use vars qw( $TRUE $FALSE $BASE_CLASS $DEBUG $VERSION );
  8         22  
  8         523  
21 8     8   3293 use HTML::Object::XPath::Boolean;
  8         26  
  8         523  
22 8     8   51 our $TRUE = HTML::Object::XPath::Boolean->True;
23 8         32 our $FALSE = HTML::Object::XPath::Boolean->False;
24 8         19 our $BASE_CLASS = 'HTML::Object::XPath';
25 8         13 our $DEBUG = 0;
26 8         149 our $VERSION = 'v0.2.0';
27             };
28              
29 8     8   57 use strict;
  8         27  
  8         140  
30 8     8   45 use warnings;
  8         20  
  8         26516  
31              
32             sub init
33             {
34 255     255 1 20500 my $self = shift( @_ );
35             # XPath Parser -> HTML::Object::XPath
36 255         391 my $pp = shift( @_ );
37 255         910 $self->{pp} = $pp;
38 255         665 $self->{predicates} = [];
39 255         506 $self->{_init_strict_use_sub} = 1;
40 255 50       791 $self->SUPER::init( @_ ) || return( $self->pass_error );
41 255         16031 return( $self );
42             }
43              
44             sub as_string
45             {
46 0     0 1 0 my $self = shift( @_ );
47             # Use of uninitialized value! grrr
48             # local $^W;
49 0         0 my $string = '(' . $self->{lhs}->as_string;
50 0 0       0 $string .= ' ' . $self->{op} . ' ' if( defined( $self->{op} ) );
51 0 0       0 $string .= $self->{rhs}->as_string if( defined( $self->{rhs} ) );
52 0         0 $string .= ')';
53 0         0 foreach my $predicate ( @{$self->{predicates}} )
  0         0  
54             {
55 0         0 $string .= '[' . $predicate->as_string . ']';
56             }
57 0         0 return( $string );
58             }
59              
60             sub as_xml
61             {
62 0     0 1 0 my $self = shift( @_ );
63             # Use of uninitialized value! grrr
64             # local $^W;
65 0         0 my $string;
66 0 0       0 if( defined( $self->{op} ) )
67             {
68 0         0 $string .= $self->op_xml();
69             }
70             else
71             {
72 0         0 $string .= $self->{lhs}->as_xml();
73             }
74 0         0 foreach my $predicate ( @{$self->{predicates}} )
  0         0  
75             {
76 0         0 $string .= "<Predicate>\n" . $predicate->as_xml() . "</Predicate>\n";
77             }
78 0         0 return( $string );
79             }
80              
81             sub evaluate
82             {
83 673     673 1 1103 my $self = shift( @_ );
84             # HTML::Object::XPath::NodeSet
85 673         938 my $node = shift( @_ );
86            
87             # If there's an op, result is result of that op.
88             # If no op, just resolve Expr
89            
90             # warn "Evaluate Expr: ", $self->as_string, "\n";
91            
92 673         871 my $results;
93            
94 673 100       1723 if( $self->{op} )
95             {
96 162 50       509 die( "No RHS of ", $self->as_string ) unless( $self->{rhs} );
97 162         421 $results = $self->op_eval( $node );
98             }
99             else
100             {
101             # HTML::Object::XPath::LocationPath
102 511         2007 $results = $self->{lhs}->evaluate( $node );
103             }
104            
105 667 100       5851 if( !$self->predicates->is_empty )
106             {
107 2 50       1172 if( !$self->_is_a( $results => 'HTML::Object::XPath::NodeSet' ) )
108             {
109 0         0 die( "Can't have predicates execute on object type: " . ref( $results ) );
110             }
111            
112             # filter initial nodeset by each predicate
113 2         77 foreach my $predicate ( @{$self->{predicates}} )
  2         8  
114             {
115 2         8 $results = $self->filter_by_predicate( $results, $predicate );
116             }
117             }
118 667         408690 return( $results );
119             }
120              
121             sub filter_by_predicate
122             {
123 2     2 1 5 my $self = shift( @_ );
124 2         7 my( $nodeset, $predicate ) = @_;
125            
126             # See spec section 2.4, paragraphs 2 & 3:
127             # For each node in the node-set to be filtered, the predicate Expr
128             # is evaluated with that node as the context node, with the number
129             # of nodes in the node set as the context size, and with the
130             # proximity position of the node in the node set with respect to
131             # the axis as the context position.
132            
133             # use ref because nodeset has a bool context
134 2 50       8 if( !ref( $nodeset ) )
135             {
136 0         0 die( "No nodeset!!!" );
137             }
138            
139             # warn "Filter by predicate: $predicate\n";
140            
141 2         10 my $newset = $self->new_nodeset->new();
142            
143 2         7 for( my $i = 1; $i <= $nodeset->size; $i++ )
144             {
145             # set context set each time 'cos a loc-path in the expr could change it
146 18         63 $self->{pp}->_set_context_set( $nodeset );
147 18         16052 $self->{pp}->_set_context_pos( $i );
148 18         15710 my $result = $predicate->evaluate( $nodeset->get_node( $i ) );
149 18 50       57 if( $self->_is_a( $result => 'HTML::Object::XPath::Boolean' ) )
    50          
150             {
151 0 0       0 if( $result->value )
152             {
153 0         0 $newset->push( $nodeset->get_node( $i ) );
154             }
155             }
156             elsif( $self->_is_a( $result => 'HTML::Object::XPath::Number' ) )
157             {
158 18 100       1025 if( $result->value == $i )
159             {
160 2         8 $newset->push( $nodeset->get_node( $i ) );
161             }
162             }
163             else
164             {
165 0 0       0 if( $result->to_boolean->value )
166             {
167 0         0 $newset->push( $nodeset->get_node( $i ) );
168             }
169             }
170             }
171 2         9 return( $newset );
172             }
173              
174 0     0 1 0 sub get_lhs { return( $_[0]->{lhs} ); }
175              
176 0     0 1 0 sub get_rhs { return( $_[0]->{rhs} ); }
177              
178 0     0 1 0 sub get_op { return( $_[0]->{op} ); }
179              
180 0     0 1 0 sub new_literal { return( shift->_class_for( 'Literal' )->new( @_ ) ); }
181              
182 2     2 1 10 sub new_nodeset { return( shift->_class_for( 'NodeSet' )->new( @_ ) ); }
183              
184 0     0 1 0 sub new_number { return( shift->_class_for( 'Number' )->new( @_ ) ); }
185              
186             sub op_and
187             {
188 10     10 1 19 my $self = shift( @_ );
189 10         24 my( $node, $lhs, $rhs ) = @_;
190 10 50       28 if( ! $lhs->evaluate( $node )->to_boolean->value )
191             {
192 0         0 return( $FALSE );
193             }
194             else
195             {
196 10         31 return( $rhs->evaluate( $node )->to_boolean );
197             }
198             }
199              
200             sub op_div
201             {
202 0     0 1 0 my $self = shift( @_ );
203 0         0 my( $node, $lhs, $rhs ) = @_;
204 0         0 my $lh_results = $lhs->evaluate( $node );
205 0         0 my $rh_results = $rhs->evaluate( $node );
206              
207 0         0 my $result = eval{ $lh_results->to_number->value / $rh_results->to_number->value; };
  0         0  
208 0 0       0 if( $@ )
209             {
210             # assume divide by zero
211             # This is probably a terrible way to handle this!
212             # Ah well... who wants to live forever...
213 0         0 return( $self->new_literal( 'Infinity' ) );
214             }
215 0         0 return( $self->new_number( $result ) );
216             }
217              
218             sub op_equals
219             {
220 99     99 1 200 my $self = shift( @_ );
221 99         202 my( $node, $lhs, $rhs ) = @_;
222              
223 99         227 my $lh_results = $lhs->evaluate( $node );
224 99         302 my $rh_results = $rhs->evaluate( $node );
225            
226 96 50 66     1765 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) &&
    100 66        
      33        
      66        
227             $rh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
228             {
229             # True if and only if there is a node in the
230             # first set and a node in the second set such
231             # that the result of performing the comparison
232             # on the string-values of the two nodes is true.
233 0         0 foreach my $lhnode ( $lh_results->get_nodelist )
234             {
235 0         0 foreach my $rhnode ( $rh_results->get_nodelist )
236             {
237 0 0       0 if( $lhnode->string_value eq $rhnode->string_value )
238             {
239 0         0 return( $TRUE );
240             }
241             }
242             }
243 0         0 return( $FALSE );
244             }
245             elsif( ( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) ||
246             $rh_results->isa( 'HTML::Object::XPath::NodeSet' ) ) &&
247             ( !$lh_results->isa( 'HTML::Object::XPath::NodeSet' ) ||
248             !$rh_results->isa( 'HTML::Object::XPath::NodeSet' ) ) )
249             {
250             # (that says: one is a nodeset, and one is not a nodeset)
251 89         191 my( $nodeset, $other );
252 89 50       266 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
253             {
254 89         138 $nodeset = $lh_results;
255 89         135 $other = $rh_results;
256             }
257             else
258             {
259 0         0 $nodeset = $rh_results;
260 0         0 $other = $lh_results;
261             }
262            
263             # True if and only if there is a node in the
264             # nodeset such that the result of performing
265             # the comparison on <type>(string_value($node))
266             # is true.
267 89 100       376 if( $self->_is_a( $other => 'HTML::Object::XPath::Number' ) )
    50          
    0          
268             {
269 5         165 foreach my $node ( $nodeset->get_nodelist )
270             {
271 5 100       18 if( $node->string_value == $other->value )
272             {
273 3         14 return( $TRUE );
274             }
275             }
276             }
277             elsif( $self->_is_a( $other => 'HTML::Object::XPath::Literal' ) )
278             {
279 84         5327 foreach my $node ( $nodeset->get_nodelist )
280             {
281 59 100       238 if( $node->string_value eq $other->value )
282             {
283 35         230 return( $TRUE );
284             }
285             }
286             }
287             elsif( $self->_is_a( $other => 'HTML::Object::XPath::Boolean' ) )
288             {
289 0 0       0 if( $nodeset->to_boolean->value == $other->value )
290             {
291 0         0 return( $TRUE );
292             }
293             }
294 51         269 return( $FALSE );
295             }
296             # Neither is a nodeset
297             else
298             {
299 7 50 33     81 if( $lh_results->isa( 'HTML::Object::XPath::Boolean' ) ||
    50 33        
300             $rh_results->isa( 'HTML::Object::XPath::Boolean' ) )
301             {
302             # if either is a boolean
303 0 0       0 if( $lh_results->to_boolean->value == $rh_results->to_boolean->value )
304             {
305 0         0 return( $TRUE );
306             }
307 0         0 return( $FALSE );
308             }
309             elsif( $lh_results->isa( 'HTML::Object::XPath::Number' ) ||
310             $rh_results->isa( 'HTML::Object::XPath::Number' ) )
311             {
312             # if either is a number
313             # 'number' might result in undef
314 7         42 local $^W;
315 7 100       28 if ($lh_results->to_number->value == $rh_results->to_number->value )
316             {
317 3         25 return( $TRUE );
318             }
319 4         32 return( $FALSE );
320             }
321             else
322             {
323 0 0       0 if( $lh_results->to_literal->value eq $rh_results->to_literal->value )
324             {
325 0         0 return( $TRUE );
326             }
327 0         0 return( $FALSE );
328             }
329             }
330             }
331              
332             sub op_eval
333             {
334 162     162 1 280 my $self = shift( @_ );
335 162         217 my $node = shift( @_ );
336 162         280 my $op = $self->{op};
337 162         1877 my $map =
338             {
339             'or' => 'op_or',
340             'and' => 'op_and',
341             '=~' => 'op_match',
342             '!~' => 'op_not_match',
343             '=' => 'op_equals',
344             '!=' => 'op_nequals',
345             '<=' => 'op_le',
346             '>=' => 'op_ge',
347             '>' => 'op_gt',
348             '<' => 'op_lt',
349             '+' => 'op_plus',
350             '-' => 'op_minus',
351             'div' => 'op_div',
352             'mod' => 'op_mod',
353             '*' => 'op_mult',
354             '|' => 'op_union',
355             };
356 162 50       441 die( "No such operator, or operator unimplemented in ", $self->as_string, "\n" ) if( !CORE::exists( $map->{ $op } ) );
357 162         309 my $mod = $map->{ $op };
358 162         614 return( $self->$mod( $node, $self->{lhs}, $self->{rhs} ) );
359             }
360              
361             sub op_ge
362             {
363 0     0 1 0 my $self = shift( @_ );
364 0         0 my( $node, $lhs, $rhs ) = @_;
365              
366 0         0 my $lh_results = $lhs->evaluate( $node );
367 0         0 my $rh_results = $rhs->evaluate( $node );
368            
369 0 0 0     0 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) &&
    0 0        
      0        
      0        
370             $rh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
371             {
372 0         0 foreach my $lhnode ( $lh_results->get_nodelist )
373             {
374 0         0 foreach my $rhnode ( $rh_results->get_nodelist )
375             {
376 0         0 my $lhNum = $self->new_number( $lhnode->string_value );
377 0         0 my $rhNum = $self->new_number( $rhnode->string_value );
378 0 0       0 if( $lhNum->value >= $rhNum->value )
379             {
380 0         0 return( $TRUE );
381             }
382             }
383             }
384 0         0 return( $FALSE );
385             }
386             elsif( ( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) ||
387             $rh_results->isa( 'HTML::Object::XPath::NodeSet' ) ) &&
388             ( !$lh_results->isa( 'HTML::Object::XPath::NodeSet' ) ||
389             !$rh_results->isa( 'HTML::Object::XPath::NodeSet' ) ) )
390             {
391             # (that says: one is a nodeset, and one is not a nodeset)
392 0 0       0 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
393             {
394 0         0 foreach my $node ( $lh_results->get_nodelist )
395             {
396 0 0       0 if( $node->to_number->value >= $rh_results->to_number->value )
397             {
398 0         0 return( $TRUE );
399             }
400             }
401             }
402             else
403             {
404 0         0 foreach my $node ( $rh_results->get_nodelist )
405             {
406 0 0       0 if( $lh_results->to_number->value >= $node->to_number->value )
407             {
408 0         0 return( $TRUE );
409             }
410             }
411             }
412 0         0 return( $FALSE );
413             }
414             # Neither is a nodeset
415             else
416             {
417 0 0 0     0 if( $lh_results->isa( 'HTML::Object::XPath::Boolean' ) ||
418             $rh_results->isa( 'HTML::Object::XPath::Boolean' ) )
419             {
420             # if either is a boolean
421 0 0       0 if( $lh_results->to_boolean->to_number->value >= $rh_results->to_boolean->to_number->value )
422             {
423 0         0 return( $TRUE );
424             }
425             }
426             else
427             {
428 0 0       0 if( $lh_results->to_number->value >= $rh_results->to_number->value )
429             {
430 0         0 return( $TRUE );
431             }
432             }
433 0         0 return( $FALSE );
434             }
435             }
436              
437             sub op_gt
438             {
439 1     1 1 5 my $self = shift( @_ );
440 1         3 my( $node, $lhs, $rhs ) = @_;
441              
442 1         4 my $lh_results = $lhs->evaluate( $node );
443 1         5 my $rh_results = $rhs->evaluate( $node );
444            
445 1 50 33     34 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) &&
    50 33        
      0        
      33        
446             $rh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
447             {
448 0         0 foreach my $lhnode ( $lh_results->get_nodelist )
449             {
450 0         0 foreach my $rhnode ( $rh_results->get_nodelist )
451             {
452 0         0 my $lhNum = $self->new_number( $lhnode->string_value );
453 0         0 my $rhNum = $self->new_number( $rhnode->string_value );
454 0 0       0 if( $lhNum->value > $rhNum->value )
455             {
456 0         0 return( $TRUE );
457             }
458             }
459             }
460 0         0 return( $FALSE );
461             }
462             elsif( ( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) ||
463             $rh_results->isa( 'HTML::Object::XPath::NodeSet' ) ) &&
464             ( !$lh_results->isa( 'HTML::Object::XPath::NodeSet' ) ||
465             !$rh_results->isa( 'HTML::Object::XPath::NodeSet' ) ) )
466             {
467             # (that says: one is a nodeset, and one is not a nodeset)
468 0 0       0 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
469             {
470 0         0 foreach my $node ( $lh_results->get_nodelist )
471             {
472 0 0       0 if( $node->to_number->value > $rh_results->to_number->value )
473             {
474 0         0 return( $TRUE );
475             }
476             }
477             }
478             else
479             {
480 0         0 foreach my $node ( $rh_results->get_nodelist )
481             {
482 0 0       0 if( $lh_results->to_number->value > $node->to_number->value )
483             {
484 0         0 return( $TRUE );
485             }
486             }
487             }
488 0         0 return( $FALSE );
489             }
490             # Neither is a nodeset
491             else
492             {
493 1 50 33     11 if( $lh_results->isa( 'HTML::Object::XPath::Boolean' ) ||
494             $rh_results->isa( 'HTML::Object::XPath::Boolean' ) )
495             {
496             # if either is a boolean
497 0 0       0 if( $lh_results->to_boolean->value > $rh_results->to_boolean->value )
498             {
499 0         0 return( $TRUE );
500             }
501             }
502             else
503             {
504 1 50       4 if( $lh_results->to_number->value > $rh_results->to_number->value )
505             {
506 0         0 return( $TRUE );
507             }
508             }
509 1         10 return( $FALSE );
510             }
511             }
512              
513             sub op_le
514             {
515 0     0 1 0 my $self = shift( @_ );
516 0         0 my( $node, $lhs, $rhs ) = @_;
517 0         0 return( $self->op_ge( $node, $rhs, $lhs ) );
518             }
519              
520             sub op_lt
521             {
522 0     0 1 0 my $self = shift( @_ );
523 0         0 my( $node, $lhs, $rhs ) = @_;
524 0         0 return( $self->op_gt( $node, $rhs, $lhs ) );
525             }
526              
527             sub op_match
528             {
529 47     47 1 76 my $self = shift( @_ );
530 47         110 my( $node, $lhs, $rhs ) = @_;
531              
532 47         85 my $lh_results = $lhs->evaluate( $node );
533 47         124 my $rh_results = $rhs->evaluate( $node );
534 47         152 my $rh_value = $rh_results->string_value;
535              
536 47 50       183 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
537             {
538 47         121 foreach my $lhnode ( $lh_results->get_nodelist )
539             {
540             # / is important here, regexp is / delimited
541 21 100       80 if( $lhnode->string_value =~ m/$rh_value/ )
542             {
543 12         231 return( $TRUE );
544             }
545             }
546 35         283 return( $FALSE );
547             }
548             else
549             {
550             return(
551 0 0       0 $lh_results->string_value =~ m/$rh_value/
552             ? $TRUE
553             : $FALSE
554             );
555             }
556             }
557            
558             sub op_minus
559             {
560 0     0 1 0 my $self = shift( @_ );
561 0         0 my( $node, $lhs, $rhs ) = @_;
562 0         0 my $lh_results = $lhs->evaluate( $node );
563 0         0 my $rh_results = $rhs->evaluate( $node );
564            
565 0         0 my $result = $lh_results->to_number->value - $rh_results->to_number->value;
566 0         0 return( $self->new_number( $result ) );
567             }
568              
569             sub op_mod
570             {
571 0     0 1 0 my $self = shift( @_ );
572 0         0 my( $node, $lhs, $rhs ) = @_;
573 0         0 my $lh_results = $lhs->evaluate( $node );
574 0         0 my $rh_results = $rhs->evaluate( $node );
575            
576 0         0 my $result = $lh_results->to_number->value % $rh_results->to_number->value;
577 0         0 return( $self->new_number( $result ) );
578             }
579              
580             sub op_mult
581             {
582 0     0 1 0 my $self = shift( @_ );
583 0         0 my( $node, $lhs, $rhs ) = @_;
584 0         0 my $lh_results = $lhs->evaluate( $node );
585 0         0 my $rh_results = $rhs->evaluate( $node );
586            
587 0         0 my $result = $lh_results->to_number->value * $rh_results->to_number->value;
588 0         0 return( $self->new_number( $result ) );
589             }
590              
591             sub op_nequals
592             {
593 0     0 1 0 my $self = shift( @_ );
594 0         0 my( $node, $lhs, $rhs ) = @_;
595 0 0       0 if( $self->op_equals( $node, $lhs, $rhs)->value )
596             {
597 0         0 return( $FALSE );
598             }
599 0         0 return( $TRUE );
600             }
601              
602             sub op_not_match
603             {
604 0     0 1 0 my $self = shift( @_ );
605 0         0 my( $node, $lhs, $rhs ) = @_;
606              
607 0         0 my $lh_results = $lhs->evaluate( $node );
608 0         0 my $rh_results = $rhs->evaluate( $node );
609 0         0 my $rh_value = $rh_results->string_value;
610            
611 0 0       0 if( $lh_results->isa( 'HTML::Object::XPath::NodeSet' ) )
612             {
613 0         0 foreach my $lhnode ( $lh_results->get_nodelist )
614             {
615 0 0       0 if( $lhnode->string_value !~ m/$rh_value/ )
616             {
617 0         0 return( $TRUE );
618             }
619             }
620 0         0 return( $FALSE );
621             }
622             else
623             {
624 0 0       0 return( $lh_results->string_value !~ m/$rh_value/ ? $TRUE : $FALSE );
625             }
626             }
627              
628             sub op_or
629             {
630 5     5 1 9 my $self = shift( @_ );
631 5         8 my( $node, $lhs, $rhs ) = @_;
632 5 50       12 if( $lhs->evaluate( $node )->to_boolean->value )
633             {
634 5         27 return( $TRUE );
635             }
636             else
637             {
638 0         0 return $rhs->evaluate( $node )->to_boolean;
639             }
640             }
641              
642             sub op_plus
643             {
644 0     0 1 0 my $self = shift( @_ );
645 0         0 my( $node, $lhs, $rhs ) = @_;
646 0         0 my $lh_results = $lhs->evaluate( $node );
647 0         0 my $rh_results = $rhs->evaluate( $node );
648            
649 0         0 my $result = $lh_results->to_number->value + $rh_results->to_number->value;
650 0         0 return( $self->new_number( $result ) );
651             }
652              
653             sub op_union
654             {
655 0     0 1 0 my $self = shift( @_ );
656 0         0 my( $node, $lhs, $rhs ) = @_;
657 0         0 my $lh_result = $lhs->evaluate( $node );
658 0         0 my $rh_result = $rhs->evaluate( $node );
659            
660 0 0 0     0 if( $lh_result->isa( 'HTML::Object::XPath::NodeSet' ) &&
661             $rh_result->isa( 'HTML::Object::XPath::NodeSet' ) )
662             {
663 0         0 my %found;
664 0         0 my $results = $self->new_nodeset;
665 0         0 foreach my $lhnode ( $lh_result->get_nodelist )
666             {
667 0         0 $found{ "$lhnode" }++;
668 0         0 $results->push( $lhnode );
669             }
670 0         0 foreach my $rhnode ( $rh_result->get_nodelist )
671             {
672 0 0       0 $results->push( $rhnode ) unless( exists( $found{ "$rhnode" } ) );
673             }
674 0         0 return( $results->sort->remove_duplicates );
675             }
676 0         0 die( "Both sides of a union must be Node Sets\n" );
677             }
678              
679             sub op_xml
680             {
681 0     0 1 0 my $self = shift( @_ );
682 0         0 my $op = $self->{op};
683              
684 0         0 my $map =
685             {
686             'and' => 'And',
687             'div' => 'Div',
688             'mod' => 'Mod',
689             'or' => 'Or',
690             '=' => 'Equals',
691             '!=' => 'NotEquals',
692             '<=' => 'LessThanOrEquals',
693             '>=' => 'GreaterThanOrEquals',
694             '>' => 'GreaterThan',
695             '<' => 'LessThan',
696             '+' => 'Plus',
697             '-' => 'Minus',
698             '*' => 'Multiply',
699             '|' => 'Union',
700             };
701 0 0       0 die( "No tag equivalent for operator \"$op\".\n" ) if( !CORE::exists( $map->{ $op } ) );
702 0         0 my $tag = $map->{ $op };
703 0         0 return( "<$tag>\n" . $self->{lhs}->as_xml() . $self->{rhs}->as_xml() . "</$tag>\n" );
704             }
705              
706 671     671 1 2034 sub predicates { return( shift->_set_get_array_as_object( 'predicates', @_ ) ); }
707              
708             sub push_predicate
709             {
710 2     2 1 4 my $self = shift( @_ );
711            
712 2 50       5 die( "Only 1 predicate allowed on FilterExpr in W3C XPath 1.0" ) if( @{$self->{predicates}} );
  2         9  
713             # push( @{$self->{predicates}}, $_[0] );
714 2         7 $self->predicates->push( $_[0] );
715             # Need to return $self
716             # return( $self );
717 2         1278 return( $self->predicates->length );
718             }
719              
720             sub set_lhs
721             {
722 186     186 1 351 my $self = shift( @_ );
723 186         815 $self->{lhs} = $_[0];
724             }
725              
726             sub set_op
727             {
728 28     28 1 68 my $self = shift( @_ );
729 28         96 $self->{op} = $_[0];
730             }
731              
732             sub set_rhs
733             {
734 28     28 1 65 my $self = shift( @_ );
735 28         103 $self->{rhs} = $_[0];
736             }
737              
738             sub _class_for
739             {
740 2     2   5 my( $self, $mod ) = @_;
741 2         95 eval( "require ${BASE_CLASS}\::${mod};" );
742 2 50       13 die( $@ ) if( $@ );
743             # ${"${BASE_CLASS}\::${mod}\::DEBUG"} = $DEBUG;
744 2   50     83 eval( "\$${BASE_CLASS}\::${mod}\::DEBUG = " . ( $DEBUG // 0 ) );
745 2         22 return( "${BASE_CLASS}::${mod}" );
746             }
747              
748             1;
749             # NOTE: POD
750             __END__
751              
752             =encoding utf-8
753              
754             =head1 NAME
755              
756             HTML::Object::XPath::Expr - HTML Object XPath Expression
757              
758             =head1 SYNOPSIS
759              
760             use HTML::Object::XPath::Expr;
761             my $this = HTML::Object::XPath::Expr->new || die( HTML::Object::XPath::Expr->error, "\n" );
762              
763             =head1 VERSION
764              
765             v0.2.0
766              
767             =head1 DESCRIPTION
768              
769             This modules represents an L<HTML::Object::XPath> expression.
770              
771             =head1 METHODS
772              
773             =head2 new
774              
775             Provided with an L<HTML::Object::XPath> object and this returns a new L<HTML::Object::XPath::Expr> object.
776              
777             =head2 as_string
778              
779             Returns the expression as a string.
780              
781             =head2 as_xml
782              
783             Returns the expression as xml.
784              
785             =head2 evaluate
786              
787             Provided with a L<HTML::Object::XPath::NodeSet> object, and this will call L</op_eval> with an L<operator|/op> has been set, otherwise, it calls L<HTML::Object::XPath::LocationPath/evaluate> passing it the node set. It returns the result from either call.
788              
789             =head2 filter_by_predicate
790              
791             This takes a nodeset object and a predicate.
792              
793             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.
794              
795             It returns a new L<node set|HTML::Object::XPath::NodeSet> object.
796              
797             =head2 get_lhs
798              
799             Returns the L<HTML::Object::XPath::LocationPath> object for the left-hand side of the expression.
800              
801             =head2 get_rhs
802              
803             Returns the L<HTML::Object::XPath::LocationPath> object for the right-hand side of the expression.
804              
805             =head2 get_op
806              
807             Returns the current operator set for this expression.
808              
809             =head2 new_literal
810              
811             Returns a new L<literal object|HTML::Object::XPath::Literal>, passing it whatever argument was provided.
812              
813             =head2 new_nodeset
814              
815             Returns a new L<node set object|HTML::Object::XPath::NodeSet>, passing it whatever argument was provided.
816              
817             =head2 new_number
818              
819             Returns a new L<number object|HTML::Object::XPath::Number>, passing it whatever argument was provided.
820              
821             =head2 op_and
822              
823             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will evaluate the node using the left-hand side LocationPath object, and return L<false|HTML::Object::XPath::Boolean> if it failed, or otherwise it wil evaluate the node using the right-hand side LocationPath object and return its result.
824              
825             =head2 op_div
826              
827             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will attempt to divide the left-hand value by the right-hand value. If ther eis an error, it returns L<infinity|HTML::Object::XPath::Number>, otherwise it returns the value from the division as a L<number object|HTML::Object::XPath::Number>.
828              
829             =head2 op_equals
830              
831             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will check if the left-hand side LocationPath is equal tot he right-hand side LocationPath. Returns L<true|HTML::Object::XPath::Boolean> or L<false|HTML::Object::XPath::Boolean>
832              
833             =head2 op_eval
834              
835             This method will evaluate the L<node|HTML::Object::ELement> provided with the left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> object also specified by calling the appropriate method in this module based on the operator value set with L</op>
836              
837             =head2 op_ge
838              
839             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will check if the left-hand side is greater or equal to the right-hand side.
840              
841             Returns L<true|HTML::Object::XPath::Boolean> or L<false|HTML::Object::XPath::Boolean>
842              
843             =head2 op_gt
844              
845             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will check if the left-hand side is greater than the right-hand side.
846              
847             Returns L<true|HTML::Object::XPath::Boolean> or L<false|HTML::Object::XPath::Boolean>
848              
849             =head2 op_le
850              
851             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will check if the left-hand side is lower or equal than the right-hand side.
852              
853             Returns L<true|HTML::Object::XPath::Boolean> or L<false|HTML::Object::XPath::Boolean>
854              
855             =head2 op_lt
856              
857             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will check if the left-hand side is lower than the right-hand side.
858              
859             Returns L<true|HTML::Object::XPath::Boolean> or L<false|HTML::Object::XPath::Boolean>
860              
861             =head2 op_match
862              
863             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will check if the left-hand side match the right-hand side as a regular expression.
864              
865             Returns L<true|HTML::Object::XPath::Boolean> or L<false|HTML::Object::XPath::Boolean>
866              
867             =head2 op_minus
868              
869             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will subtract the right-hand side from the left-hand side and return the result as a L<number object|HTML::Object::XPath::Number>.
870              
871             =head2 op_mod
872              
873             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will get the modulo between the left-hand side and the right-hand side and return the result as a L<number object|HTML::Object::XPath::Number>.
874              
875             =head2 op_mult
876              
877             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will multiply the right-hand side by the left-hand side and return the result as a L<number object|HTML::Object::XPath::Number>.
878              
879             =head2 op_nequals
880              
881             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will return L<true|HTML::Object::XPath::Boolean> if the left-hand side is not equal to the right-hand side, or L<false|HTML::Object::XPath::Boolean> otherwise.
882              
883             =head2 op_not_match
884              
885             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will check if the left-hand side does B<not> match the right-hand side as a regular expression.
886              
887             Returns L<true|HTML::Object::XPath::Boolean> or L<false|HTML::Object::XPath::Boolean>
888              
889             =head2 op_or
890              
891             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will evaluate the node using the left-hand side LocationPath and return L<true|HTML::Object::XPath::Boolean> if it worked, or otherwise return the value from evaluating the node using the right-hand side LocationPath.
892              
893             =head2 op_plus
894              
895             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will add the right-hand side to the left-hand side and return the result as a L<number object|HTML::Object::XPath::Number>.
896              
897             =head2 op_union
898              
899             Provided a L<node object|HTML::Object:Element>, a left-hand side and right-hand side L<LocationPath objects|HTML::Object::XPath::LocationPath> and this will evaluate the node both by the left-hand side and right-hand side LocationPath and return a new L<node set array object|HTML::Object::XPath::NodeSet> containing all the unique nodes resulting from those both evaluation.
900              
901             =head2 op_xml
902              
903             Provided with an operator and this returns its xml equivalent.
904              
905             Operators supported are: C<and>, C<div>, C<mod>, C<or>, C<=>, C<!=>, C<<=>, C<>=>, C<>>, C<<>, C<+>, C<->, C<*>, C<|>
906              
907             They will be converted respectively to: C<And>, C<Div>, C<Mod>, C<Or>, C<Equals>, C<NotEquals>, C<LessThanOrEquals>, C<GreaterThanOrEquals>, C<GreaterThan>, C<LessThan>, C<Plus>, C<Minus>, C<Multiply>, C<Union>
908              
909             =head2 predicates
910              
911             Set or get the predicates as an L<array object|Module::Generic::Array>
912              
913             =head2 push_predicate
914              
915             Add the predicate to the list and will raise an exception if more than one predicate was provided.
916              
917             =head2 set_lhs
918              
919             Set the left-hand side L<LocationPath|HTML::Object::XPath::LocationPath>
920              
921             =head2 set_op
922              
923             Set the operator for this expression.
924              
925             =head2 set_rhs
926              
927             Set the right-hand side L<LocationPath|HTML::Object::XPath::LocationPath>
928              
929             =head1 AUTHOR
930              
931             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
932              
933             =head1 SEE ALSO
934              
935             L<HTML::Object::XPath>, L<HTML::Object::XPath::Boolean>, L<HTML::Object::XPath::Expr>, L<HTML::Object::XPath::Function>, L<HTML::Object::XPath::Literal>, L<HTML::Object::XPath::LocationPath>, L<HTML::Object::XPath::NodeSet>, L<HTML::Object::XPath::Number>, L<HTML::Object::XPath::Root>, L<HTML::Object::XPath::Step>, L<HTML::Object::XPath::Variable>
936              
937             =head1 COPYRIGHT & LICENSE
938              
939             Copyright(c) 2021 DEGUEST Pte. Ltd.
940              
941             All rights reserved
942              
943             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
944              
945             =cut