File Coverage

lib/HTML/Object/XQuery.pm
Criterion Covered Total %
statement 369 1853 19.9
branch 133 1394 9.5
condition 54 632 8.5
subroutine 61 186 32.8
pod 35 70 50.0
total 652 4135 15.7


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/XQuery.pm
3             ## Version v0.2.1
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/05/01
7             ## Modified 2023/05/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::XQuery;
15             BEGIN
16             {
17 3     3   7463 use strict;
  3         9  
  3         108  
18 3     3   28 use warnings;
  3         16  
  3         143  
19 3     3   22 use parent qw( HTML::Object::DOM );
  3         6  
  3         37  
20 3     3   227 use vars qw( @EXPORT $DEBUG $VERSION );
  3         11  
  3         265  
21 3     3   20 our @EXPORT = qw( xq );
22 3         14 our $DEBUG = 0;
23 3         79 our $VERSION = 'v0.2.1';
24             };
25              
26 3     3   18 use strict;
  3         14  
  3         65  
27 3     3   39 use warnings;
  3         5  
  3         97  
28              
29             {
30 3     3   16 no warnings 'once';
  3         9  
  3         435  
31             *xq = \&HTML::Object::DOM::Element::xq;
32             }
33              
34             # NOTE: HTML::Object::DOM::Element class
35             package HTML::Object::DOM::Element;
36             BEGIN
37             {
38 3     3   21 use strict;
  3         9  
  3         113  
39 3     3   20 use warnings;
  3         11  
  3         147  
40 3     3   17 use vars qw( $XP $LOOK_LIKE_HTML $VERSION );
  3         7  
  3         212  
41 3     3   1761 use CSS::Object;
  3         60225  
  3         33  
42 3     3   1844 use HTML::Object::Collection;
  3         11  
  3         55  
43 3     3   1590 use HTML::Object::DOM::Attribute;
  3         8  
  3         34  
44 3     3   1580 use HTML::Object::DOM::Boolean;
  3         14  
  3         44  
45 3     3   814 use HTML::Object::DOM::Document;
  3         5  
  3         30  
46 3     3   1603 use HTML::Object::DOM::Number;
  3         12  
  3         45  
47 3     3   1594 use HTML::Object::DOM::Root;
  3         7  
  3         40  
48             # use HTML::Object::DOM::Text;
49 3     3   2323 use HTML::Selector::XPath 0.20 qw( selector_to_xpath );
  3         9345  
  3         296  
50 3     3   24 use List::Util ();
  3         6  
  3         100  
51 3     3   16 use Nice::Try;
  3         6  
  3         38  
52             # use Promise::XS ();
53             # use Promise::Me;
54 3     3   19315352 use HTML::Object::XPath;
  3         8  
  3         37  
55             use overload (
56 3         53 'eq' => \&_same_as,
57             '==' => \&_same_as,
58             fallback => 1,
59 3     3   1190 );
  3         8  
60 3     3   589 our $XP;
61             # As perl jQuery documentation
62 3         103 our $LOOK_LIKE_HTML = qr/^[[:blank:]\h]*\<\w+.*?\>/;
63             };
64              
65 3     3   21 no warnings 'redefine';
  3         5  
  3         15655  
66              
67             # Takes a selector (e.g. '.some-class'); or
68             # a collection (i.e. one or more elements resulting from a find or equivalent query); or
69             # "HTML fragment to add to the set of matched elements."; or
70             # a selector and a context (i.e. an element object); or
71             # a element object
72             # $self->add( $selector );
73             # $self->add( $elements );
74             # $self->add( $html );
75             # $self->add( $selector, $context );
76             sub add
77             {
78 2     2 0 8 my $self = shift( @_ );
79 2         6 my( $this, $context ) = @_;
80             # Compliant with what jQuery does, i.e. when no argument is provide this just returns a collection of the collecting object
81 2         18 my $collection = $self->new_collection( end => $self );
82             # if( $self->isa_element && !$self->isa_collection )
83 2 50       10 if( $self->isa_collection )
    0          
84             {
85 2         11 $collection->children( $self->children );
86             }
87             elsif( $self->isa_element )
88             {
89 0         0 $collection->children->push( $self );
90             }
91            
92 2 50 33     419 if( !defined( $this ) )
    50          
    0          
93             {
94 0         0 return( $collection )
95             }
96             # e.g.: $( "p" ).add( "div" )
97             # $( "li" ).add( "<p id='new'>new paragraph</p>" )
98             # elsif( !ref( $this ) || ( ref( $this ) && overload::Overloaded( $this ) && overload::Method( $this, '""' ) ) )
99             elsif( !ref( $this ) || overload::Method( $this, '""' ) )
100             {
101             # https://api.jquery.com/Types/#htmlString
102             # $( "li" ).add( "<p id='new'>new paragraph</p>" )
103 2 50       27 if( "$this" =~ /$LOOK_LIKE_HTML/ )
104             {
105 0         0 my $p = $self->new_parser;
106 0   0     0 $this = $p->parse_data( "$this" ) || return( $self->pass_error( $p->error ) );
107             }
108             # selector
109             # $( "p" ).add( "div" )
110             else
111             {
112             # $self->add( $selector, $context );
113 2 50       11 if( defined( $context ) )
    50          
114             {
115 0 0 0     0 return( $self->error( "A context has been provided, but it is not an HTML::Object::DOM::Element." ) ) if( !$self->_is_object( $context ) || !$context->isa( 'HTML::Object::DOM::Element' ) );
116 0   0     0 $this = $context->find( "$this" ) || return( $self->pass_error( $context->error ) );
117             }
118             # $self->add( $selector );
119             elsif( defined( $HTML::Object::DOM::GLOBAL_DOM ) )
120             {
121 2         8 my $selector = "$this";
122 2   50     11 $this = $HTML::Object::DOM::GLOBAL_DOM->find( "$selector" ) || return( $self->pass_error( $HTML::Object::DOM::GLOBAL_DOM->error ) );
123             }
124             else
125             {
126 0         0 return( $self->error( "You need to provide some context to the selector by supplying an HTML::Object::DOM::Element object." ) );
127             }
128             }
129             }
130             # Some array or hash ref provided maybe ?
131             elsif( !$self->_is_object( $this ) )
132             {
133 0         0 return( $self->error( "I was expecting an HTML::Object::DOM::Element, an HTML::Object::Collection, an html string or a selector., but instead I got '$this'." ) );
134             }
135            
136             # We now have either an element object or a collection of them
137             # We return a new collection either way
138 2 50       11 if( $self->isa_collection( $this ) )
    0          
139             {
140 2         12 $collection->children->merge( $this->children->unique );
141             }
142             elsif( $this->isa( 'HTML::Object::DOM::Element' ) )
143             {
144 0         0 $collection->children->push( $this );
145             }
146             else
147             {
148 0         0 return( $self->error( "An object of class \"", ref( $this ), "\" was provided, but I do not know what to do with it. I was expecting an HTML::Object::DOM::Element, or an HTML::Object::Collection." ) );
149             }
150 2         244 return( $collection );
151             }
152              
153             ## To make it look like really like jQuery
154             sub addClass
155             {
156 1     1 0 312 my( $self, $class ) = @_;
157 1 0 33     11 return( $self->error( "I received a reference to add as a class, but was expecting a string or a code reference." ) ) if( ref( $class ) && ref( $class ) ne 'CODE' && !( overload::Overloaded( $class ) && overload::Method( $class, '""' ) ) );
      0        
      33        
158 1 50       5 $class = "${class}" unless( ref( $class ) CORE::eq 'CODE' );
159 1         2 my $set_attr;
160             $set_attr = sub
161             {
162 1     1   137 my( $i, $e ) = @_;
163 1   50     11 my $v = $e->attr( 'class' ) // '';
164 1         638 local $_ = $e;
165 1 50       12 my $classes = ref( $class ) CORE::eq 'CODE'
166             ? $class->({ element => $e, pos => $i, value => $v })
167             : $class;
168 1 50       5 my $cl_ref = $self->new_array(
    50          
169             $self->_is_array( $classes )
170             ? $classes
171             : CORE::length( "$classes" )
172             ? [split( /[[:blank:]\h]+/, "${classes}" )]
173             : []
174             );
175 1         44 my $curr;
176 1 50       3 if( CORE::length( "${v}" ) )
177             {
178 1 50       5 $curr = $self->_is_a( $v, 'Module::Generic::Array' ) ? $v : $self->new_array( [split( /[[:blank:]\h]+/, $v )] );
179 1         72 my $new = $self->new_array;
180             $cl_ref->foreach(sub
181             {
182             # <http://www.w3.org/TR/CSS21/grammar.html#scanner>
183             # <https://stackoverflow.com/questions/448981/which-characters-are-valid-in-css-class-names-selectors#449000>
184 1 50       20 $new->push( $_ ) if( !$curr->exists( $_ ) );
185 1         41 });
186 1 50       36825 $curr->push( $new->list ) if( $new->length );
187             }
188             else
189             {
190 0         0 $curr = $cl_ref;
191             }
192 1         35933 $e->attr( class => $curr->join( ' ' )->scalar );
193 1         5 $e->reset(1);
194 1         38 };
195            
196 1 50       9 if( $self->isa_collection )
197             {
198 1         7 $self->children->for( $set_attr );
199             }
200             else
201             {
202 0   0     0 my $v = $self->attr( 'class' ) // '';
203             # Here 0 is a dummy number to satisfy the code ref required by for()
204 0         0 $set_attr->( 0, $self );
205             }
206             }
207              
208             # <https://api.jquery.com/after/>
209 2     2 1 353 sub after { return( shift->_before_after( @_, { action => 'after' } ) ); }
210              
211             # Takes html string (start with <tag...), text object (HTML::Object::DOM::Text), array or element object
212             # or alternatively a code reference that returns the above
213             # <https://api.jquery.com/append/>
214 0     0 1 0 sub append { return( shift->_append_prepend( @_, { action => 'append' } ) ); }
215              
216 0     0 0 0 sub appendTo { return( shift->_append_prepend_to( @_, { action => 'append' } ) ); }
217              
218             # $e->attr( attribute );
219             # $collection->attribute( attribute );
220             # $e->attr( attribute1 => value1, attribute2 => value2 );
221             # $collection->attr( attribute1 => value1, attribute2 => value2 );
222             # $e->attr( attribute1 => $sub_routine1, attribute2 => $string );
223             # $collection->attr( attribute1 => $sub_routine1, attribute2 => $string );
224             sub attr
225             {
226 2     2 1 184 my $self = shift( @_ );
227 2         8 my @classes = @_;
228 2 50       7 return if( !scalar( @classes ) );
229 2 100       21 if( scalar( @classes ) > 1 )
230             {
231 1         4 my $ref = {};
232 1         4 %$ref = @classes;
233 1         1 my $set_attributes;
234             $set_attributes = sub
235             {
236 1     1   4 my $e = shift( @_ );
237 1         9 while( my( $a, $v ) = each( %$ref ) )
238             {
239 1         3 local $_ = $e;
240 1 50       6 my $val = ref( $v ) CORE::eq 'CODE'
241             ? $v->({ element => $e, attribute => $a, current => $e->attributes->get( $a ) })
242             : $v;
243 1 50 0     6 return( $self->error( "I was expecting a string value for the attribute \"${a}\", but instead got \"", overload::StrVal( $val ), "\"." ) ) if( ref( $val ) && !( overload::Overloaded( $val ) && overload::Method( $val, '""' ) ) );
      33        
244 1 50       4 if( defined( $val ) )
245             {
246 1         3 $val = "$val";
247 1         6 $val =~ s/^[[:blank:]\h]+|[[:blank:]\h]+$//g;
248 1         5 $e->attributes->set( $a => $val );
249             }
250             else
251             {
252 0         0 $e->attributes->delete( $a );
253             }
254             }
255 1         563 return(1);
256 1         26 };
257            
258 1 50       8 if( $self->isa_collection )
259             {
260             $self->children->foreach(sub
261             {
262 0     0   0 my $e = shift( @_ );
263 0         0 $e->reset(1);
264             # $e->attributes->merge( $ref );
265 0 0       0 $set_attributes->( $e ) || return( $self->pass_error );
266 0         0 });
267             }
268             else
269             {
270 1         8 $self->reset(1);
271 1 50       4 $set_attributes->( $self ) || return( $self->pass_error );
272             }
273 1         9 return( $self );
274             }
275             # Get mode
276             else
277             {
278             # return( $self->children->map(sub{ $_->attributes->get( $classes[0] ) }) );
279             # Get the value of an attribute for the first element in the set of matched elements.
280 1 50       5 if( $self->isa_collection )
281             {
282 0         0 return( $self->children->first->attributes->get( $classes[0] ) );
283             }
284             else
285             {
286 1         7 return( $self->attributes->get( $classes[0] ) );
287             }
288             }
289             }
290              
291 1     1 1 9 sub before { return( shift->_before_after( @_, { action => 'before' } ) ); }
292              
293             # Takes a selector; or
294             # a selector and an HTML::Object::DOM::Element as a context; or
295             # a HTML::Object::DOM::Element object
296             # "Given a jQuery object that represents a set of DOM elements, the .closest() method searches through these elements and their ancestors in the DOM tree and constructs a new jQuery object from the matching elements."
297             sub closest
298             {
299 0     0 1 0 my $self = shift( @_ );
300 0         0 my $this = shift( @_ );
301 0         0 my $context = shift( @_ );
302 0         0 my $collection = $self->new_collection;
303 0 0       0 return $collection if( !defined( $this ) );
304 0 0 0     0 if( defined( $context ) &&
    0 0        
      0        
      0        
      0        
305             ( !$self->_is_object( $context ) ||
306             ( $self->_is_object( $context ) &&
307             !$context->isa( 'HTML::Object::DOM::Element' )
308             )
309             ) )
310             {
311 0         0 return( $self->error( "Context provided (", overload::StrVal( $context ), ") is not an HTML::Object::DOM::Element." ) );
312             }
313             elsif( ref( $this ) &&
314             $self->_is_object( $this ) &&
315             ( !$this->isa( 'HTML::Object::DOM::Element' ) ||
316             ( overload::Overloaded( $this ) && !overload::Method( $this, '""' ) )
317             ) )
318             {
319 0         0 return( $self->error( "I was expecting a selector or an HTML::Object::DOM::Element, but instead received '$this'" ) );
320             }
321             else
322             {
323 0         0 return( $self->error( "I was expecting a selector or an HTML::Object::DOM::Element, but instead received '$this'" ) );
324             }
325            
326 0         0 my $xpath;
327 0 0       0 if( !ref( $this ) )
328             {
329 0         0 $xpath = $self->_xpath_value( $this );
330             }
331 0         0 my $process;
332             $process = sub
333             {
334 0     0   0 my $elem = shift( @_ );
335             # We reach the limit of our upward search
336 0 0 0     0 return if( defined( $context ) && $elem->eid CORE::eq $context->eid );
337 0         0 my $parent = $elem->parent;
338 0 0       0 if( defined( $xpath ) )
339             {
340 0 0       0 if( $elem->matches( $xpath ) )
341             {
342 0         0 $collection->push( $elem );
343             }
344             }
345             else
346             {
347 0 0       0 if( $elem->eid CORE::eq $this->eid )
348             {
349 0         0 $collection->push( $elem );
350             }
351             }
352 0 0       0 return if( !$parent );
353 0         0 return( $process->( $parent ) );
354 0         0 };
355 0         0 $process->( $self );
356 0         0 return( $collection );
357             }
358              
359             # Takes a property name; or
360             # an array reference of one or more css properties; or
361             # a property name and a value; or
362             # a property name and a function; or
363             # an hash reference of property name-value pairs
364             # <https://api.jquery.com/css/>
365             # $e->css( $property_name );
366             # $e->css( [$property_name1, $property_name2, $property_name3] );
367             # $e->css( $property_name, $value );
368             # $e->css( $property_name, $code_reference );
369             # $e->css({ $property_name1 => $value1, $property_name2 => $value2 });
370             # <https://api.jquery.com/css/>
371             sub css
372             {
373 4     4 0 1549 my $self = shift( @_ );
374             # "An element should be connected to the DOM when calling .css()"
375 4 50 33     21 return( $self->error( "Method css() must be called on an HTML::Object::DOM::Element." ) ) if( ( !$self->isa_element && !$self->isa_collection ) || $self->tag->substr( 0, 1 ) CORE::eq '_' );
      33        
376 4         2443 my( $name, $more ) = @_;
377 4 50 33     93 return( $self->error( "No css property was provided." ) ) if( !defined( $name ) || !CORE::length( $name ) );
378            
379 4         8 my $process;
380             $process = sub
381             {
382 26     26   69 my $elem = shift( @_ );
383 26         96 my $style = $elem->attributes->get( 'style' );
384             # return if( !defined( $style ) );
385 26         14218 my $css = CSS::Object->new( format => 'CSS::Object::Format::Inline', debug => $self->debug );
386 26         970759 my $cached;
387 26 100       181 $cached = $elem->css_cache_check( $style ) if( defined( $style ) );
388 26 100       123 if( $cached )
    50          
389             {
390 12         32 $css = $cached;
391             }
392             elsif( defined( $style ) )
393             {
394             # 'inline' here is just a fake selector to serve as a container rule for the inline properties,
395             # because CSS::Object requires properties to be within a rule
396 0 0       0 $css->read_string( 'inline {' . $style . ' }' ) ||
397             return( $self->error( "Unable to parse existing style for tag name \"", $elem->prop( 'tagName' ), "\":", $css->error ) );
398             }
399             else
400             {
401             }
402 26         158 my $main = $css->rules->first;
403             # my $rule = defined( $main ) ? $css->builder->select( $main ) : $css->builder->select( 'inline' );
404 26         1110937 my $rule;
405              
406             # Get the requested property values
407             # $e->css( $property_name );
408             # $e->css( [$property_name1, $property_name2, $property_name3] );
409             # $e->css({ $property_name1 => $value1, $property_name2 => $value2 });
410 26 50 33     604 if( $self->_is_array( $name ) ||
      33        
      33        
      33        
411             $self->_is_hash( $name ) ||
412             ( ( !ref( $name ) || overload::Method( $name, '""' ) ) && !defined( $more ) ) )
413             {
414             # If this is just 1 css property, we encapsulate it into an array to standardise our processing
415             # $e->css( $property_name );
416 0 0 0     0 $name = [ "$name" ] if( !defined( $more ) && ( !ref( $name ) || overload::Method( $name, '""' ) ) );
      0        
417             # $e->css( [$property_name1, $property_name2, $property_name3] );
418             # "assing an array of style properties to .css() will result in an object of property-value pairs."
419             # <https://api.jquery.com/css/#css-propertyName>
420 0 0       0 if( $self->_is_array( $name ) )
    0          
421             {
422 0         0 my $res = $self->new_hash;
423             $self->new_array( $name )->foreach(sub
424             {
425 0         0 my $prop = shift( @_ );
426 0         0 $prop =~ tr/_/-/;
427 0         0 my $obj = $main->get_property_by_name( $prop );
428             # next
429 0 0       0 return( 1 ) if( !defined( $obj ) );
430 0         0 $res->{ $prop } = $obj->value->as_string;
431 0         0 return( 1 );
432 0         0 });
433 0         0 return( $res );
434             }
435             # $e->css({ $property_name1 => $value1, $property_name2 => $value2 });
436             elsif( $self->_is_hash( $name ) )
437             {
438 0 0       0 $rule = defined( $main ) ? $css->builder->select( $main ) : $css->builder->select( 'inline' );
439             $self->new_hash( $name )->each(sub
440             {
441 0         0 my( $prop, $value ) = @_;
442 0         0 my $obj = $main->get_property_by_name( $prop );
443             # if the value is undef, remove the property from the set of css properties
444             # "Setting the value of a style property to an empty string — e.g. $( "#mydiv" ).css( "color", "" ) — removes that property from an element if it has already been directly applied,"
445             # <https://api.jquery.com/css/#css-propertyName-value>
446 0 0 0     0 if( !defined( $value ) || !CORE::length( $value ) )
    0          
447             {
448 0 0       0 $main->element->remove( $obj ) if( $obj );
449             }
450             elsif( defined( $obj ) )
451             {
452 0         0 $obj->value( "$value" );
453             }
454             else
455             {
456 0         0 $main->$prop( "$value" );
457             }
458 0         0 });
459 0 0       0 if( $rule->elements->length > 0 )
460             {
461 0         0 my $style = $rule->as_string;
462 0 0       0 $elem->css_cache_store( $style, $css ) || return( $self->pass_error( $elem->error ) );
463 0         0 $elem->attributes->set( style => $style );
464             }
465             else
466             {
467             }
468 0         0 return( $self );
469             }
470             else
471             {
472 0         0 return( $self->error( "I was expecting a css property, or an array reference of css property, but instead I received '$name'." ) );
473             }
474             }
475             else
476             {
477             # Set css property values
478             # $e->css( $property_name, $value );
479             # $e->css( $property_name, $code_reference );
480 26 50       854 if( defined( $more ) )
481             {
482 26 50       108 return( $self->error( "More than 2 arguments were provided. I was expecting a property and its value or a function." ) ) if( scalar( @_ ) > 2 );
483 26 100       319 $rule = defined( $main ) ? $css->builder->select( $main ) : $css->builder->select( 'inline' );
484             # $e->css( $property_name, $code_reference );
485 26 50       2074937 if( ref( $more ) CORE::eq 'CODE' )
486             {
487 0 0       0 my $pos = $elem->parent ? $elem->parent->children->pos( $elem ) : 0;
488 0         0 $name =~ tr/_/-/;
489 0         0 my $obj = $main->get_property_by_name( $name );
490 0         0 my $val;
491 0 0       0 if( defined( $obj ) )
492             {
493 0         0 $val = $obj->value->as_string;
494             }
495 0         0 local $_ = $elem;
496 0         0 my $ret = $more->( $pos, $val );
497             # "If nothing is returned in the setter function (ie. function( index, style ){} ), or if undefined is returned, the current value is not changed. This is useful for selectively setting values only when certain criteria are met."
498             # <https://api.jquery.com/css/#css-propertyName-function>
499 0 0 0     0 return( $elem ) if( !defined( $ret ) || !CORE::length( $ret ) );
500 0 0       0 if( defined( $obj ) )
501             {
502 0         0 $obj->value( "$val" );
503             }
504             else
505             {
506 0         0 $rule->$name( "$val" );
507             }
508             }
509             # $e->css( $property_name, $value );
510             else
511             {
512 26 50 0     133 return( $self->error( "I was expecting a value as a string, but instead got '$more'." ) ) if( ref( $more ) && !( overload::Overloaded( $more ) && overload::Method( $more, '""' ) ) );
      33        
513 26         79 $name =~ tr/_/-/;
514 26         167 my $obj = $rule->get_property_by_name( $name );
515 26 50       19026 if( defined( $obj ) )
516             {
517 0         0 $obj->value( "$more" );
518             }
519             else
520             {
521 26         303 $rule->$name( "$more" );
522             }
523             }
524             }
525            
526 26 50 33     239383 if( defined( $rule ) && $rule->elements->length > 0 )
527             {
528 26         940518 my $style = $rule->as_string;
529 26 50       3391957 $elem->css_cache_store( $style, $css ) || return( $self->pass_error( $elem->error ) );
530 26         202 $elem->attributes->set( style => $style );
531             }
532             else
533             {
534             }
535 26         14320 return( $elem );
536             }
537 4         48 };
538            
539 4 50       17 if( $self->isa_collection )
540             {
541             $self->children->foreach(sub
542             {
543 26     26   1165 $_->reset(1);
544 26         109 $process->( $_ );
545 4         22 });
546 4         331 return( $self );
547             }
548             else
549             {
550 0         0 $self->reset(1);
551 0         0 return( $process->( $self ) );
552             }
553             }
554              
555             sub css_cache_check
556             {
557 12     12 0 36 my $self = shift( @_ );
558             # my $data = shift( @_ );
559             # return if( !defined( $data ) );
560 12 50       54 return( $self->error( "css_cache_check() must be called on an HTML element, not a collection." ) ) if( $self->isa_collection );
561 12         82 my $internal = $self->internal;
562 12   50     9458 $internal->{css_cache} //= {};
563 12 50       430 if( exists( $internal->{css_cache} ) )
564             {
565             my $css = $internal->{css_cache}->{object} ||
566 12   50     304 return( $self->error( "CSS object could not be found in cache!" ) );
567             # return( $css->clone );
568             # my $clone = $css->clone;
569             # return( $clone );
570 12         489 return( $css );
571             }
572 0         0 return( '' );
573             }
574              
575             sub css_cache_store
576             {
577 26     26 0 75 my $self = shift( @_ );
578 26         65 my $data = shift( @_ );
579 26 50       110 return if( !defined( $data ) );
580 26 50       139 return( $self->error( "css_cache_store() must be called on an HTML element, not a collection." ) ) if( $self->isa_collection );
581 26         81 my $css = shift( @_ );
582 26 50       120 return( $self->error( "No css object provided to store in the element cache." ) ) if( !$self->_is_object( $css ) );
583 26         407 my $trace = $self->_get_stack_trace;
584 26         16186 my $internal = $self->internal;
585             $internal->{css_cache} =
586             {
587 26         28456 timestamp => time(),
588             # object => $css->clone,
589             object => $css,
590             };
591 26         3473 return( $self );
592             }
593              
594             # sub data { return( shift->attr( join( '-', 'data', shift( @_ ) ) => shift( @_ ) ) ) }
595             # nothing which returns everything as a hash; or
596             # a key-value pair; or
597             # a hash reference
598             sub data
599             {
600 0     0 1 0 my $self = shift( @_ );
601 0         0 my( $this, $val ) = @_;
602 0         0 my $elem;
603 0 0       0 if( $self->isa_collection )
    0          
604             {
605 0         0 $elem = $self->children->first;
606             }
607             elsif( $self->tag->substr( 0, 1 ) )
608             {
609 0         0 return( $self->error( "You can only call the data method on html elements." ) );
610             }
611             else
612             {
613 0         0 $elem = $self;
614             }
615            
616 0         0 my $attr = $self->attributes;
617 0 0 0     0 if( $self->_is_hash( $this ) )
    0 0        
    0          
618             {
619             $this = $self->new_hash( $this )->each(sub
620             {
621 0     0   0 my( $k, $v ) = @_;
622             # Remove leading and trailing spaces if this is not a reference
623 0 0       0 $v =~ s/^[[:blank:]\h]+|[[:blank:]\h]+$//g if( !ref( $v ) );
624 0         0 $attr->set( 'data-' . $k, $v );
625 0         0 });
626 0         0 $elem->reset(1);
627 0         0 return( $elem );
628             }
629             elsif( defined( $this ) && defined( $val ) )
630             {
631 0 0 0     0 return( $self->error( "I was provided data name '$this', but I was expcting a regular string." ) ) if( ref( $this ) && ( !overload::Overloaded( $this ) || ( overload::Overloaded( $this ) && !overload::Method( $this, '""' ) ) ) );
      0        
632 0         0 $attr->set( 'data-' . $this => $val );
633 0         0 $elem->reset(1);
634 0         0 return( $elem );
635             }
636             elsif( defined( $this ) && !defined( $val ) )
637             {
638 0         0 return( $attr->get( $this ) );
639             }
640             else
641             {
642 0         0 my $ref = {};
643             $attr->each(sub
644             {
645 0     0   0 my( $k, $v ) = @_;
646 0 0 0     0 if( substr( $k, 0, 5 ) CORE::eq 'data-' && CORE::length( $k ) > 5 )
647             {
648 0         0 $ref->{ substr( $k, 5 ) } = $v;
649             }
650 0         0 });
651 0         0 return( Module::Generic::Dynamic->new( $ref ) );
652             }
653             }
654              
655             # TODO: Instead of adding this method, maybe we should change the one in HTML::Object::DOM::Element to have it return $self instead of $parent, because otherwise there is no difference
656             sub detach
657             {
658 0     0 1 0 my $self = shift( @_ );
659             # If this is a collection, walk through its children
660 0 0       0 if( $self->isa_collection )
661             {
662             $self->children->foreach(sub
663             {
664 0     0   0 my $e = shift( @_ );
665 0         0 my $parent = $e->parent;
666 0 0       0 return( 1 ) if( !$parent );
667 0         0 my $pos = $parent->children->pos( $e );
668 0         0 $parent->children->splice( $pos, 1 );
669 0         0 $e->parent( undef() );
670 0         0 $parent->reset(1);
671 0         0 });
672             }
673             # otherwise, process this one element individually
674             else
675             {
676 0         0 my $parent = $self->parent;
677 0 0       0 return( $self ) if( !$parent );
678 0         0 my $pos = $parent->children->pos( $self );
679 0 0       0 if( defined( $pos ) )
680             {
681 0         0 $parent->children->splice( $pos, 1 );
682 0         0 $self->parent( undef() );
683 0         0 $parent->reset(1);
684             }
685             }
686 0         0 return( $self );
687             }
688              
689             # Takes a code reference which receives the element position and element object as parameter
690             # It returns the current object it was called with
691             sub each
692             {
693 0     0 0 0 my( $self, $code ) = @_;
694 0 0       0 return( $self->error( "I was expecting a code reference to pass it the element position and element object, but instead I got \"", overload::StrVal( $code ), "\"." ) ) if( ref( $code ) ne 'CODE' );
695             # Make a copy of the array so that call to code ref that may remove a child element does not alter our looping operation through all the children
696             $self->children->clone->for(sub
697             {
698 0     0   0 my( $i, $e ) = @_;
699 0         0 $code->( $i, $e );
700 0         0 });
701 0         0 return( $self );
702             }
703              
704             sub empty
705             {
706 0     0 0 0 my $self = shift( @_ );
707             # Element object of Collection object, it does not matter
708 0         0 $self->children->reset;
709 0         0 $self->reset(1);
710 0         0 return( $self );
711             }
712              
713 0     0 1 0 sub end { return( shift->_set_get_object( 'end', 'HTML::Object::DOM::Element', @_ ) ); }
714              
715 0     0 0 0 sub eq { return( shift->children->index( shift( @_ ) ) ); }
716              
717             # Returns a new collection of elements whose position is an even number
718             sub even
719             {
720 0     0 0 0 my $self = shift( @_ );
721 0 0       0 return( $self ) unless( $self->isa_collection );
722 0         0 my $even = $self->children->even;
723 0         0 my $collection = $self->new_collection;
724 0         0 $collection->children( $even );
725 0         0 return( $collection );
726             }
727              
728             sub exists
729             {
730 0     0 0 0 my( $self, $path ) = @_;
731 0         0 return( $self->xp->exists( $path, $self ) );
732             }
733              
734             # Takes a selector; or
735             # function with arguments are element position (starting from 0) and the element itself, expecting a true value in return; or
736             # an array of element objects; or
737             # an element object;
738             sub filter
739             {
740 0     0 1 0 my $self = shift( @_ );
741 0         0 my $this = shift( @_ );
742 0         0 my $collection = $self->new_collection;
743 0 0       0 return( $collection ) if( !defined( $this ) );
744 0 0 0     0 if( !ref( $this ) ||
    0 0        
    0 0        
      0        
745             ( ref( $this ) &&
746             overload::Overloaded( $this ) &&
747             overload::Method( $this, '""' )
748             ) )
749             {
750 0   0     0 my $xpath = $self->_xpath_value( "$this" ) || return;
751 0 0 0     0 if( $self->isa_collection )
    0          
752             {
753             $self->children->foreach(sub
754             {
755 0 0   0   0 if( $_->matches( $xpath ) )
756             {
757 0         0 $collection->children->push( $_ );
758             }
759 0         0 });
760             }
761             elsif( $self->tag->substr( 0, 1 ) ne '_' && $self->matches( $xpath ) )
762             {
763 0         0 $collection->children->push( $self );
764             }
765             }
766             elsif( ref( $this ) eq 'CODE' )
767             {
768 0 0       0 if( $self->isa_collection )
    0          
769             {
770             $self->for(sub
771             {
772 0     0   0 my( $i, $e ) = @_;
773 0         0 local $_ = $e;
774 0 0       0 if( $this->( $i, $e ) )
775             {
776 0         0 $collection->children->push( $e );
777             }
778 0         0 });
779             }
780             elsif( $self->isa( 'HTML::Object::DOM::Element' ) )
781             {
782 0 0       0 return( $collection ) if( $self->tag->substr( 0, 1 ) eq '_' );
783 0         0 local $_ = $self;
784 0 0       0 $collection->children->push( $self ) if( $this->( 0, $self ) );
785             }
786             }
787             elsif( $self->_is_array( $this ) || $self->_is_object( $this ) )
788             {
789 0 0 0     0 if( $self->_is_object( $this ) &&
      0        
790             ( !$this->isa( 'HTML::Object::DOM::Element' ) ||
791             (
792             # Probably need to change this to HTML::Object::DOM::Node
793             $this->isa( 'HTML::Object::Element' ) &&
794             $this->tag->substr( 0, 1 ) eq '_' &&
795             !$this->isa( 'HTML::Object::Collection' )
796             )
797             ) )
798             {
799 0         0 return( $self->error( "Object of class \"", ref( $this ), "\", but you can only provide an HTML::Object::DOM::Element or an HTML::Object::Collection object." ) );
800             }
801 0 0       0 my $a = $self->new_array( $self->_is_array( $this ) ? $this : [ $this ] );
802             $a->foreach(sub
803             {
804 0     0   0 my $xpath = $_->getNodePath();
805 0 0       0 if( $self->isa_collection )
    0          
806             {
807             $self->children->foreach(sub
808             {
809 0         0 my $e = shift( @_ );
810 0 0       0 if( $e->matches( $xpath ) )
811             {
812 0         0 $collection->children->push( $e );
813             }
814 0         0 });
815             }
816             elsif( $self->matches( $xpath ) )
817             {
818 0         0 $collection->children->push( $self );
819             }
820 0         0 });
821             }
822             else
823             {
824 0         0 return( $self->error( "I was expecting a selector, a code reference, an array of elements or an element to use in filter(), but instead I got '$this', and I do not know what to do with it." ) );
825             }
826 0         0 return( $collection );
827             }
828              
829             # Takes a selector; or
830             # Element object
831             sub find
832             {
833 8     8 1 36 my( $self, $this ) = @_;
834 8         39 my $collection = $self->new_collection;
835 8 50       52 return( $collection ) if( !defined( $this ) );
836            
837 8 50 33     66 if( ref( $this ) && $self->_is_object( $this ) && $this->isa( 'HTML::Object::DOM::Element' ) )
      33        
838             {
839 0 0       0 my $a = $self->new_array( $self->isa_collection( $this ) ? $this->children : [ $this ] );
840 0         0 my $lookup;
841             $lookup = sub
842             {
843 0     0   0 my $kids = shift( @_ );
844             $kids->foreach(sub
845             {
846 0         0 my $child = shift( @_ );
847             $a->foreach(sub
848             {
849 0         0 my $candidate = shift( @_ );
850 0 0       0 if( $child->eid eq $candidate->eid )
851             {
852 0         0 $collection->children->push( $child );
853             # We've added this child. Move to next child.
854 0         0 return( 1 );
855             }
856 0         0 });
857 0 0       0 if( $child->children->length > 0 )
858             {
859 0         0 $lookup->( $child->children );
860             }
861 0         0 });
862 0         0 };
863             # Wether this is a collection or just an element object, we check our children
864 0         0 $lookup->( $self->children );
865             }
866             # I am expecting an xpath value
867             else
868             {
869 8 0 0     34 if( ref( $this ) &&
      33        
870             (
871             !overload::Overloaded( $this ) ||
872             ( overload::Overloaded( $this ) && !overload::Method( $this, '""' ) )
873             ) )
874             {
875 0         0 return( $self->error( "I was expecting an xpath string, but instead I got '$this'." ) );
876             }
877 8   50     69 my $xpath = $self->_xpath_value( $this ) || return( $self->pass_error );
878             # $self->children->foreach(sub
879             # {
880             # my $child = shift( @_ );
881             # # Propagate debug value
882             # $child->debug( $self->debug );
883             # try
884             # {
885             # my @nodes = $child->findnodes( $xpath );
886             # $collection->children->push( @nodes );
887             # }
888             # catch( $e )
889             # {
890             # warn( "Error while calling findnodes on element id \"", $_->id, "\" and tag \"", $_->tag, "\": $e\n" );
891             # }
892             # });
893 8 50 33     1307 try
  8         16  
  8         19  
  8         42  
  0         0  
  8         27  
  8         29  
  8         25  
894 8     8   16 {
895 8         62 my @nodes = $self->findnodes( $xpath );
896 8         221 $collection->children->push( @nodes );
897             }
898 8 0 50     73 catch( $e )
  8 0 33     1579  
  8 0       38  
  8 0       19  
  8 0       17  
  8 0       22  
  8 0       19  
  8 0       56  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 0       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  8         38  
  0         0  
  8         27  
  0         0  
  0         0  
  8         38  
  8         41  
  8         35  
  8         26  
  0         0  
  0         0  
  0         0  
  0         0  
899 0     0   0 {
900 0         0 warn( "Error while calling findnodes on element id \"", $_->id, "\" and tag \"", $_->tag, "\": $e\n" );
901 3 0 0 3   29 }
  3 0 0     9  
  3 0 33     12678  
  0 0 33     0  
  0 0 33     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 33     0  
  0 0 33     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  8 0       33  
  0 0       0  
  8 0       353  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  8         40  
  0         0  
  0         0  
  0         0  
  0         0  
  8         46  
902             }
903 8         57 return( $collection );
904             }
905              
906             sub find_xpath
907             {
908 0     0 1 0 my( $self, $path ) = @_;
909 0         0 return( $self->xp->find( $path, $self ) );
910             }
911              
912             sub findnodes
913             {
914 8     8 1 29 my( $self, $path ) = @_;
915 8         52 return( $self->xp->findnodes( $path, $self ) );
916             }
917              
918             sub findnodes_as_string
919             {
920 0     0 1 0 my( $self, $path ) = @_;
921 0         0 return( $self->xp->findnodes_as_string( $path, $self ) );
922             }
923              
924             sub findnodes_as_strings
925             {
926 0     0 1 0 my( $self, $path ) = @_;
927 0         0 return( $self->xp->findnodes_as_strings( $path, $self ) );
928             }
929              
930             sub findvalue
931             {
932 0     0 1 0 my( $self, $path ) = @_;
933 0         0 return( $self->xp->findvalue( $path, $self ) );
934             }
935              
936             sub findvalues
937             {
938 0     0 1 0 my( $self, $path ) = @_;
939 0         0 return( $self->xp->findvalues( $path, $self ) );
940             }
941              
942             sub first
943             {
944 0     0 1 0 my $self = shift( @_ );
945 0         0 my $collection = $self->new_collection;
946 0 0       0 if( $self->isa_collection )
947             {
948 0         0 return( $self->children->first );
949             }
950             else
951             {
952 0         0 return( $self );
953             }
954             }
955              
956             # Originally, in jQuery, this returns the underlying DOM element, but here, in perl context,
957             # this does not mean much, and we return our own object.
958 0     0 1 0 sub get { return( $_[0] ); }
959              
960             sub has
961             {
962 0     0 1 0 my $self = shift( @_ );
963 0         0 my $this = shift( @_ );
964 0         0 my $collection = $self->new_collection;
965 0 0       0 return( $collection ) if( !defined( $this ) );
966 0 0 0     0 if( ref( $this ) && $self->_is_object( $this ) && $self->isa( 'HTML::Object::DOM::Element' ) )
      0        
967             {
968 0         0 my $lookup;
969             $lookup = sub
970             {
971 0     0   0 my $kids = shift( @_ );
972 0         0 my $found;
973             $kids->foreach(sub
974             {
975 0         0 my $child = shift( @_ );
976             $this->children->foreach(sub
977             {
978 0         0 my $candidate = shift( @_ );
979             # Found a match, no need to look down further
980 0 0       0 if( $child->eid eq $candidate->eid )
981             {
982 0         0 $found = $child;
983 0         0 return( $kids->return( undef() ) );
984             }
985 0         0 });
986 0 0       0 if( $child->children->length )
987             {
988 0         0 my $rc = $lookup->( $child->children );
989 0 0       0 if( $rc )
990             {
991 0         0 $found = $rc;
992 0         0 return( $kids->return( undef() ) );
993             }
994             }
995 0         0 });
996 0         0 return( $found );
997 0         0 };
998             $self->children->foreach(sub
999             {
1000 0 0   0   0 $collection->children->push( $_ ) if( $lookup->( $_->children ) );
1001 0         0 });
1002             }
1003             # An xpath then?
1004             else
1005             {
1006 0 0 0     0 if( ref( $this ) &&
      0        
1007             (
1008             !overload::Overloaded( $this ) ||
1009             ( overload::Overloaded( $this ) && !overload::Method( $this, '""' ) )
1010             ) )
1011             {
1012 0         0 return( $self->error( "I was expecting an xpath value, but got '$this' instead." ) );
1013             }
1014 0   0     0 my $xpath = $self->_xpath_value( "$this" ) || return;
1015            
1016 0         0 my $lookup;
1017             $lookup = sub
1018             {
1019 0     0   0 my $kids = shift( @_ );
1020 0         0 my $found;
1021             $kids->foreach(sub
1022             {
1023 0         0 my $child = shift( @_ );
1024 0 0       0 if( $child->matches( $xpath ) )
1025             {
1026 0         0 $found = $child;
1027             # No need to look further, we found a match
1028 0         0 return;
1029             }
1030 0 0       0 if( $child->children->length > 0 )
1031             {
1032 0         0 my $rc = $lookup->( $child->children );
1033 0 0       0 if( $rc )
1034             {
1035 0         0 $found = $rc;
1036 0         0 return;
1037             }
1038             }
1039 0         0 });
1040 0         0 return( $found );
1041 0         0 };
1042            
1043             $self->children->foreach(sub
1044             {
1045 0 0   0   0 $collection->children->push( $_ ) if( $lookup->( $_->children ) );
1046 0         0 });
1047             }
1048 0         0 return( $collection );
1049             }
1050              
1051             sub hasClass
1052             {
1053 2     2 0 2878 my $self = shift( @_ );
1054 2         12 my $class = shift( @_ );
1055 2 50       10 return( 0 ) if( !CORE::length( $class ) );
1056 2         9 my $found = 0;
1057 2 50       10 if( $self->isa_collection )
1058             {
1059             $self->children->foreach(sub
1060             {
1061 2     2   221 my $e = shift( @_ );
1062 2         12 my $classes = $e->attributes->get( 'class' );
1063             # No class attribute, skip to next element
1064 2 50       1228 return( 1 ) if( !defined( $classes ) );
1065             # Found a match, no need to go further since we only need to return true or false
1066 2 50       142 $found++, return( undef() ) if( $classes =~ /(?:\A|[[:blank:]\h]+)${class}(?:[[:blank:]\h]+|\Z)/ );
1067 0         0 return( 1 );
1068 2         20 });
1069             }
1070             else
1071             {
1072 0         0 my $classes = $self->attributes->get( 'class' );
1073 0 0       0 return( 0 ) if( !defined( $classes ) );
1074 0 0       0 return( 1 ) if( $classes =~ /(?:\A|[[:blank:]\h]+)${class}(?:[[:blank:]\h]+|\Z)/ );
1075 0         0 return( 0 );
1076             }
1077             }
1078              
1079             # Since this is a perl context, this only set the inline css to "display: none" like jQuery actually does
1080             # Any parameter provided will be ignored
1081             # See the show() method for its alter ego
1082             sub hide
1083             {
1084 0     0 0 0 my $self = shift( @_ );
1085 0         0 my( $this, $code ) = @_;
1086 0 0 0     0 $code = $this if( ref( $this ) eq 'CODE' && !defined( $code ) );
1087 0         0 my $process;
1088             $process = sub
1089             {
1090 0     0   0 my $e = shift( @_ );
1091 0         0 my $internal = $e->internal;
1092 0         0 my $rule = $self->_css_object();
1093 0 0       0 if( defined( $rule ) )
1094             {
1095 0         0 my $display = $rule->get_property_by_name( 'display' );
1096 0         0 my $val = $display->value;
1097             # $val may be undefined if it was not set in the first place, and that's ok
1098             # when we'll restore it with show(), we'll see the original value was empty and
1099             # we'll just remove the "display: none"
1100             # Here we check what the current value is, because, if it is already set to none, we just ignore it
1101 0 0       0 if( $val ne 'none' )
1102             {
1103 0         0 $internal->{css_display_value} = $val;
1104             }
1105 0         0 $display->value( 'none' );
1106             }
1107             else
1108             {
1109 0         0 $rule = $self->_css_builder;
1110 0         0 $rule->display( 'none' );
1111             }
1112 0 0       0 if( $rule->elements->length > 0 )
1113             {
1114 0         0 $e->_css_object( $rule );
1115             }
1116 0         0 };
1117            
1118 0 0       0 if( $self->isa_collection )
    0          
1119             {
1120             $self->children->foreach(sub
1121             {
1122 0     0   0 $process->( $_ );
1123 0         0 });
1124             }
1125             elsif( $self->tag->substr( 0, 1 ) eq '_' )
1126             {
1127 0         0 return( $self->error( "You can only use the hide() or show() method on html object elements. The element you are calling hide() with is an object of class \"", ref( $self ), "\"." ) );
1128             }
1129             else
1130             {
1131 0         0 $process->( $self );
1132             }
1133             }
1134              
1135             # This takes either no arguments and it returns the inner html; or
1136             # it takes an html string to replace its content; or
1137             # it takes a code reference that is called with the index position in the set of element and
1138             # the current html data. It returns the new html data
1139             # See also text() method
1140             sub html
1141             {
1142 0     0 0 0 my $self = shift( @_ );
1143 0         0 my $this = shift( @_ );
1144 0 0       0 if( defined( $this ) )
1145             {
1146 0 0 0     0 if( !ref( $this ) ||
    0 0        
      0        
1147             ( ref( $this ) && overload::Overloaded( $this ) && overload::Method( $this, '""' ) ) )
1148             {
1149 0         0 my $p = $self->new_parser;
1150 0   0     0 my $res = $p->parse_data( "$this" ) ||
1151             return( $self->error( "Error while parsing html data provided: ", $p->error ) );
1152 0         0 $this = $res;
1153             }
1154             elsif( ref( $this ) ne 'CODE' )
1155             {
1156 0         0 return( $self->error( "I was expecting some html data or a code reference in replacement of html for this element \"", $self->tag, "\", but instead got '$this'." ) );
1157             }
1158            
1159             $self->children->for(sub
1160             {
1161 0     0   0 my( $i, $e ) = @_;
1162 0 0       0 if( ref( $this ) eq 'CODE' )
1163             {
1164 0         0 my $current_html = $e->as_string;
1165 0         0 my $html = $this->( $i, $current_html );
1166 0 0 0     0 if( !defined( $html ) || !CORE::length( $html ) )
    0 0        
    0 0        
      0        
      0        
1167             {
1168 0         0 $e->empty();
1169             # Next please
1170 0         0 return(1);
1171             }
1172             # We were provided with an HTML::Object::DOM::Element in response, we use its children as the new content
1173             elsif( ref( $html ) && $self->_is_object( $html ) && $html->isa( 'HTML::Object::DOM::Element' ) )
1174             {
1175 0 0 0     0 if( $html->tag->substr( 0, 1 ) eq '_' && !$html->isa_collection )
1176             {
1177 0         0 warn( "You cannot use this object of class ", ref( $html ), " to set its children as the new html. You can only use html element objects.\n" );
1178 0         0 return(1);
1179             }
1180 0         0 $e->children( $html->children );
1181             $html->children->foreach(sub
1182             {
1183 0         0 $_->parent( $e );
1184 0         0 });
1185 0         0 $self->reset(1);
1186 0         0 return(1);
1187             }
1188             elsif( ref( $html ) &&
1189             !( overload::Overloaded( $html ) && overload::Method( $html, '""' ) ) )
1190             {
1191 0         0 warn( "I was provided a reference '$html' as a result from calling this code reference to get the replacement html for tag \"", $e->tag, "\", but I do not know what to do with it.\n" );
1192 0         0 return(1);
1193             }
1194 0         0 my $p = $self->new_parser;
1195             my $doc = $p->parse_data( "$html" ) || do
1196 0   0     0 {
1197             warn( "Error while trying to parse html data returned by code reference supplied: ", $p->error, "\n" );
1198             # Switch to next element
1199             return(1);
1200             };
1201             # Replace the children element by the new ones found in parsing.
1202 0         0 $e->children( $doc->children );
1203             $doc->children->foreach(sub
1204             {
1205 0         0 $_->parent( $e );
1206 0         0 });
1207 0         0 $self->reset(1);
1208             }
1209             # It's an HTML::Object::DOM::Document object
1210             else
1211             {
1212 0         0 my $a = $self->new_array;
1213             $this->children->foreach(sub
1214             {
1215 0         0 $a->push( $_->clone );
1216 0         0 });
1217 0         0 $e->children( $a );
1218             }
1219             # Return true at the end to satisfy Module::Generic::Array->for
1220 0         0 return(1);
1221 0         0 });
1222             }
1223             else
1224             {
1225             # "Get the HTML contents of the first element in the set of matched elements."
1226 0 0       0 my $elem = $self->isa_collection ? $self->children->first : $self;
1227 0 0       0 return( '' ) unless( $self );
1228             # Create a new document, because we want to use the document object as_string function which produce a string of its children, and no need to reproduce it here
1229 0         0 my $doc = $elem->new_document;
1230 0         0 $doc->children( $elem->children );
1231 0         0 return( $doc->as_string );
1232             }
1233             }
1234              
1235             sub id
1236             {
1237 1     1 1 593 my $self = shift( @_ );
1238 1 50       5 if( @_ )
1239             {
1240 0 0       0 if( $self->isa_collection )
1241             {
1242 0         0 return( $self->error( "Cannot set an id on a collection" ) );
1243             }
1244             else
1245             {
1246             # Method in HTML::Object::DOM::Element
1247 0         0 return( $self->_set_get_id( @_ ) );
1248             }
1249             }
1250             else
1251             {
1252 1         5 my $e = $self;
1253 1 50       4 if( $self->isa_collection )
1254             {
1255 1         9 my $first = $self->children->first;
1256 1 50 33     182 return if( !$first || !$self->isa_element( $first ) );
1257 1         39 $e = $first;
1258             }
1259 1         8 my $id = $e->attributes->get( 'id' );
1260 1         565 return( $e->new_scalar( $id ) );
1261             }
1262             }
1263              
1264             # Takes either nothing; or
1265             # a selector; or
1266             # an element object
1267             sub index
1268             {
1269 0     0 0 0 my $self = shift( @_ );
1270 0         0 my $this = shift( @_ );
1271 0 0       0 if( defined( $this ) )
1272             {
1273 0 0 0     0 if( !ref( $this ) ||
    0 0        
      0        
      0        
      0        
1274             ( ref( $this ) && overload::Overloaded( $this ) && overload::Method( $this, '""' ) ) )
1275             {
1276 0         0 my $xpath = $self->_xpath_value( "$this" );
1277 0 0       0 if( $self->isa_collection() )
1278             {
1279 0         0 my $found;
1280             $self->children->for(sub
1281             {
1282 0     0   0 my( $i, $e ) = @_;
1283 0 0       0 if( $e->matches( $xpath ) )
1284             {
1285 0         0 $found = $i;
1286             # Exit the for loop
1287 0         0 return;
1288             }
1289 0         0 });
1290 0 0       0 return( $self->new_number(-1) ) if( !defined( $found ) );
1291 0         0 return( $self->new_number( $found ) );
1292             }
1293             else
1294             {
1295 0 0       0 if( $self->matches( $xpath ) )
1296             {
1297 0 0       0 return( $self->new_number(0) ) if( !$self->parent );
1298 0         0 my $pos = $self->parent->children->pos( $self );
1299 0 0       0 return( $self->new_number( defined( $pos ) ? $pos : -1 ) );
1300             }
1301             else
1302             {
1303 0         0 return( $self->new_number(-1) );
1304             }
1305             }
1306             }
1307             elsif( ref( $this ) && $self->_is_object( $this ) && $this->isa( 'HTML::Object::DOM::Element' ) )
1308             {
1309 0 0       0 my $elem = $this->isa_collection() ? $this->children->first : $this;
1310 0         0 my $found;
1311 0 0       0 if( $self->isa_collection() )
1312             {
1313             $self->children->for(sub
1314             {
1315 0     0   0 my( $i, $e ) = @_;
1316 0 0       0 if( $e->eid eq $elem->eid )
1317             {
1318 0         0 $found = $i;
1319 0         0 return;
1320             }
1321 0         0 });
1322             }
1323             else
1324             {
1325 0 0       0 return( $self->new_number( $self->eid eq $elem->eid ? 0 : -1 ) );
1326             }
1327             }
1328             }
1329             # Return the position of the element or if this is a collection, the position of the first element in the collection
1330             else
1331             {
1332 0 0       0 my $elem = ( $self->isa_collection ? $self->children->first : $self );
1333 0 0 0     0 return( $self->new_number(-1) ) if( !defined( $elem ) || !CORE::length( $elem ) );
1334 0 0       0 return( $self->new_number(0) ) if( !$elem->parent );
1335 0         0 my $pos = $elem->parent->children->pos( $elem );
1336 0 0       0 return( $self->new_number( defined( $pos ) ? $pos : -1 ) );
1337             }
1338             }
1339              
1340 0     0 1 0 sub insertAfter { return( shift->_insert_before_after( @_, { action => 'after' }) ); }
1341              
1342 0     0 1 0 sub insertBefore { return( shift->_insert_before_after( @_, { action => 'before' }) ); }
1343              
1344             # Takes a selector; or
1345             # an element object; or
1346             # a collection object; or
1347             # a code reference and
1348             # return true or false object
1349             # "Check the current matched set of elements against a selector, element, or jQuery object and return true if at least one of these elements matches the given arguments."
1350             # <https://api.jquery.com/is/#is-selector>
1351             sub is
1352             {
1353 0     0 1 0 my $self = shift( @_ );
1354 0         0 my $this = shift( @_ );
1355 0         0 my $found = $self->false;
1356 0 0 0     0 if( ref( $this ) CORE::eq 'CODE' )
    0 0        
    0 0        
      0        
      0        
1357             {
1358 0 0       0 if( $self->isa_collection() )
1359             {
1360             $self->children->for(sub
1361             {
1362 0     0   0 my( $i, $e ) = @_;
1363 0         0 local $_ = $e;
1364 0 0       0 if( $this->( $i, $e ) )
1365             {
1366 0         0 $found = $self->true;
1367 0         0 return;
1368             }
1369 0         0 });
1370             }
1371             else
1372             {
1373 0 0       0 my $pos = ( $self->parent ? $self->parent->children->pos( $self ) : 0 );
1374 0 0       0 if( $this->( $pos, $self ) )
1375             {
1376 0         0 $found = $self->true;
1377             }
1378             }
1379 0         0 return( $found );
1380             }
1381             elsif( ref( $this ) && $self->_is_object( $this ) && $this->isa( 'HTML::Object::DOM::Element' ) )
1382             {
1383 0 0       0 my $a = $this->isa_collection() ? $this->children() : $self->new_array( [ $this ] );
1384 0 0       0 if( $self->isa_collection() )
1385             {
1386 0         0 my $kids = $self->children;
1387             $kids->foreach(sub
1388             {
1389 0     0   0 my $e = shift( @_ );
1390             $a->foreach(sub
1391             {
1392 0         0 my $other = shift( @_ );
1393 0 0       0 if( $e->eid CORE::eq $other->eid )
1394             {
1395 0         0 $found = $self->true;
1396             # Exit this loop and tell the upper loop to exit as well
1397 0         0 return( $kids->return( undef() ) );
1398             }
1399 0         0 });
1400 0         0 });
1401             }
1402             else
1403             {
1404             $a->foreach(sub
1405             {
1406 0 0   0   0 if( $_->eid CORE::eq $self->eid )
1407             {
1408 0         0 $found = $self->true;
1409 0         0 return;
1410             }
1411 0         0 });
1412             }
1413 0         0 return( $found );
1414             }
1415             # Works for xpath, but also need to account for special keywords starting with ':'
1416             # e.g.:
1417             # is( ":first-child" )
1418             # is( ":contains('Peter')" )
1419             # is( ":checked" )
1420             elsif( !ref( $this ) ||
1421             ( ref( $this ) && overload::Overloaded( $this ) && overload::Method( $this, '""' ) ) )
1422             {
1423 0         0 my $xpath = $self->_xpath_value( $this );
1424             # false() method is inherited from Module::Generic module.
1425 0 0       0 if( $self->isa_collection() )
1426             {
1427             $self->children->foreach(sub
1428             {
1429 0 0   0   0 if( $_->matches( $xpath ) )
1430             {
1431 0         0 $found = $self->true;
1432 0         0 return;
1433             }
1434 0         0 });
1435             }
1436             else
1437             {
1438 0 0       0 $found = $self->true if( $self->matches( $xpath ) );
1439             }
1440 0         0 return( $found );
1441             }
1442             else
1443             {
1444 0         0 return( $self->error( "I was expecting a selector, an element object, a collection object or a code reference, but got '$this'." ) );
1445             }
1446             }
1447              
1448             sub isa_collection
1449             {
1450 1077     1077 0 1789 my $self = shift( @_ );
1451 1077 100       2549 if( scalar( @_ ) )
1452             {
1453 2         17 return( $_[0]->isa( 'HTML::Object::Collection' ) );
1454             }
1455 1075         6123 return( $self->isa( 'HTML::Object::Collection' ) );
1456             }
1457              
1458             sub isa_element
1459             {
1460 5     5 0 18 my $self = shift( @_ );
1461 5 100       26 my $e = scalar( @_ ) ? shift( @_ ) : $self;
1462 5         23 return( $self->_is_a( $e, 'HTML::Object::DOM::Element' ) );
1463             }
1464              
1465             sub length
1466             {
1467 0     0 0 0 my $self = shift( @_ );
1468 0 0       0 if( $self->isa_collection )
1469             {
1470 0         0 return( $self->children->length );
1471             }
1472             else
1473             {
1474 0         0 return( $self->new_number(1) );
1475             }
1476             }
1477              
1478             # $e->load( 'https://example.org/some/where' );
1479             # $e->load( 'https://example.org/some/where', { param1 => value1, param2 => value2 } );
1480             # $e->load( 'https://example.org/some/where', { param1 => value1, param2 => value2 }, sub
1481             # {
1482             # my( $responseText, $responseStatus, $responseObject ) = @_;
1483             # # do something
1484             # });
1485             # <https://api.jquery.com/load/#load-url-data-complete>
1486             # $e->load( 'https://example.org/some/where', sub
1487             # {
1488             # my( $responseText, $responseStatus, $responseObject ) = @_;
1489             # # do something
1490             # });
1491             # $e->load({
1492             # url => 'https://example.org/some/where',
1493             # data => { param1 => value1, param2 => value2 },
1494             # callback => sub
1495             # {
1496             # my( $responseText, $responseStatus, $responseObject ) = @_;
1497             # # do something
1498             # }
1499             # });
1500             # <https://api.jquery.com/load/#load-url-data-complete>
1501             sub load
1502             {
1503 1     1 0 134573 my $self = shift( @_ );
1504 1         15 my( $url, $data, $complete ) = @_;
1505 1         13 my $opts = {};
1506 1 50 33     68 if( scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' )
    50 33        
1507             {
1508 0         0 $opts = shift( @_ );
1509 0         0 ( $url, $data, $complete ) = @$opts{qw( url data callback )};
1510             }
1511             # e.g. $e->load( $url, $data, $complete, $options );
1512             elsif( scalar( @_ ) > 2 && ref( $_[-1] ) eq 'HASH' )
1513             {
1514 0         0 $opts = pop( @_ );
1515             }
1516            
1517 1 50 33     42 if( !defined( $complete ) && defined( $data ) && ref( $data ) eq 'CODE' )
      33        
1518             {
1519 0         0 $complete = $data;
1520 0         0 undef( $data );
1521             }
1522 1 50 33     24 if( defined( $data ) && ref( $data ) ne 'HASH' )
1523             {
1524 0         0 return( $self->error( "Data to be submitted to $url was provided, but I was expecting an hash reference and I got '$data'" ) );
1525             }
1526 1 50 33     461 if( defined( $complete ) && ref( $complete ) ne 'CODE' )
1527             {
1528 0         0 return( $self->error( "A callback parameter was provided, and I was expecting a code reference, such as an anonymous subroutine, but instead I got '$complete'" ) );
1529             }
1530            
1531             # No need to go further if there is nothing in our collection
1532 1 50       43 my $children = $self->isa_collection ? $self->children : $self->new_array( $self );
1533 1 50       220 return( $self ) if( !$children->length );
1534             # if( !$children->length )
1535             # {
1536             # if( defined( $complete ) )
1537             # {
1538             # my $resp = HTTP::Response->new( 204, 'No content', [] );
1539             # $children->foreach(sub
1540             # {
1541             # $complete->( '', 'nocontent', $resp );
1542             # });
1543             # }
1544             # return( $self );
1545             # }
1546            
1547             # Ultimately, if the callback is not set, we set a dummy one instead
1548 1 50   0   36121 $complete = sub{1} if( !defined( $complete ) );
  0         0  
1549            
1550 1 50 33     192 return( $self->error( "No url was provided to load data" ) ) if( !defined( $url ) || !CORE::length( "$url" ) );
1551 1 50       122 if( !$self->_load_class( 'LWP::UserAgent', { version => '6.49' } ) )
1552             {
1553 1         5916 return( $self->error( "LWP::UserAgent version 6.49 or higher is required to use load()" ) );
1554             }
1555 0 0       0 if( !$self->_load_class( 'URI', { version => '1.74' } ) )
1556             {
1557 0         0 return( $self->error( "URI version 1.74 or higher is required to use load()" ) );
1558             }
1559 0   0     0 $opts->{timeout} //= 10;
1560             # "If one or more space characters are included in the string, the portion of the string following the first space is assumed to be a jQuery selector that determines the content to be loaded."
1561             # e.g.: $( "#new-projects" )->load( "/resources/load.html #projects li" );
1562             # <https://api.jquery.com/load/#load-url-data-complete>
1563 0         0 ( $url, my $target ) = split( /[[:blank:]\h]+/, $url, 2 );
1564            
1565 0         0 my $uri;
1566 0 0 0     0 try
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1567 0     0   0 {
1568 0         0 $uri = URI->new( "$url" );
1569             }
1570 0 0 0     0 catch( $e )
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1571 0     0   0 {
1572 0         0 return( $self->error( "Bad url provided \"$url\": $e" ) );
1573 3 0 0 3   26 }
  3 0 0     7  
  3 0 0     4403  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1574            
1575 0 0 0     0 try
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1576 0     0   0 {
1577             my $ua = LWP::UserAgent->new(
1578             agent => "HTML::Object/$VERSION",
1579             timeout => $opts->{timeout},
1580 0         0 );
1581 0         0 my $resp;
1582             # "The POST method is used if data is provided as an object; otherwise, GET is assumed."
1583             # <https://api.jquery.com/load/#load-url-data-complete>
1584 0 0       0 if( defined( $data ) )
1585             {
1586 0 0 0     0 $resp = $ua->post( $uri, $data, ( ref( $opts->{headers} ) eq 'HASH' && scalar( keys( %{$opts->{headers}} ) ) ) ? %{$opts->{headers}} : () );
  0         0  
1587             }
1588             else
1589             {
1590 0 0 0     0 $resp = $ua->get( $uri, ( ref( $opts->{headers} ) eq 'HASH' && scalar( keys( %{$opts->{headers}} ) ) ) ? %{$opts->{headers}} : () );
  0         0  
1591             }
1592            
1593 0 0 0     0 if( $resp->header( 'Client-Warning' ) || !$resp->is_success )
1594             {
1595 0         0 $complete->( $resp->decoded_content, 'error', $resp );
1596 0         0 return( $self->error({
1597             code => $resp->code,
1598             message => $resp->message,
1599             }) );
1600             }
1601 0         0 my $content = $resp->decoded_content;
1602 0         0 my $parser = $self->new_parser;
1603             # HTML::Object::DOM::Document
1604 0         0 my $doc = $parser->parse_data( $content );
1605 0         0 my $new = $doc->children;
1606             # "When this method executes, it retrieves the content of ajax/test.html, but then jQuery parses the returned document to find the element with an ID of container. This element, along with its contents, is inserted into the element with an ID of result, and the rest of the retrieved document is discarded."
1607 0 0       0 if( defined( $target ) )
1608             {
1609 0   0     0 my $elem = $doc->find( $target ) || return( $self->pass_error( $doc->error ) );
1610             # $new = $self->new_array( $elem );
1611 0         0 $new = $elem->children;
1612             }
1613            
1614             # "If a "complete" callback is provided, it is executed after post-processing and HTML insertion has been performed. The callback is fired once for each element in the collection, and $_ is set to each DOM element in turn."
1615             $children->foreach(sub
1616             {
1617 0         0 my $child = shift( @_ );
1618             # Make a deep copy for each child element and set each child element's children
1619 0         0 my $clone = $new->map(sub{ $_->clone });
  0         0  
1620 0         0 $child->children( $clone );
1621 0         0 $child->reset(1);
1622 0         0 my $status = 'error';
1623 0 0 0     0 if( $resp->code >= 200 && $resp->code < 300 )
    0          
    0          
1624             {
1625 0         0 $status = 'success';
1626             }
1627             elsif( $resp->code == 304 )
1628             {
1629 0         0 $status = 'notmodified';
1630             }
1631             elsif( $resp->is_error )
1632             {
1633 0         0 $status = 'error';
1634             }
1635 0         0 $complete->( $content, $status, $resp );
1636 0         0 });
1637             }
1638 0 0 0     0 catch( $e )
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1639 0     0   0 {
1640 0         0 require HTTP::Response;
1641 0         0 my $err = "Error trying to get url \"$url\": $e";
1642 0         0 my $resp2 = HTTP::Response->new( 500, "Unexpected error", [], $err );
1643 0         0 $complete->( $err, 'error', $resp2 );
1644 0         0 return( $self->error({
1645             code => 500,
1646             message => $err,
1647             }) );
1648 3 0 0 3   25 }
  3 0 0     7  
  3 0 0     6236  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1649 0         0 return( $self );
1650             }
1651              
1652             sub map
1653             {
1654 0     0 0 0 my $self = shift( @_ );
1655 0   0     0 my $code = shift( @_ ) || return( $self->error( "No code reference was provided." ) );
1656 0 0       0 return( $self->error( "I was expecting a code reference, but instead I was provided with this: \"", overload::StrVal( $code ), "\"." ) ) if( ref( $code ) ne 'CODE' );
1657 0         0 return( $self->children->for( $code ) );
1658             }
1659              
1660             sub matches
1661             {
1662 0     0 1 0 my( $self, $path ) = @_;
1663 0         0 return( $self->xp->matches( $self, $path, $self ) );
1664             }
1665              
1666 0     0 0 0 sub name { return( shift->attr( name => shift( @_ ) ) ); }
1667              
1668             sub new_attribute
1669             {
1670 6     6 1 3174 my $self = shift( @_ );
1671 6         21 my $opts = $self->_get_args_as_hash( @_ );
1672 6 50       863 $opts->{debug} = $self->debug unless( exists( $opts->{debug} ) );
1673 6   50     187 my $e = HTML::Object::DOM::Attribute->new( $opts ) ||
1674             return( $self->pass_error( HTML::Object::DOM::Attribute->error ) );
1675 6         96 return( $e );
1676             }
1677              
1678             sub new_collection
1679             {
1680 16     16 1 55 my $self = shift( @_ );
1681 16         79 my $opts = $self->_get_args_as_hash( @_ );
1682 16 50       506 $opts->{debug} = $self->debug unless( exists( $opts->{debug} ) );
1683 16 100       515 $opts->{end} = $self unless( exists( $opts->{end} ) );
1684 16   50     119 my $e = HTML::Object::Collection->new( $opts ) ||
1685             return( $self->pass_error( HTML::Object::Collection->error ) );
1686 16         188 return( $e );
1687             }
1688              
1689 3     3 1 30 sub new_parser { HTML::Object::DOM->new }
1690              
1691             sub new_root
1692             {
1693 0     0 0 0 my $self = shift( @_ );
1694 0         0 my $opts = $self->_get_args_as_hash( @_ );
1695 0 0       0 $opts->{debug} = $self->debug unless( exists( $opts->{debug} ) );
1696 0   0     0 my $e = HTML::Object::DOM::Root->new( $opts ) ||
1697             return( $self->pass_error( HTML::Object::DOM::Root->error ) );
1698 0         0 return( $e );
1699             }
1700              
1701             # Takes a selector expression; or
1702             # a element object; or
1703             # a collection of elements; or
1704             # an array of element objects to match against the set.
1705             sub not
1706             {
1707 0     0 1 0 my $self = shift( @_ );
1708 0         0 my $this;
1709 0 0       0 $this = shift( @_ ) if( scalar( @_ ) );
1710 0         0 my $collection = $self->new_collection( end => $self );
1711             # Process array of elements
1712 0         0 my $process;
1713             $process = sub
1714             {
1715 0     0   0 my( $kids, $to_exclude ) = @_;
1716 0         0 my $exclude = $self->new_array;
1717             $kids->foreach(sub
1718             {
1719 0         0 my $elem = shift( @_ );
1720 0         0 my $path = $elem->getNodePath();
1721             $to_exclude->foreach(sub
1722             {
1723 0         0 my $e = shift( @_ );
1724 0 0 0     0 return( 1 ) if( !$self->_is_object( $e ) || !$e->isa( 'HTML::Object::DOM::Element' ) );
1725 0 0 0     0 return( 1 ) if( !$e->isa( 'HTML::Object::DOM::Comment' ) || $e->isa( 'HTML::Object::DOM::Text' ) || $e->isa( 'HTML::Object::DOM::Declaration' ) || $e->isa( 'HTML::Object::DOM::Space' ) );
      0        
      0        
1726             # This element matches the xpath of one of the collection element, so we exclude it from the result
1727 0 0       0 if( $e->matches( $path ) )
1728             {
1729 0         0 $exclude->push( $elem );
1730 0         0 return(1);
1731             }
1732 0         0 });
1733 0         0 });
1734 0         0 return( $kids->clone->remove( $exclude ) );
1735 0         0 };
1736            
1737             # No parameter provided, thus we return an empty collection
1738 0 0 0     0 if( !defined( $this ) )
    0 0        
    0 0        
    0 0        
    0 0        
1739             {
1740 0         0 return( $collection );
1741             }
1742             elsif( !ref( $this ) || ( $self->_is_object( $this ) && overload::Overloaded( $this ) && overload::Method( '""' ) ) )
1743             {
1744 0         0 my $xpath = $self->_xpath_value( "$this" );
1745             my $doc = $self->filter(sub
1746             {
1747 0     0   0 my $elem = shift( @_ );
1748 0 0 0     0 try
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1749 0         0 {
1750 0         0 return( !$elem->matches( $xpath ) );
1751             }
1752 0 0 0     0 catch( $e )
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1753 0         0 {
1754 0         0 return( $self->error( "Caught an exception while calling matches with xpath '$xpath' for element of class ", ref( $elem ), " and tag '", $elem->tag, "': $e" ) );
1755 3 0 0 3   39 }
  3 0 0     7  
  3 0 0     28030  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1756 0         0 });
1757 0         0 $collection->children( $doc->children );
1758             }
1759             elsif( $self->_is_array( $this ) )
1760             {
1761 0         0 $this = $self->new_array( $this );
1762             #my $new = $self->children->clone->remove( $this );
1763             #$collection->children( $new );
1764 0         0 $this->unique(1);
1765 0         0 my $new = $process->( $self->children, $this );
1766 0         0 $collection->children( $new );
1767             }
1768             elsif( $self->_is_object( $this ) && $self->isa_collection( $this ) )
1769             {
1770 0         0 my $kids = $this->children;
1771 0         0 my $new = $process->( $self->children, $kids );
1772 0         0 $collection->children( $new );
1773             }
1774             elsif( $self->_is_object( $this ) && $this->isa( 'HTML::Object::DOM::Element' ) )
1775             {
1776 0         0 $this = $self->new_array( [ $this ] );
1777 0         0 my $new = $process->( $self->children, $this );
1778 0         0 $collection->children( $new );
1779             }
1780             else
1781             {
1782 0         0 return( $self->error( "I receive an object \"", ref( $this ), "\", but I do not know what to do with it." ) );
1783             }
1784 0         0 return( $collection );
1785             }
1786              
1787             # Returns a new collection of elements whose position is an even number
1788             sub odd
1789             {
1790 0     0 0 0 my $self = shift( @_ );
1791 0 0       0 return( $self ) unless( $self->isa_collection );
1792 0         0 my $odd = $self->children->odd;
1793 0         0 my $collection = $self->new_collection;
1794 0         0 $collection->children( $odd );
1795 0         0 return( $collection );
1796             }
1797              
1798             # Takes html string (start with <tag...), text object (HTML::Object::DOM::Text), array or element object
1799             # or alternatively a code reference that returns the above
1800 0     0 1 0 sub prepend { return( shift->_append_prepend( @_, { action => 'prepend' } ) ); }
1801              
1802 0     0 0 0 sub prependTo { return( shift->_append_prepend_to( @_, { action => 'prepend' } ) ); }
1803              
1804             # TODO: prop(), e.g. $e->prop('outerHTML') or $e->prop('tagName')
1805             sub prop
1806             {
1807 0     0 0 0 my $self = shift( @_ );
1808             # In get mode, this only affects the first element of the set
1809             # In set mode, this affect all elements of the set
1810             # <https://api.jquery.com/prop/#prop-propertyName>
1811             # <https://developer.mozilla.org/en-US/docs/Web/API/Element#properties>
1812             my $map =
1813             {
1814 0     0   0 checked => sub{ return( shift->attr( 'checked' ) ); },
1815             # Returns the number of child elements of this element.
1816 0     0   0 childElementCount => sub{ return( shift->children->length ); },
1817             # Returns the child elements of this element.
1818 0     0   0 children => sub{ return( shift->children ); },
1819             # Is a DOMString representing the class of the element.
1820 0     0   0 className => sub{ return( shift->attr( 'class' ) ); },
1821 0     0   0 disabled => sub{ return( shift->attr( 'disabled' ) ); },
1822             # Returns the first child element of this element.
1823 0     0   0 firstElementChild => sub{ return( shift->children->first ); },
1824             # Is a DOMString representing the id of the element.
1825 0     0   0 id => sub{ return( shift->attr( 'id' ) ); },
1826             # Is a DOMString representing the markup of the element's content.
1827             innerHTML => sub
1828             {
1829 0     0   0 my $e = shift( @_ );
1830 0         0 my $a = $self->new_array;
1831             $self->children->foreach(sub
1832             {
1833 0         0 my $e = shift( @_ );
1834 0         0 my $v = $e->as_string;
1835 0 0       0 $a->push( defined( $v ) ? $v->scalar : $v );
1836 0         0 });
1837 0         0 return( $a->join( '' ) );
1838             },
1839             # Returns the last child element of this element.
1840 0     0   0 lastElementChild => sub{ return( shift->children->last ); },
1841             # A DOMString representing the local part of the qualified name of the element.
1842 0     0   0 localName => sub{ return( shift->tag ); },
1843             # Is an Element, the element immediately following the given one in the tree, or null if there's no sibling node.
1844             nextElementSibling => sub
1845             {
1846 0     0   0 my $e = shift( @_ );
1847 0   0     0 my $parent = $e->parent || return;
1848 0         0 my $pos = $parent->children->pos( $e );
1849 0         0 return( $parent->children->index( $pos + 1 ) );
1850             },
1851             # Is a DOMString representing the markup of the element including its content. When used as a setter, replaces the element with nodes parsed from the given string.
1852 0     0   0 outerHTML => sub{ return( shift->as_string ); },
1853             # Is a Element, the element immediately preceding the given one in the tree, or null if there is no sibling element.
1854             previousElementSibling => sub
1855             {
1856 0     0   0 my $e = shift( @_ );
1857 0   0     0 my $parent = $e->parent || return;
1858 0         0 my $pos = $parent->children->pos( $e );
1859 0         0 return( $parent->children->index( $pos - 1 ) );
1860             },
1861 0     0   0 readonly => sub{ return( shift->attr( 'readonly' ) ); },
1862             # Returns a String with the name of the tag for the given element.
1863 0     0   0 tagName => sub{ return( shift->tag ); },
1864 0         0 };
1865 0         0 my $ro = $self->new_array( [qw(
1866             childelementcount children firstelementchild
1867             )] );
1868            
1869             # Get
1870 0 0       0 if( scalar( @_ ) == 1 )
    0          
1871             {
1872 0 0       0 my $e = $self->isa_collection ? $self->children->first : $self;
1873 0 0       0 return if( !$e );
1874 0         0 my $prop = lc( shift( @_ ) );
1875 0 0       0 return( $self->error( "No such property \"$prop\"." ) ) if( !CORE::exists( $map->{ $prop } ) );
1876 0         0 my $code = $map->{ $prop };
1877 0         0 return( $code->( $e ) );
1878             }
1879             # Set
1880             elsif( scalar( @_ ) > 1 )
1881             {
1882 0 0       0 my $all = $self->new_array( $self->isa_collection ? $self->children : [ $self ] );
1883 0         0 my @props = @_;
1884 0         0 while( scalar( @props ) )
1885             {
1886 0         0 my( $prop, $val ) = CORE::splice( @props, 0, 2 );
1887 0         0 $prop = lc( $prop );
1888 0 0 0     0 if( defined( $val ) && CORE::length( $val ) && $ro->exists( $prop ) )
      0        
1889             {
1890 0         0 next;
1891             }
1892            
1893             # process the html
1894 0 0       0 if( $prop eq 'innerHTML' )
    0          
1895             {
1896 0 0       0 if( defined( $val ) )
1897             {
1898 0         0 my $p = HTML::Object::DOM->new;
1899             my $doc = $p->parse_data( $val ) || do
1900 0   0     0 {
1901             $! = $p->error;
1902             return;
1903             };
1904             $all->foreach(sub
1905             {
1906 0     0   0 my $e = shift( @_ );
1907 0         0 $e->children( $doc->children );
1908 0         0 $e->reset(1);
1909 0         0 });
1910             }
1911             else
1912             {
1913             $all->foreach(sub
1914             {
1915 0     0   0 my $e = shift( @_ );
1916 0         0 $e->children->empty;
1917 0         0 $e->reset(1);
1918 0         0 });
1919             }
1920 0         0 next;
1921             }
1922             elsif( $prop eq 'outerHTML' )
1923             {
1924 0 0       0 if( defined( $val ) )
1925             {
1926 0         0 my $p = HTML::Object::DOM->new;
1927             my $doc = $p->parse_data( $val ) || do
1928 0   0     0 {
1929             $! = $p->error;
1930             return;
1931             };
1932             $all->foreach(sub
1933             {
1934 0     0   0 my $e = shift( @_ );
1935 0         0 my $parent = $e->parent;
1936 0 0       0 return(1) if( !$parent );
1937 0         0 my $pos = $parent->children->pos( $e );
1938 0         0 my @new = ();
1939             $doc->children->foreach(sub
1940             {
1941 0         0 my $kid = shift( @_ );
1942 0         0 my $clone = $kid->clone;
1943 0         0 $clone->parent( $parent );
1944 0         0 push( @new, $clone );
1945 0         0 });
1946 0         0 $parent->children->splice( $pos, 1, @new );
1947 0         0 $parent->reset(1);
1948 0         0 });
1949             }
1950             else
1951             {
1952             $all->foreach(sub
1953             {
1954 0     0   0 my $e = shift( @_ );
1955 0         0 my $parent = $e->parent;
1956 0 0       0 return(1) if( !$parent );
1957 0         0 my $pos = $parent->children->pos( $e );
1958 0         0 $e->children->splice( $pos, 1 );
1959 0         0 $e->reset(1);
1960 0         0 });
1961             }
1962 0         0 next;
1963             }
1964            
1965             $all->foreach(sub
1966             {
1967 0     0   0 my $e = shift( @_ );
1968 0 0       0 if( $prop eq 'checked' )
    0          
    0          
    0          
    0          
1969             {
1970 0 0       0 if( $val )
1971             {
1972 0         0 $e->attr( checked => 'checked' );
1973             }
1974             else
1975             {
1976 0         0 $e->attributes->delete( $prop );
1977             }
1978 0         0 $e->reset(1);
1979             }
1980             elsif( $prop eq 'className' )
1981             {
1982 0 0       0 if( defined( $val ) )
1983             {
1984 0         0 $e->attr( class => $val );
1985             }
1986             else
1987             {
1988 0         0 $e->attributes->delete( 'class' );
1989             }
1990 0         0 $e->reset(1);
1991             }
1992             elsif( $prop eq 'disabled' )
1993             {
1994 0 0       0 if( $val )
1995             {
1996 0         0 $e->attr( disabled => 'disabled' );
1997             }
1998             else
1999             {
2000 0         0 $e->attributes->delete( $prop );
2001             }
2002 0         0 $e->reset(1);
2003             }
2004             elsif( $prop eq 'id' )
2005             {
2006 0 0       0 if( defined( $val ) )
2007             {
2008 0         0 $e->attr( id => $val );
2009             }
2010             else
2011             {
2012 0         0 $e->attributes->delete( $prop );
2013             }
2014 0         0 $e->reset(1);
2015             }
2016             elsif( $prop eq 'readonly' )
2017             {
2018 0 0       0 if( $val )
2019             {
2020 0         0 $e->attr( readonly => 'readonly' );
2021             }
2022             else
2023             {
2024 0         0 $e->attributes->delete( $prop );
2025             }
2026 0         0 $e->reset(1);
2027             }
2028 0         0 });
2029             }
2030             }
2031             }
2032              
2033             sub promise
2034             {
2035 0     0 0 0 my $self = shift( @_ );
2036 0         0 return( Promise::Me->new( @_ ) );
2037             # my $deferred = Promise::XS::deferred();
2038             # return( $deferred->promise() );
2039             }
2040              
2041 29     29 0 201 sub rank { return( shift->_set_get_number_as_object( 'rank', @_ ) ); }
2042              
2043             # <https://api.jquery.com/remove/>
2044             # TODO: Need to check again and do some test to ensure this api is compliant
2045             sub remove
2046             {
2047 0     0 1 0 my $self = shift( @_ );
2048 0 0       0 if( $self->isa_collection )
    0          
2049             {
2050 0     0   0 my $deleted = $self->children->foreach(sub{ $_->delete });
  0         0  
2051             }
2052             # xpath provided
2053             elsif( @_ )
2054             {
2055 0   0     0 my $xpath = $self->_xpath_value( shift( @_ ) ) || return;
2056 0         0 return( $self->find( $xpath )->remove );
2057             }
2058             # Equivalent to delete
2059             else
2060             {
2061 0         0 return( $self->delete );
2062             }
2063             }
2064              
2065             sub removeAttr
2066             {
2067 0     0 0 0 my $self = shift( @_ );
2068 0         0 my $attr = shift( @_ );
2069 0 0       0 return( $self ) if( !defined( $attr ) );
2070 0 0       0 if( $self->isa_collection )
2071             {
2072             $self->children->foreach(sub
2073             {
2074 0     0   0 $_->attributes->delete( $attr );
2075 0         0 $_->reset(1);
2076 0         0 });
2077             }
2078             else
2079             {
2080 0         0 $self->attributes->delete( $attr );
2081 0         0 $self->reset(1);
2082             }
2083 0         0 return( $self );
2084             }
2085              
2086             # class name, array of class name or a code reference
2087             # If parameter is a code reference it must return a class name or an array of class name
2088             # It receives "the index position of the element in the set and the old class value as arguments"
2089             sub removeClass
2090             {
2091 0     0 0 0 my $self = shift( @_ );
2092 0         0 my $this;
2093 0 0       0 $this = shift( @_ ) if( @_ );
2094 0         0 my $a;
2095             # No class provided, so we will remove all existing class
2096 0 0       0 if( !defined( $this ) )
    0          
2097             {
2098 0         0 $a = $self->new_array;
2099             }
2100             elsif( $self->_is_array( $this ) )
2101             {
2102 0         0 $a = $self->new_array( $this );
2103 0         0 my $failed = 0;
2104             $a->foreach(sub
2105             {
2106 0 0 0 0   0 $failed++, return( $self->error( "Class provided to be removed \"$_\" is not a string nor an overloaded object." ) ) if( ref( $_ ) && !( overload::Overloaded( $_ ) && overload::Method( $_, '""' ) ) );
      0        
2107 0         0 });
2108 0 0       0 return( $self ) if( $failed );
2109             }
2110            
2111 0         0 my $process;
2112             $process = sub
2113             {
2114 0     0   0 my $e = shift( @_ );
2115 0 0       0 return( $e ) unless( $e->attributes->exists( 'class' ) );
2116 0         0 my $c = $self->new_array( [split( /[[:blank:]\h]+/, $e->attributes->get( 'class' ) )] );
2117             # Loop through the element classes
2118             $c->for(sub
2119             {
2120 0         0 my( $i, $v ) = @_;
2121 0 0       0 if( ref( $this ) CORE::eq 'CODE' )
2122             {
2123 0         0 local $_ = $self;
2124 0         0 my $res = $this->( $i, $v );
2125 0 0       0 if( $self->_is_array( $res ) )
2126             {
2127 0         0 $a = $self->new_array( $res );
2128             }
2129             else
2130             {
2131 0         0 $a = $self->new_array( [ $res ] );
2132             }
2133             }
2134             $a->foreach(sub
2135             {
2136 0         0 my $to_remove = shift( @_ );
2137 0 0       0 if( $v CORE::eq "$to_remove" )
2138             {
2139 0         0 $c->splice( $i, 1 );
2140 0         0 $c->return( -1 );
2141             }
2142 0         0 return;
2143 0         0 });
2144 0         0 });
2145 0         0 $e->reset(1);
2146 0         0 return(1);
2147 0         0 };
2148 0 0       0 if( $self->isa_collection )
2149             {
2150 0         0 $self->children->foreach( $process );
2151             }
2152             else
2153             {
2154 0         0 $process->( $self );
2155             }
2156 0         0 return( $self );
2157             }
2158              
2159             # Takes html string, array of elements, an element (including a collection object) or a code reference
2160             sub replaceWith
2161             {
2162 0     0 1 0 my $self = shift( @_ );
2163 0   0     0 my $this = shift( @_ ) || return( $self->error( "Nothing was provided to replace." ) );
2164 0         0 my $a;
2165 0 0       0 if( !ref( $this ) )
    0          
    0          
    0          
2166             {
2167 0         0 my $p = $self->new_parser;
2168 0   0     0 $this = $p->parse_data( $this ) || return( $self->pass_error( $p->error ) );
2169 0         0 $a = $self->new_array( [ $this ] );
2170             }
2171             elsif( $self->_is_array( $this ) )
2172             {
2173             # Make sure this is a Module::Generic::Array object
2174 0         0 $a = $self->new_array( $this );
2175             }
2176             elsif( $self->_is_object( $this ) )
2177             {
2178 0 0       0 return( $self->error( "Object provided '$this' (", overload::StrVal( $this ), ") is not an HTML::Object::DOM::Element object." ) ) if( !$this->isa( 'HTML::Object::DOM::Element' ) );
2179 0         0 $a = $self->new_array( [ $this ] );
2180             }
2181             elsif( ref( $this ) ne 'CODE' )
2182             {
2183 0         0 return( $self->error( "I do not know what to do with '$this'. I was expecing an html string, or an HTML::Object::DOM::Element or an array of element objects or a collection object (HTML::Object::Collection) or a code reference." ) );
2184             }
2185            
2186 0 0       0 if( $self->isa_collection )
2187             {
2188 0         0 my $failed = 0;
2189             $self->children->foreach(sub
2190             {
2191 0     0   0 my $elem = shift( @_ );
2192 0 0       0 if( ref( $this ) CORE::eq 'CODE' )
2193             {
2194 0         0 local $_ = $elem;
2195 0         0 my $res = $this->( $elem );
2196 0 0       0 $failed++, return( $self->error( "An error occurred while executing code reference to replace html element(s). Code reference returned undef." ) ) if( !defined( $res ) );
2197 0 0 0     0 if( $self->_is_object( $res ) && $res->isa( 'HTML::Object::DOM::Element' ) )
    0 0        
2198             {
2199 0         0 $a = $self->new_array( [ $res ] );
2200             }
2201             elsif( overload::Overloaded( $res ) && overload::Method( $res, '""' ) )
2202             {
2203 0         0 my $elem = $self->new_parser( "$res" );
2204 0 0       0 $failed++, return if( !defined( $elem ) );
2205 0         0 $a = $self->new_array( [ $elem ] );
2206             }
2207             else
2208             {
2209 0         0 $failed++, return( $self->error( "Value returned from code reference to be used in replaceWith is neither a string nor a HTML::Object::DOM::Element, so I do not know what to do with it." ) );
2210             }
2211             }
2212 0 0       0 return( $self->error( "Found an element within a collection that has no parent! Element has tag \"", $elem->tag, "\"." ) ) if( !$elem->parent );
2213 0         0 my $pos = $elem->parent->pos( $elem );
2214 0 0       0 return( $self->error( "This element with tag \"", $self->tag, "\" has a parent and yet I could not find its position." ) ) if( !defined( $pos ) );
2215 0         0 my $new = $self->new_array;
2216             $a->foreach(sub
2217             {
2218 0         0 my $e = $_->detach->clone();
2219 0         0 $e->parent( $elem->parent );
2220 0         0 $new->push( $e );
2221 0         0 });
2222 0         0 $elem->parent->children->splice( $pos, 1, $a->list );
2223 0         0 $elem->parent->reset(1);
2224 0         0 });
2225             # Now that the element have been copied to their replacement location, we remove them
2226             $a->foreach(sub
2227             {
2228 0     0   0 $_->delete;
2229 0         0 });
2230 0 0       0 return if( $failed );
2231             }
2232             else
2233             {
2234 0 0       0 if( ref( $this ) CORE::eq 'CODE' )
2235             {
2236 0         0 local $_ = $self;
2237 0         0 my $res = $this->( $self );
2238 0 0       0 return( $self->error( "An error occurred while executing code reference to replace html element(s). Code reference returned undef." ) ) if( !defined( $res ) );
2239 0 0 0     0 if( $self->_is_object( $res ) && $res->isa( 'HTML::Object::DOM::Element' ) )
    0 0        
2240             {
2241 0         0 $a = $self->new_array( [ $res ] );
2242             }
2243             elsif( overload::Overloaded( $res ) && overload::Method( $res, '""' ) )
2244             {
2245 0         0 my $elem = $self->new_parser( "$res" );
2246 0 0       0 return if( !defined( $elem ) );
2247 0         0 $a = $self->new_array( [ $elem ] );
2248             }
2249             else
2250             {
2251 0         0 return( $self->error( "Value returned from code reference to be used in replaceWith is neither a string nor a HTML::Object::DOM::Element, so I do not know what to do with it." ) );
2252             }
2253             }
2254            
2255             # Object has no parent, so we are essentially replace 1 element for one or more others with no attachment to the dom
2256 0 0       0 if( !$self->parent )
2257             {
2258             # Basically swapping one element for another
2259 0 0       0 if( $a->length == 1 )
2260             {
2261 0         0 my $e = $a->first;
2262 0         0 $e->detach;
2263 0         0 return( $e );
2264             }
2265             # There are multiple element, create a document element
2266             else
2267             {
2268 0         0 my $doc = HTML::Object::DOM::Document->new;
2269 0         0 $doc->children( $a );
2270             $a->foreach(sub
2271             {
2272 0     0   0 $_->detach;
2273 0         0 $_->parent( $doc );
2274 0         0 $_->parent->reset(1);
2275 0         0 });
2276 0         0 return( $doc );
2277             }
2278             }
2279             else
2280             {
2281 0         0 my $pos = $self->parent->pos( $self );
2282 0 0       0 return( $self->error( "This element with tag \"", $self->tag, "\" has a parent and yet I could not find its position." ) ) if( !defined( $pos ) );
2283             $a->foreach(sub
2284             {
2285 0     0   0 $_->detach->parent( $self->parent );
2286 0         0 });
2287 0         0 $self->parent->children->splice( $pos, 1, $a->list );
2288 0         0 $self->parent->reset(1);
2289             }
2290             }
2291 0         0 return( $self );
2292             }
2293              
2294             sub set_namespace
2295             {
2296 0     0 0 0 my $self = shift( @_ );
2297 0         0 return( $self->xp->new->set_namespace( @_ ) );
2298             }
2299              
2300             # Since this is a perl context, this only set the inline css 1) back to its previous value,
2301             # if any; or 2) remove the display property if there was no previous value set.
2302             # Any parameter provided will be ignored
2303             # See the hide() method for its alter ego.
2304             sub show
2305             {
2306 0     0 0 0 my $self = shift( @_ );
2307 0         0 my( $this, $code ) = @_;
2308 0 0 0     0 $code = $this if( ref( $this ) eq 'CODE' && !defined( $code ) );
2309 0         0 my $process;
2310             $process = sub
2311             {
2312 0     0   0 my $e = shift( @_ );
2313 0         0 my $internal = $e->internal;
2314 0         0 my $rule = $self->_css_object();
2315 0 0       0 if( defined( $rule ) )
2316             {
2317 0         0 my $display = $rule->get_property_by_name( 'display' );
2318 0         0 my $val = $display->value;
2319             # if display current value is 'none', we check if there was a previous value we kept
2320             # and if there is we restore it, otherwise we simply just remove the property
2321 0 0       0 if( $val eq 'none' )
2322             {
2323 0         0 my $previous_val = $internal->{css_display_value};
2324 0 0 0     0 if( defined( $previous_val ) && CORE::length( $previous_val ) )
2325             {
2326 0         0 $display->value( $previous_val );
2327             }
2328             else
2329             {
2330 0         0 $display->remove_from( $rule );
2331             }
2332             }
2333             }
2334             # otherwise, there is no rule inline defined, and thus, nothing to do.
2335            
2336             # Is there any rule and properties to save back?
2337 0 0 0     0 if( defined( $rule ) && $rule->elements->length > 0 )
2338             {
2339 0         0 $e->_css_object( $rule );
2340             }
2341 0         0 };
2342            
2343 0 0       0 if( $self->isa_collection )
    0          
2344             {
2345             $self->children->foreach(sub
2346             {
2347 0     0   0 $process->( $_ );
2348 0         0 $_->reset(1);
2349 0         0 });
2350             }
2351             elsif( $self->tag->substr( 0, 1 ) eq '_' )
2352             {
2353 0         0 return( $self->error( "You can only use the hide() or show() method on html object elements. The element you are calling hide() with is an object of class \"", ref( $self ), "\"." ) );
2354             }
2355             else
2356             {
2357 0         0 $process->( $self );
2358 0         0 $self->reset(1);
2359             }
2360             }
2361              
2362             sub string_value
2363             {
2364 0     0 0 0 my $self = shift( @_ );
2365 0 0       0 return( $self->value ) if( $self->isCommentNode );
2366 0         0 return( $self->as_text );
2367             }
2368              
2369             # This is normally a HTML::Object::DOM::Element property and it should not be used equally
2370             # by a collection object, because of its nature, so we created it here to catch calls to it
2371             # while still allowing HTML::Object::DOM::Element to use it normally
2372             sub tag
2373             {
2374 866     866 1 989493 my $self = shift( @_ );
2375 866 100       2345 if( @_ )
2376             {
2377 76 50       480 if( $self->isa_collection )
2378             {
2379 0         0 return( $self->error( "tag is a read-only property" ) );
2380             }
2381             else
2382             {
2383 76         446 return( $self->_set_get_scalar_as_object( 'tag', @_ ) );
2384             }
2385             }
2386             else
2387             {
2388 790 100       2193 if( $self->isa_collection )
2389             {
2390 5         28 my $first = $self->children->first;
2391 5 50 33     769 return unless( $first && $self->_is_a( $first, 'HTML::Object::DOM::Element' ) );
2392 5         187 return( $first->_set_get_scalar_as_object( 'tag' ) );
2393             }
2394             else
2395             {
2396 785         2367 return( $self->_set_get_scalar_as_object( 'tag' ) );
2397             }
2398             }
2399             }
2400              
2401             sub tagname
2402             {
2403 0     0 0 0 my $self = shift( @_ );
2404 0         0 my @args = @_;
2405 0         0 my $map =
2406             {
2407             Comment => '#comment',
2408             Text => '#text'
2409             };
2410 0         0 my $a = $self->new_array;
2411             $self->children->foreach(sub
2412             {
2413 0     0   0 my $e = shift( @_ );
2414 0         0 my $type = [split( /::/, ref( $e ) )]->[-1];
2415 0 0       0 $a->push( exists( $map->{ $type } ) ? $map->{ $type } : $e->tag( @args ) );
2416 0         0 });
2417 0         0 return( $a );
2418             }
2419              
2420             # Takes a class name; or
2421             # class name and state (true or false); or
2422             # array of class names; or
2423             # array of class names and a state; or
2424             # a code reference called with the index position of the current class and its name. Returns a space separated list of classes or an array
2425             # <https://api.jquery.com/toggleClass/>
2426             sub toggleClass
2427             {
2428 0     0 0 0 my $self = shift( @_ );
2429 0         0 my $this;
2430 0 0       0 $this = shift( @_ ) if( @_ );
2431 0         0 my $state;
2432 0 0       0 $state = scalar( @_ ) ? shift( @_ ) : 1;
2433 0         0 my $a = $self->new_array;
2434 0         0 my $has_code = 0;
2435 0 0       0 if( defined( $this ) )
2436             {
2437 0 0 0     0 if( $self->_is_array( $this ) )
    0 0        
    0          
2438             {
2439 0         0 $a = $self->new_array( $this );
2440             }
2441             elsif( ref( $this ) CORE::eq 'CODE' )
2442             {
2443             # ok
2444 0         0 $has_code++;
2445             }
2446             elsif( ref( $this ) && overload::Overloaded( $this ) && overload::Method( $this, '""' ) )
2447             {
2448 0         0 $a = $self->new_array( [split( /[[:blank:]\h]+/, "$this" )] );
2449             }
2450             else
2451             {
2452 0         0 return( $self->error( "I was expecting an array reference of classes, or class string or a code reference, but instead I got '$this', and I do not know what to do with it." ) );
2453             }
2454             # Make sure the classes we are provided are unique
2455 0         0 $a->unique(1);
2456             }
2457            
2458 0         0 my $process;
2459             $process = sub
2460             {
2461 0     0   0 my( $i, $e ) = @_;
2462 0         0 my $ref = $e->internal->{class};
2463 0   0     0 $ref //= {};
2464 0   0     0 $ref->{toggle_status} //= 0;
2465 0         0 my $classes;
2466 0 0       0 if( $e->attributes->exists( 'class' ) )
2467             {
2468 0         0 $classes = $self->new_array( [split( /[[:blank:]\h]+/, $e->attributes->get( 'class' ) )] );
2469 0   0     0 $ref->{original_classes} //= $classes;
2470             }
2471             # No class on this element yet
2472            
2473 0 0       0 if( $has_code )
2474             {
2475 0         0 local $_ = $e;
2476 0         0 my $res = $this->( $i, $classes, $ref->{toggle_status} );
2477 0 0 0     0 if( $self->_is_array( $res ) )
    0 0        
2478             {
2479 0         0 $a = $self->new_array( $res );
2480             }
2481             elsif( !ref( $res ) || ( overload::Overloaded( $res ) && overload::Method( $res, '""' ) ) )
2482             {
2483 0         0 $a = $self->new_array( [ split( /[[:blank:]\h]+/, "$res" ) ] );
2484             }
2485             else
2486             {
2487 0         0 warn( "Code reference for class of element with tag \"", $e->tag, "\" returned '$this', but I do not know what to do with it.\n" );
2488 0         0 return( 1 );
2489             }
2490 0         0 $a->unique(1);
2491             }
2492            
2493             # No class set yet on this element
2494 0 0       0 if( !defined( $classes ) )
2495             {
2496             # and we have no class either, so we skip to the next element. Nothing to do here
2497 0 0       0 if( !$a->length )
2498             {
2499 0         0 return(1);
2500             }
2501             # we activate our classes
2502             else
2503             {
2504 0         0 $ref->{toggle_status} = 1;
2505 0         0 $e->attributes->set( class => $a->join( ' ' ) );
2506 0         0 $e->reset(1);
2507             }
2508             }
2509             else
2510             {
2511             # we found existing class, and we toggled without specifying any
2512             # which mean we switch them all on/off
2513 0 0       0 if( !$a->length )
2514             {
2515 0 0       0 $e->attributes->set( class => ( $ref->{toggle_status} ? $ref->{original_classes} : '' ) );
2516             }
2517             # Specific were provided. We toggle them on/off
2518             else
2519             {
2520 0 0       0 if( $ref->{toggle_status} )
2521             {
2522 0         0 $classes->remove( $a );
2523             }
2524             else
2525             {
2526 0         0 $classes->push( $a->list )->unique;
2527             }
2528 0         0 $e->attributes->set( class => $classes->join( ' ' ) );
2529 0         0 $e->reset(1);
2530 0         0 $ref->{toggle_status} = !$ref->{toggle_status};
2531             }
2532             }
2533 0         0 };
2534            
2535 0 0       0 if( $self->isa_collection )
2536             {
2537 0         0 $self->children->for( $process );
2538             }
2539             else
2540             {
2541 0         0 $process->( 0, $self );
2542             }
2543             }
2544              
2545 0     0 1 0 sub to_number { return( HTML::Object::DOM::Number->new( shift->getValue ) ); }
2546              
2547 0     0 1 0 sub toString { return( shift->as_xml( @_ ) ); }
2548              
2549             sub xp
2550             {
2551 8     8 1 25 my $self = shift( @_ );
2552 8 100       34 unless( $XP )
2553             {
2554 2         36 $XP = HTML::Object::XPath->new;
2555             }
2556             # $XP->debug( $self->debug );
2557 8         72 return( $XP );
2558             }
2559              
2560             # Ref: <https://api.jquery.com/Types/#jQuery>
2561             # xq( '#myId', $document )
2562             # xq( '<div />', { id => 'Pouec', class => 'Hello' } );
2563             # xq( '<html><head><title>Hello world</title></head><body>Hello!</body></html>' );
2564             # xq();
2565             sub xq
2566             {
2567 13     13 0 24891 my( $this, $more ) = @_;
2568             # e.g. $('<div />', { id => 'pouec', class => 'hello' });
2569 13 100 0     199 if( $this =~ /$LOOK_LIKE_HTML/ )
    50 33        
2570             {
2571 6 50       32 print( STDERR __PACKAGE__, "::xq: Argument provided looks like ", CORE::length( $this ), " bytes of HTML, parsing it.\n" ) if( $HTML::Object::XQuery::DEBUG >= 4 );
2572 6         60 my $p = HTML::Object::DOM->new;
2573             my $doc = $p->parse_data( $this ) || do
2574 6   33     66 {
2575             $! = $p->error;
2576             return;
2577             };
2578             # $doc is a HTML::Object::DOM::Document, which is not suitable, so we change it to a
2579             # collection object
2580 6         63 my $collection = $doc->new_collection;
2581 6 50       27 print( STDERR __PACKAGE__, "::xq: Pushing ", $doc->children->length, " elements found into our new collection.\n" ) if( $HTML::Object::XQuery::DEBUG >= 4 );
2582 6         26 $collection->children( $doc->children );
2583 6 100       1174 if( $doc->children->length == 1 )
2584             {
2585 4         144337 my $e = $doc->children->first;
2586             # I do not use Module::Generic::_is_hash on purpose because I do not want to catch objects inadvertently
2587             # We found attributes, so we set them up now
2588 4 50       676 if( ref( $more ) CORE::eq 'HASH' )
2589             {
2590 4 50       23 my $debug = CORE::delete( $more->{_debug} ) if( CORE::exists( $more->{_debug} ) );
2591 4         21 $e->attributes->merge( $more );
2592 4         2505 $e->debug( $debug );
2593 4         137 $collection->debug( $debug );
2594             }
2595             # We correct a situation where the user called for example $('<div />', { class => 'hello', id => 'pouec' });
2596             # And this would lead the parser to flag it to be empty, respecting the user decision,
2597             # but in this case, this is merely a short-hand notation to create a tag, and is not a
2598             # reflexion that this tag should indeed be treated as empty when it is not by standard
2599             # hus, we correct it here.
2600 4 50 33     94 if( $e->children->length == 0 && $e->is_empty )
2601             {
2602 4         3445 my $def = $p->get_definition( $e->tag );
2603 4 50       30 $e->is_empty(0) if( !$def->{is_empty} );
2604 4         2738 $e->close;
2605             }
2606             }
2607 6         73118 return( $collection );
2608             }
2609             elsif( !ref( $this ) || ( overload::Overloaded( $this ) && overload::Method( $this, '""' ) ) )
2610             {
2611 7 50       39 print( STDERR __PACKAGE__, "::xq: Argument provided '$this' looks like a selector, searching for it.\n" ) if( $HTML::Object::XQuery::DEBUG >= 4 );
2612             # e.g. $('div')
2613 7 100 33     87 if( !defined( $more ) )
    100 66        
2614             {
2615             # e.g. $('body')
2616 3 50       13 if( defined( $HTML::Object::DOM::GLOBAL_DOM ) )
2617             {
2618 3   50     47 my $collection = $HTML::Object::DOM::GLOBAL_DOM->find( $this ) || return;
2619 3         33 return( $collection );
2620             }
2621             else
2622             {
2623 0         0 return( HTML::Object::DOM->error( "You need to provide some context to the selector by supplying an HTML::Object::DOM::Element object." ) );
2624             }
2625             }
2626             # e.g., with context: $('div', $element);
2627             elsif( !ref( $more ) || ( ref( $more ) && !$more->isa( 'HTML::Object::DOM::Element' ) ) )
2628             {
2629 1         11 return( HTML::Object::DOM->error( "Context provided selector must be an element object. Got '", overload::StrVal( $more ), "'" ) );
2630             }
2631 3   50     28 my $collection = $more->find( $this ) || return( HTML::Object::DOM->pass_error( $more->error ) );
2632 3         19 $collection->debug( $more->debug );
2633 3         228 return( $collection );
2634             }
2635             else
2636             {
2637 0         0 return( HTML::Object::DOM->error( "I do not know what to do with '$this'." ) );
2638             }
2639             }
2640              
2641             sub _append_prepend
2642             {
2643 0     0   0 my $self = shift( @_ );
2644 0   0     0 my $this = shift( @_ ) || return( $self->error( "Nothing was provided to append or prepend." ) );
2645 0         0 my $opts = $self->_get_args_as_hash( @_ );
2646 0 0       0 if( !exists( $opts->{action} ) )
2647             {
2648 0         0 my @caller_info = caller(1);
2649 0         0 my $caller = [split( /::/, $caller_info[3])]->[-1];
2650 0 0       0 return( $self->error( "No action argument was provided and I am unable to guess it." ) ) if( $caller !~ /^(append|prepend)$/ );
2651 0         0 $opts->{action} = $caller;
2652             }
2653 0 0       0 return( $self->error( "Invalid value for argument \"action\": '$opts->{action}'" ) ) if( $opts->{action} !~ /^(append|prepend)$/ );
2654 0         0 my $a;
2655 0 0       0 if( !ref( $this ) )
    0          
    0          
    0          
2656             {
2657 0         0 my $p = $self->new_parser;
2658 0   0     0 $this = $p->parse_data( $this ) || return( $self->pass_error( $p->error ) );
2659 0         0 $a = $self->new_array( [ $this ] );
2660             }
2661             elsif( $self->_is_array( $this ) )
2662             {
2663             # Make sure this is a Module::Generic::Array object
2664 0         0 $a = $self->new_array( $this );
2665             }
2666             elsif( $self->_is_object( $this ) )
2667             {
2668 0 0       0 return( $self->error( "Object provided '$this' (", overload::StrVal( $this ), ") is not an HTML::Object::DOM::Element object." ) ) if( !$this->isa( 'HTML::Object::DOM::Element' ) );
2669 0         0 $a = $self->new_array( [ $this ] );
2670             }
2671             elsif( ref( $this ) ne 'CODE' )
2672             {
2673 0         0 return( $self->error( "I do not know what to do with '$this'. I was expecing an html string, or an HTML::Object::DOM::Element or an array of element objects or a collection object (HTML::Object::Collection) or a code reference." ) );
2674             }
2675            
2676 0 0       0 if( $self->isa_collection )
2677             {
2678 0         0 my $failed = 0;
2679             # Going through each object in the collection
2680             $self->children->for(sub
2681             {
2682 0     0   0 my( $i, $e ) = @_;
2683 0         0 $e->reset(1);
2684             # will silently fail just like jQuery does
2685 0         0 my $parent = $e->parent;
2686 0 0       0 my $pos = $parent ? $parent->children->pos( $e ) : $i;
2687 0 0       0 if( ref( $this ) CORE::eq 'CODE' )
2688             {
2689 0         0 local $_ = $e;
2690 0         0 my $res = $this->( $pos, $e->as_string );
2691 0 0       0 $failed++, return( $self->error( "An error occurred while executing code reference to $opts->{action} html element(s). Code reference returned undef." ) ) if( !defined( $res ) );
2692 0 0 0     0 if( $self->_is_object( $res ) && $res->isa( 'HTML::Object::DOM::Element' ) )
    0 0        
2693             {
2694 0         0 $a = $self->new_array( [ $res ] );
2695             }
2696             elsif( overload::Overloaded( $res ) && overload::Method( $res, '""' ) )
2697             {
2698 0         0 my $elem = $self->new_parser( "$res" );
2699 0 0       0 $failed++, return if( !defined( $elem ) );
2700 0         0 $a = $self->new_array( [ $elem ] );
2701             }
2702             else
2703             {
2704 0         0 $failed++, return( $self->error( "Value returned from code reference to be used in $opts->{action}\(\) is neither a string nor a HTML::Object::DOM::Element, so I do not know what to do with it." ) );
2705             }
2706             }
2707             $a->foreach(sub
2708             {
2709 0         0 my $elem = $_->detach->clone;
2710 0         0 $elem->parent( $e );
2711 0 0       0 if( $opts->{action} CORE::eq 'append' )
    0          
2712             {
2713 0         0 $e->children->push( $elem );
2714             }
2715             elsif( $opts->{action} CORE::eq 'prepend' )
2716             {
2717 0         0 $e->children->unshift( $elem );
2718             }
2719 0         0 });
2720 0         0 });
2721 0 0       0 return if( $failed );
2722             }
2723             else
2724             {
2725 0         0 $self->reset(1);
2726             # will silently fail just like jQuery does
2727 0         0 my $parent = $self->parent;
2728 0 0       0 my $pos = $parent ? $parent->children->pos( $self ) : 0;
2729 0 0       0 if( ref( $this ) CORE::eq 'CODE' )
2730             {
2731 0         0 local $_ = $self;
2732 0         0 my $res = $this->( $pos, $self->as_string );
2733 0 0       0 return( $self->error( "An error occurred while executing code reference to $opts->{action} html element(s). Code reference returned undef." ) ) if( !defined( $res ) );
2734 0 0 0     0 if( $self->_is_object( $res ) && $res->isa( 'HTML::Object::DOM::Element' ) )
    0 0        
2735             {
2736 0         0 $a = $self->new_array( [ $res ] );
2737             }
2738             elsif( overload::Overloaded( $res ) && overload::Method( $res, '""' ) )
2739             {
2740 0         0 my $elem = $self->new_parser( "$res" );
2741 0 0       0 return if( !defined( $elem ) );
2742 0         0 $a = $self->new_array( [ $elem ] );
2743             }
2744             else
2745             {
2746 0         0 return( $self->error( "Value returned from code reference to be used in $opts->{action}\(\) is neither a string nor a HTML::Object::DOM::Element, so I do not know what to do with it." ) );
2747             }
2748             }
2749             $a->foreach(sub
2750             {
2751 0     0   0 $_->detach();
2752 0         0 $_->parent( $self );
2753 0 0       0 if( $opts->{action} CORE::eq 'append' )
    0          
2754             {
2755 0         0 $self->children->push( $_ );
2756             }
2757             elsif( $opts->{action} CORE::eq 'prepend' )
2758             {
2759 0         0 $self->children->unshift( $_ );
2760             }
2761 0         0 });
2762             }
2763 0         0 return( $self );
2764             }
2765              
2766             # Takes html string; or
2767             # selector; or
2768             # element object; or
2769             # array of objects; or
2770             # collection
2771             # "If there is more than one target element, however, cloned copies of the inserted element will be created for each target except the last, and that new set (the original element plus clones) is returned."
2772             sub _append_prepend_to
2773             {
2774 0     0   0 my $self = shift( @_ );
2775 0   0     0 my $this = shift( @_ ) || return( $self->error( "No target was provided to insert element." ) );
2776 0         0 my $opts = $self->_get_args_as_hash( @_ );
2777 0 0       0 if( !exists( $opts->{action} ) )
2778             {
2779 0         0 my @caller_info = caller(1);
2780 0         0 my $caller = [split( /::/, $caller_info[3])]->[-1];
2781 0 0       0 return( $self->error( "No action argument was provided and I am unable to guess it." ) ) if( $caller !~ /^(appendTo|prependTo|append_to|prepend_to)$/ );
2782 0         0 $opts->{action} = ( $caller =~ /^(append|prepend)(?:To|_to)$/ )[0];
2783             }
2784 0 0       0 return( $self->error( "Invalid value for argument \"action\": '$opts->{action}'" ) ) if( $opts->{action} !~ /^(append|prepend)$/ );
2785 0         0 my $a;
2786             # A collection to be returned if there is more than 1 target
2787 0         0 my $collection = $self->new_collection;
2788 0 0       0 if( !ref( $this ) )
    0          
    0          
2789             {
2790 0 0       0 if( $self->_is_html( $this ) )
2791             {
2792 0         0 my $p = $self->new_parser;
2793 0   0     0 $this = $p->parse_data( $this ) || return( $self->pass_error( $p->error ) );
2794 0         0 $a = $self->new_array( [ $this ] );
2795             }
2796             # otherwise this has to be a selector
2797             # TODO: Need to correct this and adjust the object used as a base for the find
2798             # since $self could very well be a dynamically created dom object
2799             else
2800             {
2801 0   0     0 $this = $self->find( $this ) || return;
2802 0         0 $a = $self->new_array( [ $this ] );
2803             }
2804             }
2805             elsif( $self->_is_array( $this ) )
2806             {
2807             # Make sure this is a Module::Generic::Array object
2808 0         0 $a = $self->new_array( $this );
2809             }
2810             elsif( $self->_is_object( $this ) )
2811             {
2812 0 0       0 return( $self->error( "Object provided '$this' (", overload::StrVal( $this ), ") is not an HTML::Object::DOM::Element object." ) ) if( !$this->isa( 'HTML::Object::DOM::Element' ) );
2813 0         0 $a = $self->new_array( [ $this ] );
2814             }
2815             else
2816             {
2817 0         0 return( $self->error( "I do not know what to do with \"$this\". I was expecting a selector, html data, an element object or an array." ) );
2818             }
2819            
2820             # If the content to be inserted is a collection, we loop through it, duplicate each element and insert them
2821 0 0       0 if( $self->isa_collection )
2822             {
2823             $a->foreach(sub
2824             {
2825 0     0   0 my $elem = $_;
2826 0         0 my $parent = $elem->parent;
2827 0 0       0 return( 1 ) if( !$parent );
2828 0         0 my $pos = $parent->children->pos( $elem );
2829 0 0       0 warn( "Found a parent for tag \"", $elem->tag, "\", but somehow I could not find its position among its children elements.\n" ) if( !defined( $pos ) );
2830 0 0       0 return( 1 ) if( !defined( $pos ) );
2831             $self->children->foreach(sub
2832             {
2833 0         0 my $e = shift( @_ );
2834             # Making sure the content element is detached from its original parent
2835 0         0 my $clone = $e->detach->clone;
2836 0         0 $clone->parent( $elem );
2837 0         0 $clone->reset(1);
2838 0 0       0 if( $opts->{action} CORE::eq 'before' )
    0          
2839             {
2840 0         0 $parent->children->splice( $pos, 0, $clone );
2841             }
2842             elsif( $opts->{action} CORE::eq 'after' )
2843             {
2844 0         0 $parent->children->splice( $pos + 1, 0, $clone );
2845             }
2846 0         0 $collection->children->push( $clone );
2847 0         0 });
2848 0         0 });
2849             }
2850             else
2851             {
2852             # If the target is just one element, we do not duplicate them, but simply move them
2853 0 0       0 if( $a->length == 1 )
2854             {
2855 0         0 my $elem = $a->first;
2856 0         0 my $parent = $elem->parent;
2857 0 0       0 return( 1 ) if( !$parent );
2858 0         0 $elem->reset(1);
2859 0         0 my $pos = $parent->children->pos( $elem );
2860 0 0       0 return( $self->error( "Found a parent for tag \"", $elem->tag, "\", but somehow I could not find its position among its children elements." ) ) if( !defined( $pos ) );
2861 0         0 $self->detach;
2862 0         0 $self->parent( $elem );
2863 0 0       0 if( $opts->{action} CORE::eq 'before' )
    0          
2864             {
2865 0         0 $parent->children->splice( $pos, 0, $self );
2866             }
2867             elsif( $opts->{action} CORE::eq 'after' )
2868             {
2869 0         0 $parent->children->splice( $pos + 1, 0, $self );
2870             }
2871 0         0 $collection->children->push( $self );
2872             }
2873             # However, if the target contain multiple element, we clone the content element
2874             else
2875             {
2876             $a->foreach(sub
2877             {
2878 0     0   0 my $elem = $_;
2879 0         0 my $parent = $elem->parent;
2880 0 0       0 return( 1 ) if( !$parent );
2881 0         0 $elem->reset(1);
2882 0         0 my $pos = $parent->children->pos( $elem );
2883 0 0       0 warn( "Found a parent for tag \"", $elem->tag, "\", but somehow I could not find its position among its children elements.\n" ) if( !defined( $pos ) );
2884 0 0       0 return( 1 ) if( !defined( $pos ) );
2885 0         0 my $clone = $self->detach->clone;
2886 0         0 $clone->parent( $elem );
2887 0 0       0 if( $opts->{action} CORE::eq 'before' )
    0          
2888             {
2889 0         0 $parent->children->splice( $pos, 0, $clone );
2890             }
2891             elsif( $opts->{action} CORE::eq 'after' )
2892             {
2893 0         0 $parent->children->splice( $pos + 1, 0, $clone );
2894             }
2895 0         0 $collection->children->push( $clone );
2896 0         0 });
2897             }
2898             }
2899 0         0 return( $collection );
2900             }
2901              
2902             # Takes html string (start with <tag...), text object (HTML::Object::DOM::Text), array or element object
2903             # or alternatively a code reference that returns the above
2904             sub _before_after
2905             {
2906 3     3   13 my $self = shift( @_ );
2907 3   50     15 my $this = shift( @_ ) || return( $self->error( "Nothing was provided to insert before or after." ) );
2908 3         14 my $opts = $self->_get_args_as_hash( @_ );
2909 3 50       438 if( !exists( $opts->{action} ) )
2910             {
2911 0         0 my @caller_info = caller(1);
2912 0         0 my $caller = [split( /::/, $caller_info[3])]->[-1];
2913 0 0       0 return( $self->error( "No action argument was provided and I am unable to guess it." ) ) if( $caller !~ /^(before|after)$/ );
2914 0         0 $opts->{action} = $caller;
2915             }
2916 3 50       30 return( $self->error( "Invalid value for argument \"action\": '$opts->{action}'" ) ) if( $opts->{action} !~ /^(before|after)$/ );
2917 3         9 my $a;
2918 3 50       12 if( !ref( $this ) )
    0          
    0          
    0          
2919             {
2920 3         19 my $p = $self->new_parser;
2921 3   50     38 $this = $p->parse_data( $this ) || return( $self->pass_error( $p->error ) );
2922             # $a = $self->new_array( [ $this ] );
2923             # $this is a HTML::Document; we take its children
2924 3         15 $a = $this->children;
2925             }
2926             elsif( $self->_is_array( $this ) )
2927             {
2928             # Make sure this is a Module::Generic::Array object
2929 0         0 $a = $self->new_array( $this );
2930             }
2931             elsif( $self->_is_object( $this ) )
2932             {
2933 0 0       0 return( $self->error( "Object provided '$this' (", overload::StrVal( $this ), ") is not an HTML::Object::DOM::Element object." ) ) if( !$this->isa( 'HTML::Object::DOM::Element' ) );
2934 0         0 $a = $self->new_array( [ $this ] );
2935             }
2936             elsif( ref( $this ) ne 'CODE' )
2937             {
2938 0         0 return( $self->error( "I do not know what to do with '$this'. I was expecing an html string, or an HTML::Object::DOM::Element or an array of element objects or a collection object (HTML::Object::Collection) or a code reference." ) );
2939             }
2940            
2941 3 50       240 if( $self->isa_collection )
2942             {
2943 3         9 my $failed = 0;
2944             # Going through each object in the collection
2945             $self->children->for(sub
2946             {
2947 5     5   737 my( $i, $e ) = @_;
2948 5         25 $e->reset(1);
2949             # will silently fail just like jQuery does
2950 5         21 my $parent = $e->parent;
2951 5 50       139 return( 1 ) if( !$parent );
2952 5         11 my $pos;
2953 5 100       28 if( $opts->{action} CORE::eq 'before' )
    50          
2954             {
2955 2         9 $pos = $parent->children->pos( $e );
2956             }
2957             elsif( $opts->{action} CORE::eq 'after' )
2958             {
2959             # $pos = $parent->children->pos( $e->close_tag ? $e->close_tag : $e );
2960 3         12 $pos = $parent->children->pos( $e );
2961             }
2962 5 50       517 $failed++, return( $self->error( "Element with tag \"", $e->tag, "\" has a parent, but I could not find it among its children elements." ) ) if( !defined( $pos ) );
2963 5 50       18 if( ref( $this ) CORE::eq 'CODE' )
2964             {
2965 0         0 local $_ = $e;
2966 0         0 my $res = $this->( $pos, $e->as_string );
2967 0 0       0 $failed++, return( $self->error( "An error occurred while executing code reference to $opts->{action} html element(s). Code reference returned undef." ) ) if( !defined( $res ) );
2968 0 0 0     0 if( $self->_is_object( $res ) && $res->isa( 'HTML::Object::DOM::Element' ) )
    0 0        
2969             {
2970 0         0 $a = $self->new_array( [ $res ] );
2971             }
2972             elsif( overload::Overloaded( $res ) && overload::Method( $res, '""' ) )
2973             {
2974 0         0 my $elem = $self->new_parser( "$res" );
2975 0 0       0 $failed++, return if( !defined( $elem ) );
2976 0         0 $a = $self->new_array( [ $elem ] );
2977             }
2978             else
2979             {
2980 0         0 $failed++, return( $self->error( "Value returned from code reference to be used in $opts->{action}\(\) is neither a string nor a HTML::Object::DOM::Element, so I do not know what to do with it." ) );
2981             }
2982             }
2983             $a->foreach(sub
2984             {
2985 5         96 my $elem = $_->clone;
2986 5         93 $elem->parent( $e );
2987 5 100       208 if( $opts->{action} CORE::eq 'before' )
    50          
2988             {
2989 2         12 $parent->children->splice( $pos, 0, $_ );
2990             }
2991             elsif( $opts->{action} CORE::eq 'after' )
2992             {
2993 3         13 $parent->children->splice( $pos + 1, 0, $_ );
2994             }
2995 5         522 $pos++;
2996 5         60 });
2997 3         23 });
2998 3 50       569 return( $self->pass_error ) if( $failed );
2999             }
3000             else
3001             {
3002             # will silently fail just like jQuery does
3003 0         0 my $parent = $self->parent;
3004 0 0       0 return(1) if( !$parent );
3005 0         0 my $pos = $parent->children->pos( $self );
3006 0 0       0 return( $self->error( "Element with tag \"", $self->tag, "\" has a parent, but I could not find it among its children elements." ) ) if( !defined( $pos ) );
3007 0 0       0 if( ref( $this ) CORE::eq 'CODE' )
3008             {
3009 0         0 local $_ = $self;
3010 0         0 my $res = $this->( $pos, $self->as_string );
3011 0 0       0 return( $self->error( "An error occurred while executing code reference to $opts->{action} html element(s). Code reference returned undef." ) ) if( !defined( $res ) );
3012 0 0 0     0 if( $self->_is_object( $res ) && $res->isa( 'HTML::Object::DOM::Element' ) )
    0 0        
3013             {
3014 0         0 $a = $self->new_array( [ $res ] );
3015             }
3016             elsif( overload::Overloaded( $res ) && overload::Method( $res, '""' ) )
3017             {
3018 0         0 my $elem = $self->new_parser( "$res" );
3019 0 0       0 return if( !defined( $elem ) );
3020 0         0 $a = $self->new_array( [ $elem ] );
3021             }
3022             else
3023             {
3024 0         0 return( $self->error( "Value returned from code reference to be used in $opts->{action}\(\) is neither a string nor a HTML::Object::DOM::Element, so I do not know what to do with it." ) );
3025             }
3026             }
3027             $a->foreach(sub
3028             {
3029 0     0   0 $_->detach();
3030 0         0 $_->parent( $self );
3031 0         0 $_->reset(1);
3032 0 0       0 if( $opts->{action} CORE::eq 'before' )
    0          
3033             {
3034 0         0 $parent->children->splice( $pos, 0, $_ );
3035             }
3036             elsif( $opts->{action} CORE::eq 'after' )
3037             {
3038 0         0 $parent->children->splice( $pos + 1, 0, $_ );
3039             }
3040 0         0 });
3041             }
3042 3         23 return( $self );
3043             }
3044              
3045             sub _same_as
3046             {
3047 194     194   8353 my $self = shift( @_ );
3048 194         305 my $this = shift( @_ );
3049 194 100 66     924 return(0) if( !defined( $this ) || !$self->_is_object( $this ) || !$this->isa( 'HTML::Object::DOM::Element' ) );
      66        
3050 155 50       2346 if( $this->isa_collection )
3051             {
3052             # We are not a collection, but the other is
3053 0 0 0     0 if( !$self->isa_collection )
    0          
3054             {
3055 0         0 return(0);
3056             }
3057             # https://css-tricks.com/snippets/jquery/compare-jquery-objects/
3058             elsif( $self->length == $this->length &&
3059             $self->length == $self->filter( $this )->length )
3060             {
3061 0         0 return(1);
3062             }
3063             else
3064             {
3065 0         0 return(0);
3066             }
3067             }
3068             else
3069             {
3070 155 50       454 return(0) if( $self->tag CORE::ne $this->tag );
3071 155 100       126266 return( $self->eid CORE::eq $this->eid ? 1: 0 );
3072             }
3073             }
3074              
3075             # If argument is provided, pass a CSS::Object::Builder::Rule object
3076             # If no argument is provided, get a CSS::Object::Builder::Rule of the inline css, if any at all.
3077             # Returns undef if no css attribute is set yet.
3078             sub _css_object
3079             {
3080 0     0   0 my $self = shift( @_ );
3081 0 0       0 if( @_ )
3082             {
3083 0         0 my $rule = shift( @_ );
3084 0         0 my $css = $rule->css;
3085 0         0 my $style = $rule->as_string;
3086 0         0 $self->css_cache_store( $style, $css );
3087 0         0 $self->attributes->set( css => $style );
3088 0         0 return( $rule );
3089             }
3090             else
3091             {
3092 0         0 my $style = $self->attributes->get( 'css' );
3093 0 0       0 return if( !defined( $style ) );
3094 0         0 my $css = CSS::Object->new( format => 'CSS::Object::Format::Inline', debug => $self->debug );
3095 0         0 my $cached = $self->css_cache_check( $style );
3096 0 0       0 if( $cached )
3097             {
3098 0         0 $css = $cached;
3099             }
3100             else
3101             {
3102             ## 'inline' here is just a fake selector to serve as a container rule for the inline properties,
3103             ## because CSS::Object requires properties to be within a rule
3104 0 0       0 $css->read_string( 'inline {' . $style . ' }' ) ||
3105             return( $self->error( "Unable to parse existing style for tag name \"", $self->prop( 'tagName' ), "\":", $css->error ) );
3106             }
3107 0         0 my $main = $css->rules->first;
3108 0 0       0 my $rule = defined( $main ) ? $css->builder->select( $main ) : $css->builder->select( 'inline' );
3109 0         0 return( $rule );
3110             }
3111             }
3112              
3113             sub _css_builder
3114             {
3115 0     0   0 my $self = shift( @_ );
3116 0         0 my $css = CSS::Object->new( format => 'CSS::Object::Format::Inline', debug => $self->debug );
3117 0         0 return( $css->builder->select( 'inline' ) );
3118             }
3119              
3120             # Takes selector, html, element or array
3121             # xq( '<p>Test</p>' )->insertBefore( xq( '.inner', $doc ) );
3122             # $elem->insertBefore( '.inner' );
3123             sub _insert_before_after
3124             {
3125 0     0   0 my $self = shift( @_ );
3126 0   0     0 my $this = shift( @_ ) || return( $self->error( "No target was provided to insert element." ) );
3127 0         0 my $opts = $self->_get_args_as_hash( @_ );
3128 0 0       0 if( !exists( $opts->{action} ) )
3129             {
3130 0         0 my @caller_info = caller(1);
3131 0         0 my $caller = [split( /::/, $caller_info[3])]->[-1];
3132 0 0       0 return( $self->error( "No action argument was provided and I am unable to guess it." ) ) if( $caller !~ /^(?:insert|insert_)(?:Before|After)$/i );
3133 0         0 $opts->{action} = lc( ( $caller =~ /^(?:insert|insert_)(?:Before|After)$/i )[0] );
3134             }
3135 0 0       0 return( $self->error( "Invalid value for argument \"action\": '$opts->{action}'" ) ) if( $opts->{action} !~ /^(?:before|after)$/ );
3136 0         0 my $a;
3137 0 0       0 if( !ref( $this ) )
    0          
    0          
3138             {
3139 0 0       0 if( $self->_is_html( $this ) )
3140             {
3141 0         0 my $p = $self->new_parser;
3142 0   0     0 $this = $p->parse_data( $this ) || return( $self->pass_error( $p->error ) );
3143 0         0 $a = $self->new_array( [ $this ] );
3144             }
3145             # otherwise this has to be a selector
3146             # TODO: Need to correct this and adjust the object used as a base for the find
3147             # since $self could very well be a dynamically created dom object
3148             else
3149             {
3150 0   0     0 $this = $self->find( $this ) || return;
3151 0         0 $a = $self->new_array( [ $this ] );
3152             }
3153             }
3154             elsif( $self->_is_array( $this ) )
3155             {
3156             # Make sure this is a Module::Generic::Array object
3157 0         0 $a = $self->new_array( $this );
3158             }
3159             elsif( $self->_is_object( $this ) )
3160             {
3161 0 0       0 return( $self->error( "Object provided '$this' (", overload::StrVal( $this ), ") is not an HTML::Object::DOM::Element object." ) ) if( !$this->isa( 'HTML::Object::DOM::Element' ) );
3162 0         0 $a = $self->new_array( [ $this ] );
3163             }
3164             else
3165             {
3166 0         0 return( $self->error( "I do not know what to do with \"$this\". I was expecting a selector, html data, an element object or an array." ) );
3167             }
3168            
3169             # If the content to be inserted is a collection, we loop through it, duplicate each element and insert them
3170 0 0       0 if( $self->isa_collection )
3171             {
3172             $a->foreach(sub
3173             {
3174 0     0   0 my $elem = $_;
3175 0         0 my $parent = $elem->parent;
3176 0 0       0 return(1) if( !$parent );
3177 0         0 $elem->reset(1);
3178 0         0 my $pos = $parent->children->pos( $elem );
3179 0 0       0 warn( "Found a parent for tag \"", $elem->tag, "\", but somehow I could not find its position among its children elements.\n" ) if( !defined( $pos ) );
3180 0 0       0 return( 1 ) if( !defined( $pos ) );
3181             $self->children->foreach(sub
3182             {
3183 0         0 my $e = shift( @_ );
3184             # Making sure the content element is detached from its original parent
3185 0         0 my $clone = $e->detach->clone;
3186 0         0 $clone->parent( $elem );
3187 0 0       0 if( $opts->{action} CORE::eq 'before' )
    0          
3188             {
3189 0         0 $parent->children->splice( $pos, 0, $clone );
3190             }
3191             elsif( $opts->{action} CORE::eq 'after' )
3192             {
3193 0         0 $parent->children->splice( $pos + 1, 0, $clone );
3194             }
3195 0         0 });
3196 0         0 });
3197             }
3198             else
3199             {
3200             # If the target is just one element, we do not duplicate them, but simply move them
3201 0 0       0 if( $a->length == 1 )
3202             {
3203 0         0 my $elem = $a->first;
3204 0         0 my $parent = $elem->parent;
3205 0 0       0 return(1) if( !$parent );
3206 0         0 $elem->reset(1);
3207 0         0 my $pos = $parent->children->pos( $elem );
3208 0 0       0 return( $self->error( "Found a parent for tag \"", $elem->tag, "\", but somehow I could not find its position among its children elements." ) ) if( !defined( $pos ) );
3209 0         0 $self->detach;
3210 0         0 $self->parent( $elem );
3211 0 0       0 if( $opts->{action} CORE::eq 'before' )
    0          
3212             {
3213 0         0 $parent->children->splice( $pos, 0, $self );
3214             }
3215             elsif( $opts->{action} CORE::eq 'after' )
3216             {
3217 0         0 $parent->children->splice( $pos + 1, 0, $self );
3218             }
3219             }
3220             # However, if the target contain multiple element, we clone the content element
3221             else
3222             {
3223             $a->foreach(sub
3224             {
3225 0     0   0 my $elem = $_;
3226 0         0 my $parent = $elem->parent;
3227 0 0       0 return(1) if( !$parent );
3228 0         0 $elem->reset(1);
3229 0         0 my $pos = $parent->children->pos( $elem );
3230 0 0       0 warn( "Found a parent for tag \"", $elem->tag, "\", but somehow I could not find its position among its children elements.\n" ) if( !defined( $pos ) );
3231 0 0       0 return(1) if( !defined( $pos ) );
3232 0         0 my $clone = $self->detach->clone;
3233 0         0 $clone->parent( $elem );
3234 0 0       0 if( $opts->{action} CORE::eq 'before' )
    0          
3235             {
3236 0         0 $parent->children->splice( $pos, 0, $clone );
3237             }
3238             elsif( $opts->{action} CORE::eq 'after' )
3239             {
3240 0         0 $parent->children->splice( $pos + 1, 0, $clone );
3241             }
3242 0         0 });
3243             }
3244             }
3245 0         0 return( $self );
3246             }
3247              
3248 0 0   0   0 sub _is_html { return( $_[1] =~ /^[[:blank:]\h]*<\w+/ ? 1 : 0 ); }
3249              
3250 0     0   0 sub _is_same_node { shift( @_ ); return( shift->eid CORE::eq shift->eid ); }
  0         0  
3251              
3252 8 50   8   24 sub _xpath_value { shift( @_ ); return( ref( $_[0] ) ? ${$_[0]} : HTML::Selector::XPath::selector_to_xpath( $_[0] ) ); }
  8         77  
  0            
3253              
3254             1;
3255             # NOTE: POD
3256             __END__