File Coverage

lib/HTML/Object/Element.pm
Criterion Covered Total %
statement 423 1031 41.0
branch 158 644 24.5
condition 70 336 20.8
subroutine 74 145 51.0
pod 83 83 100.0
total 808 2239 36.0


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/Element.pm
3             ## Version v0.2.6
4             ## Copyright(c) 2023 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/04/25
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::Element;
15             BEGIN
16             {
17             # For smart match
18 30     30   20625 use v5.10.1;
  30         114  
19 30     30   150 use strict;
  30         69  
  30         780  
20 30     30   185 use warnings;
  30         85  
  30         1215  
21 30     30   208 use warnings::register;
  30         82  
  30         2952  
22 30     30   183 use parent qw( Module::Generic );
  30         459  
  30         196  
23 30     30   119262 use vars qw( $LOOK_LIKE_HTML $LOOK_LIKE_IT_HAS_HTML $ATTRIBUTE_NAME_RE $VERSION );
  30         465  
  30         2233  
24 30     30   13097 use Data::UUID;
  30         16954  
  30         1751  
25 30     30   219 use Digest::MD5 ();
  30         73  
  30         458  
26 30     30   128 use Encode ();
  30         92  
  30         546  
27 30     30   25390 use Nice::Try;
  30         3390248  
  30         247  
28 30     30   92769935 use Scalar::Util ();
  30         72  
  30         780  
29 30     30   159 use Want;
  30         66  
  30         3762  
30             use overload (
31 30         374 'eq' => \&_same_as,
32             '==' => \&_same_as,
33             fallback => 1,
34 30     30   222 );
  30         71  
35 30     30   7628 our $LOOK_LIKE_HTML = qr/^[[:blank:]\h]*\<\w+.*?\>/;
36 30         115 our $LOOK_LIKE_IT_HAS_HTML = qr/\<\w+.*?\>/;
37 30         76 our $ATTRIBUTE_NAME_RE = qr/\w[\w\-]*/;
38 30         644 our $VERSION = 'v0.2.6';
39             };
40              
41 30     30   195 use strict;
  30         63  
  30         870  
42 30     30   168 use warnings;
  30         68  
  30         85874  
43              
44             sub init
45             {
46 1322     1322 1 6279 my $self = shift( @_ );
47 1322         6987 my $opts = $self->_get_args_as_hash( @_ );
48 1322         192706 for( qw( attributes attributes_sequence ) )
49             {
50 2644 100       11077 delete( $opts->{ $_ } ) if( !defined( $opts->{ $_ } ) );
51             }
52 1322         4147 my $parent = delete( $opts->{parent} );
53 1322         4119 $opts->{parent} = $parent;
54 1322 50       6315 $self->{attr} = {} unless( exists( $self->{attr} ) );
55 1322 50       6385 $self->{attr_seq} = [] unless( exists( $self->{attr_seq} ) );
56 1322         4823 $self->{checksum} = '';
57 1322 50       6020 $self->{close_tag} = '' unless( exists( $self->{close_tag} ) );
58 1322         3165 $self->{column} = 0;
59             # Was there a closing tag for non-void tags?
60 1322 50       6057 $self->{is_closed} = 0 unless( exists( $self->{is_closed} ) );
61 1322 100       5109 $self->{is_empty} = 0 unless( exists( $self->{is_empty} ) );
62 1322         3215 $self->{line} = 0;
63 1322         3149 $self->{modified} = 0;
64 1322         2932 $self->{offset} = 0;
65 1322         3146 $self->{original} = undef;
66 1322         3832 $self->{parent} = undef;
67 1322         3548 $self->{rank} = undef;
68 1322 100       4732 $self->{tag} = '' unless( exists( $self->{tag} ) );
69 1322         2858 $self->{_init_strict_use_sub} = 1;
70 1322         3499 $self->{_exception_class} = 'HTML::Object::Exception';
71 1322 50       5436 $self->SUPER::init( $opts ) || return( $self->pass_error );
72 1322         17799331 $self->{children} = [];
73             # uuid
74 1322         9014 $self->{eid} = $self->_generate_uuid();
75             # The user is always right, so we check if the tag has a forward slash as attribute
76             # If there is one, this means this tag is an empty (void) tag.
77             # We issue a warning if our dictionary-derived value 'is_empty' says different
78 1322 100       14691 $opts->{is_empty} = 0 if( !exists( $opts->{is_empty} ) );
79 1322 100       8738 $opts->{attributes} = {} if( !exists( $opts->{attributes} ) );
80 1322         4163 my $attr = $opts->{attributes};
81 1322 100 100     11239 if( !$opts->{is_empty} && exists( $attr->{'/'} ) )
82             {
83 4 50       1477 warnings::warn( "Tag initiated \"$opts->{tag}\" is marked as non-empty (non-void), but ends with \"/>\" at line $opts->{line} and column $opts->{column}: $opts->{original}\n" ) if( warnings::enabled() );
84 4         39 $self->is_empty(1);
85             }
86 1322         19711 $self->checksum( $self->set_checksum );
87 1322         991534 $self->{_cache_value} = '';
88 1322         16756 $self->{_internal} = {};
89 1322         10480 return( $self );
90             }
91              
92             # Note: HTML::Element compatibility
93             sub address
94             {
95 0     0 1 0 my $self = shift( @_ );
96 0 0       0 if( @_ )
97             {
98 0         0 my $addr = shift( @_ );
99 0         0 my $path = $self->new_array( [split( /\./, $addr )] );
100 0         0 my $root;
101             # relative path, such as .2.5.3
102 0 0       0 if( !length( $path->[0] ) )
103             {
104 0         0 $root = $self;
105             }
106             else
107             {
108 0         0 $root = $self->root;
109 0 0       0 return( $self->error( "First offset position should be 0 for root or a relative path." ) ) if( $path->shift != 0 );
110             }
111 0         0 my $offset;
112 0   0     0 while( $path->length && ( $offset = $path->shift ) )
113             {
114 0 0       0 return( $self->error( "Invalid offset '$offset' in path '$addr'. Value is bigger than the actual size of elements (", $root->children->size, "); starting from 0." ) ) if( $offset > $root->children->size );
115 0         0 $root = $root->children->get( $offset );
116             }
117 0         0 return( $root );
118             }
119             else
120             {
121 0         0 my $line = $self->new_array;
122 0   0     0 my $pos = $self->pos || 0;
123 0         0 $line->push( $pos );
124 0         0 $line->push( $self->lineage->list );
125 0         0 return( $line->reverse->join( '.' ) );
126             }
127             }
128              
129             # Note: HTML::Element compatibility
130             sub all_attr
131             {
132 0     0 1 0 my $self = shift( @_ );
133 0         0 my $ref = $self->attributes;
134 0         0 return( %$ref );
135             }
136              
137             # Note: HTML::Element compatibility
138             sub all_attr_names
139             {
140 0     0 1 0 my $self = shift( @_ );
141 0         0 return( $self->attributes->keys->list );
142             }
143              
144 0     0 1 0 sub as_html { return( shift->as_string( @_ ) ); }
145              
146             sub as_string
147             {
148 109     109 1 88481 my $self = shift( @_ );
149 109         537 my $opts = $self->_get_args_as_hash( @_ );
150             # If the element is called from within a collection, although it still has its
151             # parent, we do not know exactly where is its closing tag, if any.
152             # So this option makes it possible to return the tag and its closing tag, if any.
153 109 100       10232 $opts->{inside_collection} = 0 if( !CORE::exists( $opts->{inside_collection} ) );
154 109   50     423 $opts->{inside_collection} //= 0;
155 109   100     607 $opts->{recursive} //= 0;
156 109 100 100     606 return( $self->{_cache_value} ) if( $self->{_cache_value} && !CORE::length( $self->{_reset} ) );
157 98         767 my $tag = $self->tag;
158 98         81436 my $res = $self->new_array;
159 98         2174 my $a = $self->new_array( ["<${tag}"] );
160 98         2712 my $hash1 = $self->checksum;
161 98         79536 my $hash2 = $self->set_checksum;
162 98 100 100     2360 if( $self->original->defined && $hash1 eq $hash2 )
163             {
164 48         27616 $a->set( [ $self->original->scalar ] );
165             }
166             else
167             {
168 50 100       27457 if( !$self->attributes_sequence->is_empty )
169             {
170 32         16271 my $attr = $self->new_array;
171             $self->attributes_sequence->foreach(sub
172             {
173 72     72   21676 my $k = shift( @_ );
174 72 50       243 return( 1 ) if( $k eq '/' );
175 72         199 my $v = $self->attributes->get( $k );
176             # Ensure double quotes are escaped
177 72         37149 $v =~ s/(?<!\\)\"/\\\"/gs;
178 72         537 $attr->push( sprintf( '%s="%s"', $k, $v ) );
179 32         677 });
180 32         4751 $a->push( $attr->join( ' ' )->scalar );
181             }
182             }
183 98 100       37120 if( !$self->children->is_empty )
184             {
185 55 50       5247 if( $self->is_empty )
186             {
187 0 0       0 warnings::warn( "This tag \"$tag\" is supposed to be an empty / void one, but it has " . $self->children->length . " children.\n" ) if( warnings::enabled() );
188             }
189             # The user is alway right, so let's add those children
190 55         39098 $res->push( $a->join( ' ' )->scalar );
191 55 100 100     2493 $res->push( '>' ) unless( $self->original->defined && $hash1 eq $hash2 );
192             $self->children->foreach(sub
193             {
194 123     123   19790 my $e = shift( @_ );
195 123         213 my $v;
196 123 50       444 if( $opts->{as_xml} )
197             {
198 0         0 $v = $e->as_xml( recursive => 1 );
199             }
200             else
201             {
202 123         1043 $v = $e->as_string( recursive => 1 );
203             }
204 123 50       62224 $res->push( defined( $v ) ? $v->scalar : $v );
205 55         31189 });
206             # $res->push( "</${tag}>" );
207             # $res->push( "</${tag}>" ) if( !$self->parent && !$self->is_empty );
208             # if( ( $opts->{inside_collection} || !$opts->{recursive} ) && $self->close_tag )
209 55 50       15372 if( my $close = $self->close_tag )
210             {
211 55         2223 my $parent = $self->parent;
212 55 50 66     1905 unless( $parent && defined( my $pos = $parent->children->pos( $close ) ) )
213             {
214 55         5570 $res->push( $close->as_string );
215             }
216             }
217             }
218             else
219             {
220 43 100       4614 if( $self->is_empty )
221             {
222             # No need to add this, because we are re-using the original tag data since it has not changed
223 1 50       692 $a->push( '/>' ) unless( $hash1 eq $hash2 );
224 1         15 $res->push( $a->join( ' ' )->scalar );
225             }
226             else
227             {
228 42         29543 $res->push( $a->join( ' ' )->scalar );
229 42 100 100     1896 $res->push( '>' ) unless( $self->original->defined && $hash1 eq $hash2 );
230             # If it has a parent, the parent will contain the closing tag, but
231             # If this element is an element created with a find, such as $('body'), it has no
232             # parent.
233             # $res->push( "</${tag}>" ) if( !$self->parent && !$self->is_empty );
234 42 100       23775 if( my $close = $self->close_tag )
235             {
236 34         1176 my $parent = $self->parent;
237 34 100 100     990 unless( $parent && defined( my $pos = $parent->children->pos( $close ) ) )
238             {
239 30         3485 $res->push( $close->as_string );
240             }
241             }
242             }
243             }
244 98         41758 my $elem = $res->join( '' );
245 98         12248 $self->{_cache_value} = $elem;
246 98         345 CORE::delete( $self->{_reset} );
247 98         508 return( $elem );
248             }
249              
250             # Note: HTML::Element compatibility
251             sub as_text
252             {
253 12     12 1 76928 my $self = shift( @_ );
254 12 100 100     100 return( $self->{_cache_text} ) if( $self->{_cache_text} && !CORE::length( $self->{_reset} ) );
255 11         114 my $opts = $self->_get_args_as_hash( @_ );
256 11         109 my $a = $self->new_array;
257 11         277 my $seen = {};
258 11         29 my $crawl;
259             $crawl = sub
260             {
261 12     12   44 my $elem = shift( @_ );
262             $elem->children->foreach(sub
263             {
264 19         2524 my $e = shift( @_ );
265 19         83 my $addr = Scalar::Util::refaddr( $e );
266 19 50       95 return(1) if( CORE::exists( $seen->{ $addr } ) );
267 19         58 $seen->{ $addr }++;
268 19 100 100     144 if( $e->isa( 'HTML::Object::Text' ) ||
269             $e->isa( 'HTML::Object::Space' ) )
270             {
271 18 50 33     97 if( exists( $opts->{callback} ) && ref( $opts->{callback} ) eq 'CODE' )
272             {
273             # If value returned is not true, we skip this element
274 0 0       0 $opts->{callback}->( $e ) || return(1);
275             }
276 18         130 $a->push( $e->as_string->scalar );
277             }
278            
279 19 100 100     14751 unless( $e->isa( 'HTML::Object::Text' ) ||
280             $e->isa( 'HTML::Object::Space' ) )
281             {
282 1         10 $crawl->( $e );
283             }
284 12         50 });
285 11         87 };
286 11 50 33     248 if( $self->isa( 'HTML::Object::Text' ) ||
287             $self->isa( 'HTML::Object::Space' ) )
288             {
289 0         0 $a->push( $self->value->scalar );
290             }
291             else
292             {
293 11         57 $crawl->( $self );
294             }
295 11         2068 $self->{_cache_text} = $a->join( '' );
296 11         476 CORE::delete( $self->{_reset} );
297 11         71 return( $self->{_cache_text} );
298             }
299              
300             # Note: HTML::Element compatibility
301             sub as_trimmed_text
302             {
303 0     0 1 0 my $self = shift( @_ );
304 0         0 my $opts = $self->_get_args_as_hash( @_ );
305 0   0     0 my $text = $self->as_text( $opts ) || return;
306 0         0 $text->replace( qr/^[[:blank:]\h\v]+|[[:blank:]\h\v]+$/, '' );
307 0         0 return( $text );
308             }
309              
310             # Note: HTML::Element compatibility
311             # This does the same as for html. Sub classes take care of the differences
312             # sub as_xml { return( shift->as_string( @_ ) ); }
313             sub as_xml
314             {
315 0     0 1 0 my $self = shift( @_ );
316 0         0 my $opts = $self->_get_args_as_hash( @_ );
317 0         0 $opts->{as_xml} = 1;
318 0         0 return( $self->as_string( $opts ) );
319             }
320              
321             sub attr
322             {
323 339     339 1 44634 my $self = shift( @_ );
324 339   50     941 my $attr = shift( @_ ) || return( $self->error( "No attribute name provided." ) );
325 339 50       1608 return( $self->error( "Attribute provided \"${attr}\" contains illegal characters. Only alphanumeric and _ are supported." ) ) if( $attr !~ /^\w+$/ );
326 339 100       816 if( @_ )
327             {
328 61         153 my $v = shift( @_ );
329 61         110 my $old;
330 61 50       176 if( defined( $v ) )
331             {
332 61         254 $old = $self->attributes->get( $attr );
333             # We do not want to force stringification, because for attribute like 'href' it could have an URI object as a value.
334             # When stringification will be required, it will be done automatically anyway.
335             # $v = "$v" if( ref( $v ) && overload::Method( $v, '""' ) );
336 61 100       34587 $v =~ s/^[[:blank:]\h]+|[[:blank:]\h]+$//g if( !ref( $v ) );
337 61         196 $self->attributes->set( $attr => $v );
338 61 100       32267 $self->attributes_sequence->push( $attr ) if( !$self->attributes_sequence->has( $attr ) );
339             }
340             else
341             {
342 0         0 $self->attributes_sequence->remove( $attr );
343 0         0 $old = $self->attributes->delete( $attr );
344             }
345            
346             # Check for attributes callback and execute it.
347             # This is typically used for HTML::Object::TokenList by HTML::Object::DOM::Element and HTML::Object::DOM::AnchorElement
348 61         2204099 my $callbacks = $self->{_internal_attribute_callbacks};
349 61 100       8038 $callbacks = {} if( ref( $callbacks ) ne 'HASH' );
350 61 100 66     346 if( CORE::exists( $callbacks->{ $attr } ) && ref( $callbacks->{ $attr } ) eq 'CODE' )
351             {
352 3         27 my $cb = $callbacks->{ $attr };
353 3 50 33     16 try
  3         8  
  3         7  
  3         15  
  0         0  
  3         9  
  3         12  
  3         6  
354 3     3   5 {
355 3         17 $cb->( $self, $v );
356             }
357 3 100 50     23 catch( $e )
  3 0 33     26  
  1 0       4  
  3 0       8  
  3 0       6  
  3 0       8  
  3 0       6  
  3 0       16  
  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 50       0  
  0 0       0  
  0 50       0  
  0         0  
  0         0  
  0         0  
  3         11  
  0         0  
  0         0  
  3         9  
  3         11  
  3         13  
  3         14  
  3         11  
  3         11  
  0         0  
  0         0  
  0         0  
  0         0  
358 0     0   0 {
359 0         0 return( $self->error( "Error executing attribute callback for attribute \"$attr\" for element with tag \"", $self->tag, "\"." ) );
360 30 0 0 30   260 }
  30 0 0     67  
  30 0 33     232182  
  0 0 0     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 66     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  
  3 0       11  
  0 0       0  
  3 0       78  
  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  
  3         13  
  0         0  
  0         0  
  0         0  
  0         0  
  3         12  
361             }
362 61         236 $self->reset(1);
363 61         242 return( $old );
364             }
365             else
366             {
367 278         695 return( $self->attributes->get( $attr ) );
368             }
369             }
370              
371 2868     2868 1 4102292 sub attributes { return( shift->reset(@_)->_set_get_hash_as_mix_object( 'attr', @_ ) ); }
372              
373             # sub attributes_sequence { return( shift->_set_get_array_as_object( 'attr_seq', @_ ) ); }
374             sub attributes_sequence
375             {
376 1138     1138 1 5335345 my $self = shift( @_ );
377 1138 100       4283 unless( @_ )
378             {
379 817 100       3950 if( $self->_set_get_array_as_object( 'attr_seq' )->sort != $self->attributes->keys->sort )
380             {
381 47         42346 $self->_set_get_array_as_object( 'attr_seq', $self->attributes->keys->sort );
382             }
383             }
384 1138         910532 return( $self->reset(@_)->_set_get_array_as_object( 'attr_seq', @_ ) );
385             }
386              
387 1139     1139 1 449201 sub checksum { return( shift->reset(@_)->_set_get_scalar_as_object( 'checksum', @_ ) ); }
388              
389 3761     3761 1 929698 sub children { return( shift->reset(@_)->_set_get_object_array_object( 'children', 'HTML::Object::Element', @_ ) ); }
390              
391 0     0 1 0 sub class { return( ref( $_[0] ) ); }
392              
393             # Note: HTML::Element compatibility
394             sub clone
395             {
396 34     34 1 587 my $self = shift( @_ );
397 34         1065 my $new = $self->SUPER::clone();
398 34         190086 $new->{eid} = $self->_generate_uuid();
399 34         580 my $children = $self->clone_list;
400 34         149 $new->children( $children );
401             $children->foreach(sub
402             {
403 12     12   187 shift->parent( $new );
404 34         8736 });
405 34         869 $new->parent( undef );
406 34         2004 $new->reset(1);
407 34         173 return( $new );
408             }
409              
410             # Note: HTML::Element compatibility
411             sub clone_list
412             {
413 34     34 1 122 my $self = shift( @_ );
414 34         206 my $a = $self->new_array;
415             $self->children->foreach(sub
416             {
417 12     12   1978 my $e = shift( @_ );
418 12         114 $a->push( $e->clone );
419 34         1014 });
420 34         7194 return( $a );
421             }
422              
423             sub close
424             {
425 47     47 1 1445 my $self = shift( @_ );
426 47         201 my $opts = $self->_get_args_as_hash( @_ );
427             # No need to close
428 47 100       438 return( $self ) if( $self->is_empty );
429             # if( !$parent )
430             # {
431             # warnings::warn( "No parent set for this element \"" . $self->tag . "\".\n" ) if( warnings::enabled( 'HTML::Object' ) );
432             # return( $self );
433             # }
434             my $e = $self->new_closing({
435             attributes => $opts->{attr},
436             attributes_sequence => $opts->{seq},
437             column => $opts->{col},
438             line => $opts->{line},
439             offset => $opts->{offset},
440             original => $opts->{raw},
441 46   50     32689 tag => $self->tag,
442             debug => $self->debug,
443             }) || return( $self->pass_error );
444 46         331 my $parent = $self->parent;
445 46 100       1435 if( $parent )
446             {
447 6         32 my $pos = $parent->children->pos( $self );
448 6 50       694 return( $self->error( "Could not find the opening tag '", $self->tag, "' in our parent." ) ) if( !defined( $pos ) );
449             # We place the closing tag in the parent's child right after our opening tag
450             # $parent->children->splice( $pos + 1, 0, $e );
451             }
452 46         320 $self->is_closed(1);
453 46         41660 $self->close_tag( $e );
454 46         2215 $self->reset(1);
455 46         174 return( $self );
456             }
457              
458 369     369 1 1945 sub close_tag { return( shift->reset(@_)->_set_get_object( 'close_tag', 'HTML::Object::Element', @_ ) ); }
459              
460 1093     1093 1 14417791 sub column { return( shift->reset(@_)->_set_get_number_as_object( 'column', @_ ) ); }
461              
462             # Note: HTML::Element compatibility
463 0     0 1 0 sub content { return( shift->children ); }
464              
465             # Note: HTML::Element compatibility
466 0     0 1 0 sub content_array_ref { return( shift->children ); }
467              
468             # Note: HTML::Element compatibility
469             sub content_list
470             {
471 0     0 1 0 my $self = shift( @_ );
472 0 0       0 if( want( 'LIST' ) )
473             {
474 0         0 return( $self->children->list );
475             }
476             else
477             {
478 0         0 return( $self->children->length );
479             }
480             }
481              
482             # Note: HTML::Element compatibility
483             sub delete
484             {
485 0     0 1 0 my $self = shift( @_ );
486 0         0 $self->delete_content;
487 0         0 $self->detach;
488 0         0 %$self = ();
489             }
490              
491             # Note: HTML::Element compatibility
492             sub delete_content
493             {
494 0     0 1 0 my $self = shift( @_ );
495             $self->children->foreach(sub
496             {
497 0     0   0 $_->delete;
498 0         0 });
499 0         0 $self->reset(1);
500 0         0 return( $self );
501             }
502              
503             # Note: HTML::Element compatibility
504             # Does not do anything by design
505       0 1   sub delete_ignorable_whitespace {}
506              
507             sub depth
508             {
509 0     0 1 0 my $self = shift( @_ );
510 0         0 my $n = 0;
511 0         0 my $parent = $self;
512 0         0 $n++ while( $parent = $parent->parent );
513 0         0 return( $self->new_number( $n ) );
514             }
515              
516             sub descendants
517             {
518 0     0 1 0 my $self = shift( @_ );
519 0         0 my $a = $self->new_array;
520             $self->traverse(sub
521             {
522 0     0   0 my $e = shift( @_ );
523 0         0 my $class = $e->class;
524 0 0       0 return(1) unless( $class eq 'HTML::Object::Element' );
525 0         0 $a->push( $e );
526 0         0 });
527 0         0 return( $a );
528             }
529              
530             # Note: HTML::Element compatibility
531 0     0 1 0 sub destroy { return( shift->delete( @_ ) ); }
532              
533 0     0 1 0 sub destroy_content { return( shift->delete_content( @_ ) ); }
534              
535             # Note: HTML::Element compatibility
536             sub detach
537             {
538 12     12 1 208 my $self = shift( @_ );
539 12         47 my $parent = $self->parent;
540 12 50       340 return if( !$parent );
541 0         0 my $id = $self->eid;
542 0         0 my $pos = $parent->children->pos( $self );
543 0 0       0 if( defined( $pos ) )
544             {
545 0         0 $parent->children->splice( $pos, 1 );
546 0         0 $self->parent( undef() );
547 0         0 $parent->reset(1);
548             }
549 0         0 return( $parent );
550             }
551              
552             # Note: HTML::Element compatibility
553             sub detach_content
554             {
555 0     0 1 0 my $self = shift( @_ );
556             $self->children->foreach(sub
557             {
558 0     0   0 shift->parent( undef() );
559 0         0 });
560 0         0 my @removed = $self->children->list;
561 0         0 $self->children->reset;
562 0         0 return( @removed );
563             }
564              
565             sub dump
566             {
567 0     0 1 0 my $self = shift( @_ );
568 0   0     0 my $depth = shift( @_ ) || 0;
569 0         0 my $prefix = '.' x $depth;
570 0         0 $depth++;
571 0         0 my $tag = $self->tag;
572 0 0       0 printf( STDOUT "${prefix} Tag '$tag' has %d children.\n", $self->children->length ) if( $self->children->length );
573 0         0 my %esc = (
574             "\a" => "\\a",
575             "\b" => "\\b",
576             "\t" => "\\t",
577             "\n" => "\\n",
578             "\f" => "\\f",
579             "\r" => "\\r",
580             "\e" => "\\e",
581             );
582             $self->children->foreach(sub
583             {
584 0     0   0 my $e = shift( @_ );
585 0         0 my $str = $e->original->scalar;
586 0         0 $str =~ s/([\a\b\t\n\f\r\e])/$esc{$1}/gs;
587 0         0 $str =~ s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
  0         0  
588 0         0 $str =~ s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
  0         0  
589 0         0 $str =~ s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
  0         0  
590 0         0 print( STDOUT "${prefix}. ${str}\n" );
591 0 0 0     0 $e->dump( $depth ) if( !$e->is_empty || $e->children->length );
592 0         0 });
593 0         0 return( $self );
594             }
595              
596 1504     1504 1 9187 sub eid { return( shift->{eid} ); }
597              
598             # Returns self, but is overriden in HTML::Object::Result
599             # See <https://api.jquery.com/end/#end>
600 0     0 1 0 sub end { return( shift( @_ ) ); }
601              
602             sub extract_links
603             {
604 0     0 1 0 my $self = shift( @_ );
605 0         0 my @tags = @_;
606 0         0 for( @tags )
607             {
608 0         0 $_ = lc( $_ );
609             }
610 0         0 my $wants = {};
611 0         0 @$wants{ @tags } = (1) x scalar( @tags );
612 0         0 my $has_expectation = scalar( keys( %$wants ) );
613 0         0 my $a = $self->new_array;
614 0         0 my $crawl;
615 0         0 my $seen = {};
616             $crawl = sub
617             {
618 0     0   0 my $kids = shift( @_ );
619             $kids->foreach(sub
620             {
621 0         0 my $e = shift( @_ );
622 0         0 my $def;
623 0         0 my $tag = $e->tag;
624 0 0       0 $def = $HTML::Object::LINK_ELEMENTS->{ "$tag" } if( exists( $HTML::Object::LINK_ELEMENTS->{ "$tag" } ) );
625             # return(1) if( !defined( $def ) );
626             # return(1) if( $has_expectation && !exists( $wants->{ "$tag" } ) );
627 0 0 0     0 if( defined( $def ) &&
      0        
628             (
629             !$has_expectation ||
630             ( $has_expectation && !exists( $wants->{ "$tag" } ) )
631             ) )
632             {
633 0         0 foreach my $attr ( @$def )
634             {
635 0         0 my $val;
636 0 0 0     0 if( $e->attributes->exists( $attr ) && length( $val = $e->attributes->get( $attr ) ) )
637             {
638 0         0 $a->push( $self->new_hash({
639             attribute => $attr,
640             element => $e,
641             tag => $tag,
642             value => $val,
643             }) );
644             }
645             }
646             }
647 0         0 my $addr = Scalar::Util::refaddr( $e );
648 0 0       0 if( ++$seen->{ $addr } > 1 )
649             {
650 0         0 return(1);
651             }
652 0         0 $crawl->( $e->children );
653 0         0 return(1);
654 0         0 });
655 0         0 };
656 0         0 $crawl->( $self->children );
657 0         0 return( $a );
658             }
659              
660             # Note: HTML::Element compatibility
661             # sub find { return( shift->find_by_tag_name( @_ ) ); }
662             # find() is a xpath method
663              
664             sub find_by_attribute
665             {
666 0     0 1 0 my $self = shift( @_ );
667 0         0 my( $att, $val ) = @_;
668 0         0 $att = lc( $att );
669 0 0       0 return( $self->error( "No attribute was provided." ) ) if( !length( $att ) );
670 0         0 my $a = $self->new_array;
671 0 0 0     0 $a->push( $self ) if( $self->attributes->exists( $att ) && $self->attributes->get( $att ) eq $val );
672 0         0 my $crawl;
673             $crawl = sub
674             {
675 0     0   0 my $elems = shift( @_ );
676             $elems->foreach(sub
677             {
678 0         0 my $e = shift( @_ );
679 0 0       0 return(1) if( $e->class ne 'HTML::Object::Element' );
680 0 0 0     0 $a->push( $e ) if( $e->attributes->exists( $att ) && $e->attributes->get( $att ) eq $val );
681 0 0       0 $crawl->( $e->children ) if( $e->children->length > 0 );
682 0         0 });
683 0         0 };
684 0 0       0 $crawl->( $self->children ) if( $self->children->length > 0 );
685 0         0 return( $a );
686             }
687              
688             sub find_by_tag_name
689             {
690 0     0 1 0 my $self = shift( @_ );
691 0         0 my @tags = @_;
692 0         0 for( @tags )
693             {
694 0         0 $_ = lc( $_ );
695             }
696 0         0 my $tags = {};
697 0         0 @$tags{ @tags } = (1) x scalar( @tags );
698 0         0 my $a = $self->new_array;
699 0 0       0 $a->push( $self ) if( exists( $tags->{ $self->tag } ) );
700 0         0 my $crawl;
701             $crawl = sub
702             {
703 0     0   0 my $elems = shift( @_ );
704             $elems->foreach(sub
705             {
706 0         0 my $e = shift( @_ );
707             # return(1) if( $e->class ne 'HTML::Object::Element' );
708 0 0       0 return(1) if( !$self->_is_a( $e => 'HTML::Object::Element' ) );
709 0 0       0 $a->push( $e ) if( exists( $tags->{ $e->tag } ) );
710 0 0       0 $crawl->( $e->children ) if( $e->children->length > 0 );
711 0         0 });
712 0         0 };
713 0 0       0 $crawl->( $self->children ) if( $self->children->length > 0 );
714 0         0 return( $a );
715             }
716              
717 0 0   0 1 0 sub has_children { return( shift->children->is_empty ? 0 : 1 ); }
718              
719 19     19 1 3754 sub id : lvalue { return( shift->_set_get_id( @_ ) ); }
720              
721             # Note: Similar to HTML::ELement, but not quite, because we have no concept of pos(), so this just add to the stack of children
722             sub insert_element
723             {
724 0     0 1 0 my $self = shift( @_ );
725 0   0     0 my $e = shift( @_ ) || return( $self->error( "No html element was provided to insert." ) );
726 0 0       0 return( $self->error( "Element provided (", overload::StrVal( $e ), ") is not an object." ) ) if( !$self->_is_object( $e ) );
727 0 0       0 return( $self->error( "Element provided (", overload::StrVal( $e ), ") is not an HTML::Object::Element." ) ) if( !$e->isa( 'HTML::Object::Element' ) );
728 0         0 $self->push_content( $e );
729 0         0 $self->reset(1);
730 0         0 return( $e );
731             }
732              
733             # Used to store arbitrarily data for internal purpose
734 38     38 1 236 sub internal { return( shift->reset(@_)->_set_get_hash_as_mix_object( '_internal', @_ ) ); }
735              
736 481     481 1 151697 sub is_closed { return( shift->reset(@_)->_set_get_boolean( 'is_closed', @_ ) ); }
737              
738             # Note: Different from HTML::Element in that this is a flag derived from the dictionary. To get the equivalent, one must use has_children()
739 1772     1772 1 7883230 sub is_empty { return( shift->reset(@_)->_set_get_boolean( 'is_empty', @_ ) ); }
740              
741 4 50   4 1 376 sub is_valid_attribute { return( $_[1] =~ /^$ATTRIBUTE_NAME_RE$/ ? 1 : 0 ); }
742              
743 0     0 1 0 sub is_void { return( shift->reset(@_)->is_empty( @_ ) ); }
744              
745             # Note: Compatibility with HTML::Element
746             sub left
747             {
748 122     122 1 257 my $self = shift( @_ );
749 122 50       354 my $offset = @_ ? int( shift( @_ ) ) : 0;
750 122         455 my $pos = $self->pos;
751             # We return empty if we could not find our object within our parent's children; or
752             # the requested offset position is higher than the position of our object
753 122 100 66     6802 return( $self->new_array ) if( !defined( $pos ) || $offset > $pos );
754 118         432 my $kids = $self->parent->children;
755             # I am my parent's only child; no need to bother
756 118 50       7701 return( $self->new_array ) if( $kids->length == 1 );
757             # We use position as offset length which will put us right before our own element
758 118         4309404 return( $kids->offset( $offset, ( $pos - $offset ) ) );
759             }
760              
761 1093     1093 1 12455564 sub line { return( shift->_set_get_number_as_object( 'line', @_ ) ); }
762              
763             # Note: HTML::Element compatibility
764             sub lineage
765             {
766 95     95 1 1429 my $self = shift( @_ );
767 95         147 my $parent = $self;
768 95         332 my $lineage = $self->new_array;
769 95         1828 while( $parent = $parent->parent )
770             {
771 257         5304 $lineage->push( $parent );
772             }
773 95         2165 return( $lineage );
774             }
775              
776             sub lineage_tag_names
777             {
778 0     0 1 0 my $self = shift( @_ );
779 0         0 my $a = $self->new_array;
780 0         0 my $parent = $self;
781 0         0 while( $parent = $parent->parent )
782             {
783 0         0 $a->push( $parent->tag->scalar );
784             }
785 0         0 return( $a );
786             }
787              
788             sub look
789             {
790 3     3 1 8 my $self = shift( @_ );
791 3         7 my $opts = {};
792 3 50       16 $opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' );
793 3         7 my $p = [];
794 3         14 for( my $i = 0; $i < scalar( @_ ); )
795             {
796 3 50       12 if( ref( $_[$i] ) )
797             {
798 0 0       0 return( $self->error( "Reference provided (", overload::StrVal( $_[$i] ), "), but the only reference I accept is code reference." ) ) if( ref( $_[$i] ) ne 'CODE' );
799 0         0 push( @$p, $_[ $i++ ] );
800             }
801             else
802             {
803 3         47 push( @$p, {
804             key => $_[$i],
805             val => $_[$i + 1],
806             });
807 3         15 $i += 2;
808             }
809             }
810 3         21 my $a = $self->new_array;
811 3         80 my( $check_elem, $crawl_down );
812             $check_elem = sub
813             {
814 107     107   203 my $e = shift( @_ );
815 107         153 my $def = shift( @_ );
816 107         447 my $attr = $e->attributes;
817             # Assume ok, then check otherwise
818 107         107662 my $ok = 1;
819 107         297 foreach my $this ( @$p )
820             {
821 107 50       346 if( ref( $this ) eq 'CODE' )
822             {
823 0         0 local $_ = $e;
824 0         0 my $rc = $this->( $e );
825 0 0       0 $ok = 0, last if( !$rc );
826             }
827             else
828             {
829 107 50       398 if( $this->{key} eq '_tag' )
    0          
830             {
831 107 50       258 if( ref( $this->{val} ) eq 'Regexp' )
832             {
833 0 0       0 $ok = 0, last if( $e->tag !~ /$this->{val}/ );
834             }
835             else
836             {
837 107 100       360 $ok = 0, last if( $e->tag ne $this->{val} );
838             }
839             }
840             elsif( !$attr->exists( $this->{key} ) )
841             {
842 0 0       0 if( !defined( $this->{val} ) )
843             {
844             # Good to go; the user searches for an attribute with an undefined value
845             # in other term, the user wants an element whose attribute does not exist
846             }
847             else
848             {
849 0         0 $ok = 0, last;
850             }
851             }
852             else
853             {
854 0         0 my $val = $attr->get( $this->{key} );
855 0 0       0 if( defined( $val ) )
856             {
857 0 0 0     0 if( ref( $this->{val} ) eq 'Regexp' )
    0 0        
      0        
      0        
858             {
859 0 0       0 $ok = 0, last if( $val !~ /$this->{val}/ );
860             }
861             elsif( (
862             ref( $this->{val} ) &&
863             ref( $this->{val} ) ne ref( $val )
864             ) ||
865             (
866             ( !ref( $val ) || overload::Method( $val. '""' ) ) &&
867             lc( "$val" ) ne lc( "$this->{val}" )
868             ) )
869             {
870 0         0 $ok = 0, last;
871             }
872             }
873             else
874             {
875 0 0       0 $ok = 0, last if( defined( $this->{val} ) );
876             }
877             }
878             }
879             }
880            
881             # We passed all checks, no checking our children
882 107 100       90266 $a->push( $e ) if( $ok );
883             # Stop here since we reached the maximum number of matches
884 107 50 33     426 return if( CORE::exists( $opts->{max_match} ) && $a->length >= $opts->{max_match} );
885             # Don't go down or up further if we reached the maximum level
886 107 100 100     377 return(1) if( CORE::exists( $opts->{max_level} ) && ( $def->{level} + 1 ) > $opts->{max_level} );
887 100         171 $def->{level}++;
888 100 50       225 if( $opts->{direction} eq 'down' )
    0          
889             {
890 100 100       393 $crawl_down->( $e->children, $def ) if( $e->children->length > 0 );
891             }
892             elsif( $opts->{direction} eq 'up' )
893             {
894 0 0       0 $check_elem->( $e->parent ) if( $e->parent );
895             }
896 100         2807820 $def->{level}--;
897 100         14131 return(1);
898 3         37 };
899            
900             $crawl_down = sub
901             {
902 22     22   1874 my $kids = shift( @_ );
903 22         76 my $def = shift( @_ );
904             # $kids->foreach( $check_elem );
905             $kids->foreach(sub
906             {
907 104         2142 $check_elem->( $_, $def );
908 22         217 });
909 3         23 };
910            
911 3         19 my $def = { level => 0 };
912 3         10 $check_elem->( $self, $def );
913             # return( $a->length > 0 ? $a : '' );
914 3         39 return( $a );
915             }
916              
917             sub look_down
918             {
919 3     3 1 4561 my $self = shift( @_ );
920 3         9 my $opts = {};
921 3 100       18 $opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' );
922 3         17 $opts->{direction} = 'down';
923 3         19 return( $self->look( @_, $opts ) );
924             }
925              
926             sub look_up
927             {
928 0     0 1 0 my $self = shift( @_ );
929 0         0 my $opts = {};
930 0 0       0 $opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' );
931 0         0 $opts->{direction} = 'up';
932 0         0 return( $self->look( @_, $opts ) );
933             }
934              
935 0 0   0 1 0 sub looks_like_html { return( $_[1] =~ /$LOOK_LIKE_HTML/ ? 1 : 0 ); }
936              
937             # sub looks_like_it_has_html { return( $_[1] =~ /$LOOK_LIKE_IT_HAS_HTML/ ? 1 : 0 ); }
938             sub looks_like_it_has_html
939             {
940 2     2 1 35 my $self = shift( @_ );
941 2 100       25 return( $_[0] =~ /$LOOK_LIKE_IT_HAS_HTML/ ? 1 : 0 );
942             }
943              
944 0     0 1 0 sub modified { return( shift->_set_get_boolean( 'modified', @_ ) ); }
945              
946             sub new_attribute
947             {
948 0     0 1 0 my $self = shift( @_ );
949 0 0       0 $self->_load_class( 'HTML::Object::Attribute' ) || return( $self->pass_error );
950 0   0     0 my $att = HTML::Object::Attribute->new( @_ ) ||
951             return( $self->pass_error( HTML::Object::Attribute->error ) );
952 0         0 return( $att );
953             }
954              
955             sub new_closing
956             {
957 0     0 1 0 my $self = shift( @_ );
958 0 0       0 $self->_load_class( 'HTML::Object::Closing' ) || return( $self->pass_error );
959 0   0     0 my $e = HTML::Object::Closing->new( @_ ) ||
960             return( $self->pass_error( HTML::Object::Closing->error ) );
961 0         0 return( $e );
962             }
963              
964             sub new_document
965             {
966 0     0 1 0 my $self = shift( @_ );
967 0 0       0 $self->_load_class( 'HTML::Object::Document' ) || return( $self->pass_error );
968 0   0     0 my $e = HTML::Object::Document->new( debug => $self->debug ) ||
969             return( $self->pass_error( HTML::Object::Document->error ) );
970 0         0 return( $e );
971             }
972              
973             sub new_element
974             {
975 0     0 1 0 my $self = shift( @_ );
976 0   0     0 my $tag = shift( @_ ) || return( $self->error( "No tag was provided to create an element." ) );
977 0   0     0 my $dict = HTML::Object->get_definition( $tag ) || return( $self->pass_error( HTML::Object->error ) );
978             my $e = HTML::Object::Element->new({
979             is_empty => $dict->{is_empty},
980             tag => $dict->{tag},
981 0   0     0 debug => $self->debug,
982             }) || return( $self->pass_error( HTML::Object::Element->error ) );
983 0         0 return( $e );
984             }
985              
986             sub new_from_lol
987             {
988 0     0 1 0 my $self = shift( @_ );
989 0         0 my $a = $self->new_array;
990 0         0 my @args = @_;
991 0         0 my $crawl;
992             $crawl = sub
993             {
994 0     0   0 my $ref = shift( @_ );
995 0         0 my $parent;
996 0 0       0 $parent = shift( @_ ) if( scalar( @_ ) );
997 0         0 my $elem;
998 0         0 foreach my $this ( @$ref )
999             {
1000 0 0 0     0 if( $self->_is_array( $this ) )
    0          
    0          
1001             {
1002 0   0     0 my $e = $crawl->( $this, ( $elem // $parent ) ) || return;
1003 0 0 0     0 if( defined( $elem ) || defined( $parent ) )
1004             {
1005 0   0     0 $e->parent( $elem // $parent );
1006 0   0     0 ( $elem // $parent )->children->push( $e );
1007             }
1008             }
1009             elsif( $self->_is_hash( $this ) )
1010             {
1011 0 0       0 return( $self->error( "Hash of attributes set found before tag name definition" ) ) if( !defined( $elem ) );
1012 0         0 $elem->attributes( $this );
1013             }
1014             elsif( $self->_is_object( $this ) && $this->isa( 'HTML::Object::Element' ) )
1015             {
1016 0   0     0 my $custodian = ( $elem // $parent );
1017 0 0       0 my $e = $this->parent ? $this->clone : $this;
1018 0 0       0 return( $self->error( "Found an element object \"", $e->tag, "\" to add to the tree, but no parent was provided nor any element was initiated yet." ) ) if( !defined( $custodian ) );
1019 0         0 $e->parent( $custodian );
1020 0         0 $custodian->children->push( $e );
1021             }
1022             else
1023             {
1024 0 0 0     0 return( $self->error( "Found an object ($this), but I do not know what to do with it." ) ) if( $self->_is_object( $this ) && ( !overload::Overloaded( $this ) || ( overload::Overloaded( $this ) && !overload::Method( $this => '""' ) ) ) );
      0        
1025             # This is the element tag name
1026 0 0 0     0 if( !defined( $elem ) && "$this" =~ /^\w+$/ )
1027             {
1028 0   0     0 $elem = $self->new_element( "$this" ) || return;
1029 0 0       0 if( defined( $parent ) )
1030             {
1031 0         0 $elem->parent( $parent );
1032 0         0 $parent->children->push( $elem );
1033             }
1034             }
1035             # Text node added as a child
1036             else
1037             {
1038 0   0     0 my $custodian = ( $elem // $parent );
1039 0 0       0 return( $self->error( "Found a text to add to the tree, but no parent was provided nor any element was initiated yet." ) ) if( !defined( $custodian ) );
1040 0   0     0 my $t = $self->new_text( "$this" ) || return;
1041 0         0 $t->parent( $custodian );
1042 0         0 $custodian->children->push( $t );
1043             }
1044             }
1045             }
1046 0         0 return( $elem );
1047 0         0 };
1048            
1049 0         0 foreach my $this ( @args )
1050             {
1051 0 0       0 return( $self->error( "I was expecting an array reference, but instead got '$this'." ) ) if( !$self->_is_array( $this ) );
1052             # There are more than one elements provided in this array definition, i.e. multiple html tags at the top level
1053             # so we create a special document html element to contain them
1054 0 0       0 if( scalar( @$this ) > 0 )
1055             {
1056 0   0     0 my $doc = $self->new_document || return;
1057 0 0       0 $crawl->( $this => $doc ) || return;
1058 0         0 $a->push( $doc );
1059             }
1060             else
1061             {
1062 0   0     0 my $e = $crawl->( $this ) || return;
1063 0         0 $a->push( $e );
1064             }
1065             }
1066 0         0 return( $a );
1067             }
1068              
1069             sub new_parser
1070             {
1071 0     0 1 0 my $self = shift( @_ );
1072 0 0       0 $self->_load_class( 'HTML::Object' ) || return( $self->pass_error );
1073 0   0     0 my $p = HTML::Object->new( debug => $self->debug ) ||
1074             return( $self->pass_error( HTML::Object->error ) );
1075 0         0 return( $p );
1076             }
1077              
1078             sub new_text
1079             {
1080 0     0 1 0 my $self = shift( @_ );
1081 0         0 my $p = {};
1082 0 0 0     0 if( scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' )
1083             {
1084 0         0 $p = shift( @_ );
1085             }
1086             else
1087             {
1088 0         0 $p->{value} = join( '', @_ );
1089             }
1090 0         0 $p->{debug} = $self->debug;
1091 0 0       0 $self->_load_class( 'HTML::Object::Text' ) || return( $self->pass_error );
1092 0   0     0 my $e = HTML::Object::Text->new( $p ) ||
1093             return( $self->pass_error( HTML::Object::Text->error ) );
1094 0         0 return( $e );
1095             }
1096              
1097             # Note: HTML::Element compatibility
1098             sub normalize_content
1099             {
1100 0     0 1 0 my $self = shift( @_ );
1101 0         0 my $children = $self->children;
1102 0         0 my $new = $self->new_array;
1103 0         0 my $prev;
1104             $children->foreach(sub
1105             {
1106 0 0 0 0   0 if( ( defined( $_ ) && $self->_is_a( $_ => 'HTML::Object::Text' ) && defined( $prev ) && $self->_is_a( $prev => 'HTML::Object::Text' ) ) ||
      0        
      0        
      0        
      0        
      0        
      0        
1107             ( defined( $_ ) && $self->_is_a( $_ => 'HTML::Object::Space' ) && defined( $prev ) && $self->_is_a( $prev => 'HTML::Object::Space' ) ) )
1108             {
1109 0         0 $prev->value->append( $_->value );
1110 0         0 next;
1111             }
1112 0         0 $prev = $_;
1113 0         0 $new->push( $_ );
1114 0         0 });
1115 0         0 $self->children( $new );
1116 0         0 return( $self );
1117             }
1118              
1119             # TODO: next()
1120              
1121 1093     1093 1 13750915 sub offset { return( shift->reset(@_)->_set_get_number_as_object( 'offset', @_ ) ); }
1122              
1123 1488     1488 1 17293560 sub original { return( shift->_set_get_scalar_as_object( 'original', @_ ) ); }
1124              
1125 1145     1145 1 5954889 sub parent { return( shift->_set_get_object_without_init( 'parent', 'HTML::Object::Element', @_ ) ); }
1126              
1127             # Note: Different from the one in HTML::Element
1128             sub pos
1129             {
1130 228     228 1 484 my $self = shift( @_ );
1131 228         731 my $parent = $self->parent;
1132 228 100       5932 return( $self->new_null ) if( !$parent );
1133 224         790 my $kids = $parent->children;
1134             #my $id = $self->eid;
1135             #my( $pos ) = grep{ $kids->[$_]->eid eq $id } 0..$#$kids;
1136             #return( $pos );
1137 224         15907 return( $kids->pos( $self ) );
1138             }
1139              
1140 0     0 1 0 sub pindex { return( shift->pos( @_ ) ); }
1141              
1142             # TODO: previous()
1143              
1144             # Note: HTML::Element compatibility
1145             sub postinsert
1146             {
1147 0     0 1 0 my $self = shift( @_ );
1148 0         0 my $parent = $self->parent;
1149 0 0       0 return( $self->error( "Element has no parent." ) ) if( !$parent );
1150 0         0 my $pos = $parent->children->pos( $self );
1151 0 0       0 return( $self->error( "Element is not found among parent's children elements." ) ) if( !defined( $pos ) );
1152 0   0     0 my $new = $self->_get_elements_list( @_ ) || return( $self->pass_error );
1153             $new->foreach(sub
1154             {
1155 0 0   0   0 $_->detach if( $_->parent );
1156 0         0 $_->parent( $parent );
1157 0         0 });
1158 0         0 $parent->children->splice( $pos + 1, 0, $new->list );
1159 0         0 $parent->reset(1);
1160 0         0 return( $self );
1161             }
1162              
1163             # Note: HTML::Element compatibility
1164             sub preinsert
1165             {
1166 0     0 1 0 my $self = shift( @_ );
1167 0         0 my $parent = $self->parent;
1168 0 0       0 return( $self->error( "Element has no parent." ) ) if( !$parent );
1169 0         0 my $pos = $parent->children->pos( $self );
1170 0 0       0 return( $self->error( "Element is not found among parent's children elements." ) ) if( !defined( $pos ) );
1171 0   0     0 my $new = $self->_get_elements_list( @_ ) || return( $self->pass_error );
1172             $new->foreach(sub
1173             {
1174 0 0   0   0 $_->detach if( $_->parent );
1175 0         0 $_->parent( $parent );
1176 0         0 });
1177 0         0 $parent->children->splice( $pos, 0, $new->list );
1178 0         0 $parent->reset(1);
1179 0         0 return( $self );
1180             }
1181              
1182             # Note: HTML::Element compatibility
1183             sub push_content
1184             {
1185 0     0 1 0 my $self = shift( @_ );
1186 0 0       0 return( $self ) unless( @_ );
1187 0         0 my $children = $self->children;
1188 0   0     0 my $new = $self->_get_elements_list( @_ ) || return( $self->pass_error );
1189             $new->foreach(sub
1190             {
1191 0 0   0   0 $_->detach if( $_->parent );
1192 0         0 $_->parent( $self );
1193 0         0 $children->push( $_ );
1194 0         0 });
1195 0         0 $self->reset(1);
1196 0         0 return( $self );
1197             }
1198              
1199             # Note: HTML::Element compatibility
1200             sub replace_with
1201             {
1202 0     0 1 0 my $self = shift( @_ );
1203 0         0 my $parent = $self->parent;
1204 0 0       0 return( $self->error( "Element has no parent." ) ) if( !$parent );
1205 0         0 my $pos = $parent->children->pos( $self );
1206 0 0       0 return( $self->error( "Element is not found among parent's children elements." ) ) if( !defined( $pos ) );
1207 0   0     0 my $new = $self->_get_elements_list( @_ ) || return( $self->pass_error );
1208             $new->foreach(sub
1209             {
1210 0 0   0   0 $_->detach if( $_->parent );
1211 0         0 $_->parent( $parent );
1212 0         0 });
1213 0         0 $parent->children->splice( $pos, 1, $new->list );
1214 0         0 $parent->reset(1);
1215 0         0 return( $self );
1216             }
1217              
1218             sub replace_with_content
1219             {
1220 0     0 1 0 my $self = shift( @_ );
1221 0         0 my $parent = $self->parent;
1222 0         0 my $children = $self->children;
1223 0 0       0 return( $self->error( "This element has no parent." ) ) if( !$parent );
1224 0         0 my $pos = $parent->children->pos( $self );
1225 0 0       0 return( $self->error( "Unable to find the current element among its parent's children." ) ) if( !defined( $pos ) );
1226             $children->foreach(sub
1227             {
1228 0     0   0 $_->parent( $parent );
1229 0         0 });
1230 0         0 $parent->splice( $pos, 1, $children->list );
1231 0         0 $self->parent( undef() );
1232 0         0 $parent->reset(1);
1233 0         0 return( $self );
1234             }
1235              
1236             sub reset
1237             {
1238 18263     18263 1 71803 my $self = shift( @_ );
1239 18263 100 100     63886 if( !CORE::length( $self->{_reset} ) && scalar( @_ ) )
1240             {
1241 1364         4672 $self->{_reset} = scalar( @_ );
1242 1364 100       6733 if( my $parent = $self->parent )
1243             {
1244 278         8744 $parent->reset(1);
1245             }
1246             }
1247 18263         156844 return( $self );
1248             }
1249              
1250             # Note: HTML::Element compatibility
1251             sub right
1252             {
1253 108     108 1 280 my $self = shift( @_ );
1254 108         438 my $parent = $self->parent;
1255 108 100       3355 return( $self->new_null ) if( !$parent );
1256 106         470 my $kids = $parent->children;
1257 106         8134 my $pos = $self->pos;
1258 106 50       4228 my $offset = @_ ? int( shift( @_ ) ) : $kids->size;
1259 106 50 33     3841844 return( $self->new_array ) if( !defined( $pos ) || $offset < $pos );
1260 106 50       15296 return( $self->new_array ) if( $kids->length == 1 );
1261             # my $results = $kids->offset( $pos + 1, ( $offset - $pos ) );
1262             # return( $results );
1263 106         3865192 return( $kids->offset( $pos + 1, ( $offset - $pos ) ) );
1264             }
1265              
1266             # Note: HTML::Element compatibility
1267             sub root
1268             {
1269 52     52 1 116 my $self = shift( @_ );
1270 52         98 my $root = $self;
1271 52         89 my $parent;
1272 52         188 while( $parent = $root->parent )
1273             {
1274 72         2662 $root = $parent;
1275             }
1276             # Typically a HTML::Object::Document
1277 52         1827 return( $root );
1278             }
1279              
1280             sub same_as
1281             {
1282 0     0 1 0 my $self = shift( @_ );
1283 0   0     0 my $elem = shift( @_ ) || return( $self->error( "No element object was provided to compare against." ) );
1284 0 0       0 return( $self->error( "Element provided (", overload::StrVal( $elem ), ") is not an object." ) ) if( !$self->_is_object( $elem ) );
1285 0 0       0 return( $self->error( "Element provided (", overload::StrVal( $elem ), ") is not an HTML::Object::Element object." ) ) if( !$elem->isa( 'HTML::Object::Element' ) );
1286 0         0 my $my_attr = $self->attributes->keys->sort;
1287 0         0 my $her_attr = $elem->attributes->keys->sort;
1288 0 0       0 return(0) unless( $my_attr eq $her_attr );
1289             $my_attr->foreach(sub
1290             {
1291 0 0   0   0 return(0) if( $self->attributes->get( $_ ) ne $elem->attributes->get( $_ ) );
1292 0         0 });
1293 0 0       0 return(0) if( $self->children->length != $elem->children->length );
1294 0         0 my $her_kids = $elem->children;
1295             $self->children->for(sub
1296             {
1297 0     0   0 my( $i, $e ) = @_;
1298 0 0       0 return(0) if( !$e->same_as( $her_kids->[$i] ) );
1299 0         0 });
1300 0         0 return(1);
1301             }
1302              
1303             sub set_checksum
1304             {
1305 631     631 1 2073 my $self = shift( @_ );
1306 631         3724 my $tag = $self->_tag;
1307 631         572514 my $a = $self->new_array( [$tag] );
1308             $self->attributes_sequence->foreach(sub
1309             {
1310 561     561   349473 my $attr = shift( @_ );
1311 561         2446 $a->push( $self->attributes->get( $attr ) );
1312 631         22053 });
1313 631         395986 return( $self->_get_md5_hash( $a->join( ';' )->scalar ) );
1314             }
1315              
1316             # Note: HTML::Element compatibility
1317             sub splice_content
1318             {
1319 0     0 1 0 my $self = shift( @_ );
1320 0         0 my $offset = shift( @_ );
1321 0         0 my $length = shift( @_ );
1322 0 0       0 return( $self ) unless( @_ );
1323 0 0       0 return( $self->error( "Offset value provided '$offset' is not an integer." ) ) if( !$self->_is_integer( $offset ) );
1324 0 0       0 return( $self->error( "Length value provided '$length' is not an integer." ) ) if( !$self->_is_integer( $length ) );
1325 0         0 my $children = $self->children;
1326 0   0     0 my $new = $self->_get_elements_list( @_ ) || return( $self->pass_error );
1327             $new->foreach(sub
1328             {
1329 0 0   0   0 $_->detach if( $_->parent );
1330 0         0 $_->parent( $self );
1331 0         0 });
1332 0         0 $children->splice( $offset, $length, $new->list );
1333 0         0 $self->reset(1);
1334 0         0 return( $self );
1335             }
1336              
1337 3673     3673 1 7676856 sub tag { return( shift->reset(@_)->_set_get_scalar_as_object( 'tag', @_ ) ); }
1338              
1339             # Note: HTML::Element compatibility
1340             sub traverse
1341             {
1342 0     0 1 0 my $self = shift( @_ );
1343 0   0     0 my $code = shift( @_ ) || return( $self->error( "No code provided to traverse the html tree." ) );
1344 0 0       0 return( $self->error( "The argument provided (", overload::StrVal( $code ), ") is not an anonymous subroutine." ) ) if( ref( $code ) ne 'CODE' );
1345 0         0 my $opts = $self->_get_args_as_hash( @_ );
1346 0   0     0 $opts->{bottom_up} //= 0;
1347 0         0 my $seen = {};
1348 0         0 my $crawl;
1349             $crawl = sub
1350             {
1351 0     0   0 my $e = shift( @_ );
1352 0         0 my $addr = Scalar::Util::refaddr( $e );
1353             # Duplicate
1354 0 0       0 return if( ++$seen->{ $addr } > 1 );
1355 0         0 local $_ = $e;
1356 0 0       0 $code->( $e ) unless( $opts->{bottom_up} );
1357             $e->children->foreach(sub
1358             {
1359 0         0 $crawl->( $_[0] );
1360 0         0 });
1361 0 0       0 $code->( $e ) if( $opts->{bottom_up} );
1362 0         0 };
1363 0         0 $crawl->( $self );
1364 0         0 return( $self );
1365             }
1366              
1367             # Note: HTML::Element compatibility
1368             sub unshift_content
1369             {
1370 0     0 1 0 my $self = shift( @_ );
1371 0 0       0 return( $self ) unless( @_ );
1372 0         0 my $children = $self->children;
1373 0   0     0 my $new = $self->_get_elements_list( @_ ) || return( $self->pass_error );
1374             $new->foreach(sub
1375             {
1376 0     0   0 $_->parent( $self );
1377 0         0 });
1378 0         0 $children->splice( 0, 0, $new->list );
1379 0         0 $self->reset(1);
1380 0         0 return( $self );
1381             }
1382              
1383             # called on a parent, with a child as second argument and its rank as third
1384             # returns the child if it is already an element, or
1385             # a new HTML::Object::Text element if it is a plain string
1386             sub _child_as_object
1387             {
1388 0     0   0 my( $self, $elt_or_text, $rank ) = @_;
1389 0 0       0 return unless( defined( $elt_or_text ) );
1390 0 0       0 if( !ref( $elt_or_text ) )
1391             {
1392 0         0 require HTML::Object::Text;
1393             # $elt_or_text is a string, turn it into a TextNode object
1394 0         0 $elt_or_text = HTML::Object::Text->new(
1395             parent => $self,
1396             value => $elt_or_text,
1397             );
1398             }
1399 0 0 0     0 warn( "rank is a ", ref( $rank ), " elt_or_text is a ", ref( $elt_or_text ) ) if( ref( $rank ) && !$self->_is_a( $rank, 'Module::Generic::Number' ) );
1400             # used for sorting
1401 0         0 $elt_or_text->rank( $rank );
1402 0         0 return( $elt_or_text );
1403             }
1404              
1405             sub _generate_uuid
1406             {
1407 1356     1356   2848804 return( lc( Data::UUID->new->create_str ) );
1408             }
1409              
1410             sub _get_elements_list
1411             {
1412 0     0   0 my $self = shift( @_ );
1413 0         0 my $new = $self->new_array;
1414 0         0 my $seen = {};
1415 0         0 my $prev;
1416 0         0 my $self_addr = Scalar::Util::refaddr( $self );
1417 0         0 my $parent_addr;
1418 0         0 my $parent = $self->parent;
1419 0 0       0 $parent_addr = Scalar::Util::refaddr( $parent ) if( defined( $parent ) );
1420 0         0 for( @_ )
1421             {
1422 0 0       0 return( $self->error( "Replacement element is not an HTML::Object::Element" ) ) if( !$self->_is_a( $_ => 'HTML::Object::Element' ) );
1423 0         0 my $addr = Scalar::Util::refaddr( $_ );
1424 0 0       0 if( ++$seen->{ $addr } > 1 )
1425             {
1426 0 0       0 warnings::warn( "Warnings only: found duplicate element with tag '" . $_->tag . "' provided in replace_with()\n" ) if( warnings::enabled( 'HTML::Object' ) );
1427 0         0 next;
1428             }
1429 0 0       0 return( $self->error( "Replacement list contains a copy of target!" ) ) if( $self_addr eq $addr );
1430 0 0 0     0 return( $self->error( "Cannot replace an item with its parent!" ) ) if( defined( $parent_addr ) && $addr eq $parent_addr );
1431 0 0 0     0 if( ( $_->isa( 'HTML::Object::Text' ) && defined( $prev ) && $prev->isa( 'HTML::Object::Text' ) ) ||
      0        
      0        
      0        
      0        
1432             ( $_->isa( 'HTML::Object::Space' ) && defined( $prev ) && $prev->isa( 'HTML::Object::Space' ) ) )
1433             {
1434 0         0 $prev->value->append( $_->value );
1435 0         0 next;
1436             }
1437 0         0 $new->push( $_ );
1438 0         0 $prev = $_;
1439             }
1440 0         0 return( $new );
1441             }
1442              
1443             # Used by after, append, before
1444             sub _get_from_list_of_elements_or_html
1445             {
1446 13     13   36 my $self = shift( @_ );
1447 13         60 my $list = $self->new_array;
1448 13         303 my $prev;
1449 13         76 foreach my $this ( @_ )
1450             {
1451 16 100       94 if( $self->_is_a( $this => 'HTML::Object::Element' ) )
1452             {
1453 11 50       465 if( $self->_is_a( $this => 'HTML::Object::DOM::DocumentFragment' ) )
    50          
1454             {
1455 0         0 my $clone = $this->children->clone;
1456 0         0 $list->push( $clone->list );
1457 0         0 $this->children->reset;
1458 0         0 undef( $prev );
1459             }
1460             elsif( $self->_is_a( $this => 'HTML::Object::Text' ) )
1461             {
1462 0 0 0     0 if( defined( $prev ) && $self->_is_a( $prev => 'HTML::Object::Text' ) )
1463             {
1464 0         0 $prev->value->append( $this->value );
1465             }
1466             else
1467             {
1468 0         0 my $clone = $this->clone;
1469 0         0 $list->push( $clone );
1470 0         0 $prev = $clone;
1471             }
1472             }
1473             else
1474             {
1475 11         859 my $clone = $this->clone;
1476 11         307 $list->push( $clone );
1477             # $list->push( $clone->close_tag ) if( $clone->close_tag );
1478 11         111 undef( $prev );
1479             }
1480             }
1481             else
1482             {
1483 5 0 0     166 if( ref( $this ) && ( !$self->_is_object( $this ) || ( $self->_is_object( $this ) && !overload::Method( $this, '""' ) ) ) )
      33        
1484             {
1485 0         0 return( $self->error( "I was expecting some HTML data, but got '", overload::StrVal( $this ), "'" ) );
1486             }
1487            
1488             # if( "$this" =~ /$LOOK_LIKE_HTML/ )
1489             # LOOK_LIKE_HTML check for html tag starting at the beginning of the string
1490             # LOOK_LIKE_IT_HAS_HTML checks for tag anywhere
1491 5 100       110 if( "$this" =~ /$LOOK_LIKE_IT_HAS_HTML/ )
1492             {
1493 1         11 my $p = $self->new_parser( debug => 4 );
1494 1   50     8 my $res = $p->parse_data( "$this" ) ||
1495             return( $self->error( "Error while parsing html data provided: ", $p->error ) );
1496 1 50       5 $list->push( $res->children->list ) if( !$res->children->is_empty );
1497             }
1498             # Maybe just some text provided, and in that case, the parser would return nothing unfortunately
1499             else
1500             {
1501 4 50 33     29 if( defined( $prev ) && $self->_is_a( $prev => 'HTML::Object::Text' ) )
1502             {
1503 0         0 $prev->value->append( "$this" );
1504             }
1505             else
1506             {
1507 4         41 my $e = $self->new_text({ value => "$this" });
1508 4         45 $list->push( $e );
1509 4         41 $prev = $e;
1510             }
1511             }
1512             }
1513             }
1514 13         130 return( $list );
1515             }
1516              
1517             sub _get_md5_hash
1518             {
1519 1139     1139   399535 my $self = shift( @_ );
1520 1139         3127 my $data = shift( @_ );
1521 1139 100 66     9495 return( $self->error( "No data was provided to compute a md5 hash." ) ) if( !defined( $data ) || !length( "$data" ) );
1522 1038 50 33     4477 try
  1038         2247  
  1038         2728  
  1038         6260  
  0         0  
  1038         2335  
  1038         4474  
  1038         3289  
1523 1038     1038   1993 {
1524 1038         14782 return( Digest::MD5::md5_hex( Encode::encode( 'utf8', $data, Encode::FB_CROAK ) ) );
1525             }
1526 1038 0 0     6752 catch( $e )
  0 0 33     0  
  0 0       0  
  1038 0       3087  
  1038 0       2132  
  1038 0       2100  
  1038 0       2772  
  1038 0       5764  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 100       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  
  1038         3523  
  940         2811  
  98         255  
  0         0  
  0         0  
  1038         43960  
  1038         5687  
  1038         3242  
  1038         3662  
  0         0  
  0         0  
  0         0  
  0         0  
1527 0     0   0 {
1528 0         0 return( $self->error( "An error occurred while calculating the md5 hash for tag \"", $self->tag, "\": $e" ) );
1529 30 0 0 30   302 }
  30 0 0     76  
  30 0 33     17197  
  0 0 33     0  
  0 0 33     0  
  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       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  
  1038 0       3909  
  0 0       0  
  1038 100       11530  
  1038 50       7390  
  1038 50       4582  
  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  
  1038         15698  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1530             }
1531              
1532             # For other modules to use
1533 2     2   14 sub _is_reset { return( CORE::length( shift->{_reset} ) ); }
1534              
1535             # For other modules to use
1536 94     94   437 sub _remove_reset { return( CORE::delete( shift->{_reset} ) ); }
1537              
1538             # Method shared with HTML::Object::XQuery
1539             sub _set_get_id : lvalue { return( shift->_set_get_callback({
1540             get => sub
1541             {
1542 11     11   5716 my $self = shift( @_ );
1543 11         54 my $id = $self->new_scalar( $self->attributes->get( 'id' ) );
1544 11         6434 return( $id );
1545             },
1546             set => sub
1547             {
1548 8     8   5580 my $self = shift( @_ );
1549 8         25 my $id = shift( @_ );
1550 8 50 33     78 if( !defined( $id ) || !CORE::length( $id ) )
1551             {
1552 0 0       0 if( $self->attributes->exists( 'id' ) )
1553             {
1554 0         0 $self->attributes->delete( 'id' );
1555 0         0 $self->attributes_sequence->remove( 'id' );
1556 0         0 $self->reset(1);
1557 0         0 return(1);
1558             }
1559 0         0 return(0);
1560             }
1561             else
1562             {
1563 8         45 $self->attributes->set( id => $id );
1564 8         4949 $self->reset(1);
1565 8         30 return(1);
1566             }
1567             }
1568 19     19   270 }, @_ ) ); }
1569              
1570             sub _same_as
1571             {
1572 215     215   6358 my $self = shift( @_ );
1573 215         421 my $this = shift( @_ );
1574 215 50 33     1392 return(0) if( !defined( $this ) || ( defined( $this ) && !$self->_is_a( $this, 'HTML::Object::Element' ) ) );
      33        
1575 215 100       9448 return( $self->eid CORE::eq $this->eid ? 1 : 0 );
1576             }
1577              
1578             # Used to register callbacks for some properties like rel, sizes, controlslist that we trigger and that update the attribute's HTML::Object::TokenList
1579             sub _set_get_internal_attribute_callback
1580             {
1581 58     58   139 my $self = shift( @_ );
1582 58 50       236 $self->{_internal_attribute_callbacks} = {} if( ref( $self->{_internal_attribute_callbacks} ) ne 'HASH' );
1583 58         140 my $ref = $self->{_internal_attribute_callbacks};
1584             # get mode
1585 58 50       263 if( scalar( @_ ) == 1 )
    50          
1586             {
1587 0         0 my $attr = shift( @_ );
1588 0         0 return( $ref->{ $attr } );
1589             }
1590             elsif( scalar( @_ ) )
1591             {
1592 58 50       226 return( $self->error( "Odd number of parameters for attribute callback assignment." ) ) if( ( @_ % 2 ) );
1593 58         239 for( my $i = 0; $i < scalar( @_ ); $i += 2 )
1594             {
1595 58         263 $ref->{ $_[ $i ] } = $_[ $i + 1 ];
1596             }
1597 58         142 return( $self );
1598             }
1599 0         0 return;
1600             }
1601              
1602             # A private method for internal use when the tag method has been overriden for example as it is the case in HTML::Object::XQuery
1603 631     631   3012 sub _tag { return( shift->reset(@_)->_set_get_scalar_as_object( 'tag', @_ ) ); }
1604              
1605             1;
1606             # NOTE: POD
1607             __END__
1608              
1609             =encoding utf-8
1610              
1611             =head1 NAME
1612              
1613             HTML::Object::Element - HTML Element Object
1614              
1615             =head1 SYNOPSIS
1616              
1617             use HTML::Object::Element;
1618             my $this = HTML::Object::Element->new || die( HTML::Object::Element->error, "\n" );
1619              
1620             =head1 VERSION
1621              
1622             v0.2.6
1623              
1624             =head1 DESCRIPTION
1625              
1626             This interface implement a core element for L<HTML::Object> parser. An element can be one or more space, a text, a tag, a comment, or a document, all of the above inherit from this core interface.
1627              
1628             For a more elaborate interface and a close implementation of the Web Document Object Model (a.k.a. DOM), see L<HTML::Object::DOM::Element> and the L<DOM parser|HTML::Object::DOM>
1629              
1630             =head1 METHODS
1631              
1632             =for Pod::Coverage add
1633              
1634             =for Pod::Coverage addClass
1635              
1636             =for Pod::Coverage appendTo
1637              
1638             =for Pod::Coverage align
1639              
1640             =for Pod::Coverage compact
1641              
1642             =for Pod::Coverage crossOrigin
1643              
1644             =for Pod::Coverage currentSrc
1645              
1646             =for Pod::Coverage defaultValue
1647              
1648             =for Pod::Coverage download
1649              
1650             =for Pod::Coverage form
1651              
1652             =for Pod::Coverage hash
1653              
1654             =for Pod::Coverage host
1655              
1656             =for Pod::Coverage hostname
1657              
1658             =for Pod::Coverage href
1659              
1660             =for Pod::Coverage hreflang
1661              
1662             =for Pod::Coverage origin
1663              
1664             =for Pod::Coverage password
1665              
1666             =for Pod::Coverage pathname
1667              
1668             =for Pod::Coverage port
1669              
1670             =for Pod::Coverage protocol
1671              
1672             =for Pod::Coverage referrerPolicy
1673              
1674             =for Pod::Coverage rel
1675              
1676             =for Pod::Coverage relList
1677              
1678             =for Pod::Coverage search
1679              
1680             =for Pod::Coverage setCustomValidity
1681              
1682             =for Pod::Coverage target
1683              
1684             =for Pod::Coverage useMap
1685              
1686             =for Pod::Coverage username
1687              
1688             =head2 address
1689              
1690             This method is purely for compatibility with L<HTML::Element/address>. Please, refer to its documentation for its use.
1691              
1692             =head2 all_attr
1693              
1694             Returns an hash (B<not> an hash reference) of the element's attributes as a key-value pairs.
1695              
1696             This is provided in compatibility with C<HTML::Element>
1697              
1698             my %attributes = $e->all_attr;
1699              
1700             =head2 all_attr_names
1701              
1702             Returns a list of all the element's attributes in no particular order.
1703              
1704             my @attributes = $e->all_attr_names;
1705              
1706             =head2 as_html
1707              
1708             This is an alias for L</as_string>
1709              
1710             =head2 as_string
1711              
1712             Returns a string representation of the current element and its underlying descendants.
1713              
1714             If a cached version of that string exists, it is returned instead.
1715              
1716             =head2 as_text
1717              
1718             Returns a string representation of the text content of the current element and its descendant.
1719              
1720             If a cached version of that string exists, it is returned instead.
1721              
1722             =head2 as_trimmed_text
1723              
1724             Return the value returned by L</as_text>, only its leading and trailing spaces, if any, are trimmed.
1725              
1726             =head2 as_xml
1727              
1728             This is merely an alias for L<as_string>
1729              
1730             =head2 attr
1731              
1732             Provided with an attribute C<name> and this will return it. If an attribute C<value> is also provided, it will set or replace the attribute valu accordingly. If that attribute value provided is C<undef>, this will remove the attribute altogether.
1733              
1734             =head2 attributes
1735              
1736             Returns an L<hash object|Module::Generic::Hash> of all the attributes key-value pairs.
1737              
1738             Be careful this is a 'live' object, and if you make change to it directly, you could damage the hierarchy or introduce errors.
1739              
1740             =head2 attributes_sequence
1741              
1742             Returns an L<array object|Module::Generic::Array> containing the attribute names in their order of appearance.
1743              
1744             =head2 checksum
1745              
1746             Returns the element checksum, used to determine if any change was made.
1747              
1748             =head2 children
1749              
1750             Returns an L<array object|Module::Generic::Array> containing all the element's children.
1751              
1752             =head2 class
1753              
1754             Returns this element class, e.g. C<HTML::Object::Element> or C<HTML::Object::Document>
1755              
1756             =head2 clone
1757              
1758             Returns a copy of the current element, and recursively all of its descendants,
1759              
1760             The cloned element, that is returned, has no parent.
1761              
1762             =head2 clone_list
1763              
1764             Clone all the element children and return a new L<array object|Module::Generic::Array> of the cloned children.
1765              
1766             This is quite different from C<HTML::Element> equivalent that is accessed as a class method and takes an arbitrary list of elements.
1767              
1768             =head2 close
1769              
1770             Close the current tag, if necessary. It returns the current object upon success, or C<undef> upon error and sets an L<error|Module::Generic/error>
1771              
1772             =head2 close_tag
1773              
1774             Set or get a L<closing element object|HTML::Object::Closing> that is used to close the current element.
1775              
1776             =head2 column
1777              
1778             Returns the column at which this element was found in the original HTML text string, by the L<parser|HTML::Object>.
1779              
1780             =head2 content
1781              
1782             This is an alias for L</children>. It returns an L<array object|Module::Generic::Array> of the current element's children objects.
1783              
1784             =head2 content_array_ref
1785              
1786             This is an alias for L</children>. It returns an L<array object|Module::Generic::Array> of the current element's children objects.
1787              
1788             This is provided in compatibility with C<HTML::Element>
1789              
1790             =head2 content_list
1791              
1792             In list context, this returns the list of the curent element's children, if any, and in scalar context, this returns the number of children elements it contains.
1793              
1794             This is provided in compatibility with C<HTML::Element>
1795              
1796             =head2 delete
1797              
1798             Remove all of its content by calling L</delete_content>, detach the current object, and destroy the object.
1799              
1800             =head2 delete_content
1801              
1802             Remove the content, i.e. all the children, of the current element, effectively calling L</delete> on each one of them.
1803              
1804             It returns the current element.
1805              
1806             =head2 delete_ignorable_whitespace
1807              
1808             Does not do anything by design. There is no much value into this method under L<HTML::Object> in the first place.
1809              
1810             =head2 depth
1811              
1812             Returns an L<integer|Module::Generic::Number> representing the depth level of the current element in the hierarchy.
1813              
1814             =head2 descendants
1815              
1816             Returns an L<array object|Module::Generic::Array> of all the element's descendants throughout its hierarchy.
1817              
1818             =head2 destroy
1819              
1820             An alias for L</delete>
1821              
1822             =head2 destroy_content
1823              
1824             An alias for L</delete_content>
1825              
1826             =head2 detach
1827              
1828             This method takes no parameter and removes the current element from its parent's list of children element, and unset its parent object value.
1829              
1830             It returns the element parent object.
1831              
1832             =head2 detach_content
1833              
1834             This method takes no argument and will remove the parent value for each of its children, set the children list for the current element to an empty list and return the list of those children elements thus removed.
1835              
1836             my @removed = $e->detach_content;
1837              
1838             This is provided in compatibility with C<HTML::Element>
1839              
1840             =head2 dump
1841              
1842             Print out on the stdout a representation of the hierarchy of element objects.
1843              
1844             =head2 eid
1845              
1846             Returns the element unique id, which is automatically generated for any element. This is actually a uuid. For example:
1847              
1848             my $eid = $e->eid; # e.g.: 971ef725-e99b-4869-b6ac-b245794e84e2
1849              
1850             =head2 end
1851              
1852             Returns the current object.
1853              
1854             Actually, I am not sure this should be here, and rather it should be in L<HTML::Object::XQuery> since it simulates jQuery.
1855              
1856             =head2 extract_links
1857              
1858             Returns links found by traversing the element and all of its children and looking for attributes (like C<href> in an C<<a>> element, or C<src> in an C<<img>> element) whose values represent links.
1859              
1860             You may specify that you want to extract links from just some kinds of elements (instead of the default, which is to extract links from all the kinds of elements known to have attributes whose values represent links). For instance, if you want to extract links from only C<<a>> and C<<img>> elements, you could code it like this:
1861              
1862             my $links = $elem->extract_links( qw( a img ) ) ||
1863             die( $elem->error );
1864             foreach( @$links )
1865             {
1866             say "Hey, there is a ", $_->{tag}, " that links to ", $_->{value}, "in its ", $_->{attribute}, " attribute, at ", $_->{element}->address;
1867             }
1868              
1869             The dictionary definition hash reference of all tags and their attributes containing potential links is available as C<$HTML::Object::LINK_ELEMENTS>
1870              
1871             This method returns an L<array object|Module::Generic::Array> containing L<hash objects|Module::Generic::Hash>, for each attribute of an element containing a link, with the following properties:
1872              
1873             =over 4
1874              
1875             =item * C<attribute>
1876              
1877             The attribute containing the link
1878              
1879             =item * C<element>
1880              
1881             The L<element object|HTML::Object::Element>
1882              
1883             =item * C<tag>
1884              
1885             The element tag name.
1886              
1887             =item * C<value>
1888              
1889             The attribute value, which would typically contain the link value.
1890              
1891             =back
1892              
1893             Nota bene: this method has been implemented to provide similar API as L<HTML::Element> and the 2 first paragraphs of this method description are taken from this module.
1894              
1895             =head2 find_by_attribute
1896              
1897             Returns an L<array object|Module::Generic::Array> of all the elements (including potentially the current element itself) in the element's hierarchy who have an attribute that matches the given attribute name.
1898              
1899             my $list = $e->find_by_attribute( 'data-dob' );
1900              
1901             =head2 find_by_tag_name
1902              
1903             Returns an L<array object|Module::Generic::Array> of all the elements (including potentially the current element itself) in the element's hierarchy who matches any of the specified tag names. Tag names can be provided n case insensitive.
1904              
1905             my $list = $e->find_by_tag_name( qw( div p span ) );
1906              
1907             =head2 has_children
1908              
1909             Returns true if the current element has children, i.e. it contains other elements within itself.
1910              
1911             =head2 id
1912              
1913             Set or get the id HTML attribute of the element.
1914              
1915             =head2 insert_element
1916              
1917             Provided with an element object and this will add it to the current element's children.
1918              
1919             It returns the current element object.
1920              
1921             =head2 internal
1922              
1923             Returns the internal hash of key-value paris used internally by this package. This is primarily used to handle the C<data-*> special attributes.
1924              
1925             =head2 is_closed
1926              
1927             Returns true if the current element has a L<closing tag|HTML::Object::Closing> that is accessible with L</close_tag>
1928              
1929             =head2 is_empty
1930              
1931             Returns true if this is an element who, by HTML standard, does not contain any other elements, and false otherwise.
1932              
1933             To check if the element has children, use L</has_children>
1934              
1935             =head2 is_inside
1936              
1937             Provided with a list of tag names or element objects, and this will check if the current element is contained in any of the element objects, or elements whose tag name is provided. It returns true if it is contained, or false otherwise.
1938              
1939             Example:
1940              
1941             say $e->is_inside( qw( span div ), $elem1, 'p', $elem2 ) ? 'yes' : 'no';
1942              
1943             =head2 is_valid_attribute
1944              
1945             Provided with an attribute name and this returns true if it is valid of false otherwise.
1946              
1947             =head2 is_void
1948              
1949             Returns true if, by standard, this tag is void, meaning it does not contain any children. For example: C<<br />>, C<<link />>, or C<<input />>
1950              
1951             =head2 left
1952              
1953             Returns an L<array object|Module::Generic::Array> of all the sibling objects before the current element.
1954              
1955             =head2 line
1956              
1957             Returns the line at which this element was found in the original HTML text string, by the L<parser|HTML::Object>.
1958              
1959             =head2 lineage
1960              
1961             Returns an L<array object|Module::Generic::Array> of the current element's parent and parent's parent up to the L<root of the hierarchy|HTML::Object::Document>
1962              
1963             =head2 lineage_tag_names
1964              
1965             Returns an L<array object|Module::Generic::Array> of the current element's parent tag name and parent's parent tag name up to the L<root of the hierarchy|HTML::Object::Document>
1966              
1967             This is equivalent to:
1968              
1969             my $list = $self->lineage->map(sub{ $_->tag });
1970              
1971             =head2 look
1972              
1973             This is the method that does the heavy work for L</look_down> and L</look_up>
1974              
1975             =head2 look_down
1976              
1977             Provided with some criterias, and an optional hash reference of options, and this will crawl down the current element hierarchy to find any matching element.
1978              
1979             my $list = $e->look_down( _tag => 'div' ); # returns an Module::Generic::Array object
1980             my $list = $e->look_down( class => qr/\bclass_name\b/, { max_level => 3, max_match => 1 });
1981              
1982             The options you can specify are:
1983              
1984             =over 4
1985              
1986             =item I<max_level>
1987              
1988             Takes an integer that sets the maximum lower or upper level beyond which, this wil stop searching.
1989              
1990             =item I<max_match>
1991              
1992             Takes an integer that sets the maximum number of matches after which, this will stop recurring and return the result.
1993              
1994             =back
1995              
1996             There are three kinds of criteria you can specify:
1997              
1998             =over 4
1999              
2000             =item 1. C<attr_name>, C<attr_value>
2001              
2002             This is used when you are looking for an element with a particular attribute name and value. For example:
2003              
2004             my $list = $e->look_down( id => 'hello' );
2005              
2006             This will look for any element whose attribute C<id> has a value of C<hello>
2007              
2008             If you want to search for an attribute that does B<not> exist, set the attribute value being searched to C<undef>
2009              
2010             To search for a tag, use the special attribute C<_tag>. For example:
2011              
2012             my $list = $e->look_down( _tag => 'div' );
2013              
2014             This will return an L<array object|Module::Generic::Array> of all the C<div> elements.
2015              
2016             =item 2. C<attr_name>, qr//
2017              
2018             Same as above, except the attribute value of the element being checked will be evaluated against this regular expression and if true will be added into the resulting array object.
2019              
2020             For example:
2021              
2022             my $list = $e->look_down( 'data-dob' => qr/^\d{4}-\d{2}-\d{2}$/ );
2023              
2024             This will search for all element who have an attribute C<data-dob> and with value something that looks like a date.
2025              
2026             =item 3. \&my_check or sub{ # some code here }
2027              
2028             Provided with a code reference (i.e. a reference to an existing subroutine, or an anonymous one), and it will be evaluated for each element found. If it returns C<undef>, C<look_down> will interrupt its crawling, and if it returns true, it will signal the need to add the element to the resulting array object of elements.
2029              
2030             For example:
2031              
2032             my $list = $e->look_down(
2033             _tag => 'img',
2034             class => qr/\bactive\b/,
2035             sub
2036             {
2037             return( $_->attr( 'width' ) > 350 ? 1 : 0 );
2038             }
2039             );
2040              
2041             When executing the code, the current element being evaluated will be made available via C<$_>
2042              
2043             =back
2044              
2045             Those criteria are called and evaluated in the order they are provided. Thus, if you specify, for example:
2046              
2047             my $list = $e->look_down(
2048             _tag => 'img',
2049             class => qr/\bactive\b/,
2050             sub
2051             {
2052             return( $_->attr( 'width' ) > 350 ? 1 : 0 );
2053             }
2054             );
2055              
2056             Each element will be evaluated first to see if their tag is C<img> and discarded if they are not. Then, if they have a class attribute and its content match the regular expression provided, and the element gets discarded if it does not match. Finally, the code will be evaluated.
2057              
2058             Thus, the order of the criteria is important.
2059              
2060             It returns an L<array object|Module::Generic::Array> of all the elements found.
2061              
2062             This is provided as a compatibility with C<HTML::Element>
2063              
2064             =head2 look_up
2065              
2066             Provided with some criterias, and an optional hash reference of options, and this will crawl up the current element ascendants starting with its parent to find any matching element.
2067              
2068             The options that can be used are the same ones that for L</look_down>, i.e. C<max_level> and C<max_match>
2069              
2070             It returns an L<array object|Module::Generic::Array> of all the elements found.
2071              
2072             This is provided as a compatibility with C<HTML::Element>
2073              
2074             =head2 looks_like_html
2075              
2076             Provided with a string and this returns true if the string starts with an HTML tag, or false otherwise.
2077              
2078             =head2 looks_like_it_has_html
2079              
2080             Provided with a string and this returns true if the string contains HTML tags, or false otherwise.
2081              
2082             =head2 modified
2083              
2084             Set or get a boolean of whether the element was modified. Actually this is not used.
2085              
2086             This returns a L<DateTime> object.
2087              
2088             =head2 new_attribute
2089              
2090             This creates a new L<HTML::Object::Attribute> object passing it any arguments provided, and returns the object thus created, or C<undef> if an L<error|Module::Generic/error> occurred.
2091              
2092             =head2 new_closing
2093              
2094             This creates a new L<HTML::Object::Closing> object passing it any arguments provided, and returns the object thus created, or C<undef> if an L<error|Module::Generic/error> occurred.
2095              
2096             =head2 new_document
2097              
2098             Instantiate a new L<HTML document|HTML::Object::Document>, passing it whatever argument was provided, and return the resulting object.
2099              
2100             =head2 new_element
2101              
2102             Instantiate a new L<element|HTML::Object::Element>, passing it whatever argument was provided, and return the resulting object.
2103              
2104             =head2 new_from_lol
2105              
2106             This is a legacy from C<HTML::Element>, but is not actually used.
2107              
2108             This recursively constructs a tree of nodes.
2109              
2110             It returns an L<array object|Module::Generic::Array> of elements.
2111              
2112             =head2 new_parser
2113              
2114             Instantiate a new L<parser object|HTML::Object>, passing it whatever argument was provided, and return the resulting object.
2115              
2116             =head2 new_text
2117              
2118             Instantiate a new L<text object|HTML::Object::Text>, passing it whatever argument was provided, and return the resulting object.
2119              
2120             =head2 normalize_content
2121              
2122             Check each of the current element child element and concatenate any adjacent text or space element.
2123              
2124             It returns the current object.
2125              
2126             =head2 offset
2127              
2128             Returns the offset value, i.e. the byte position, at which the tag was found in the original HTML data.
2129              
2130             =head2 original
2131              
2132             Returns the original raw string data as it was captured initially by the parser.
2133              
2134             This is an important feature of L<HTML::Object> since that, if nothing was changed, L<HTML::Object> will return the element objects in their C<original> text version.
2135              
2136             Whereas, other HTML parser, decode all the HTML elements parsed and rebuild them, often badly and even though they have not been changed, which of course, incur a heavy speed penalty.
2137              
2138             =head2 parent
2139              
2140             Returns the current element's L<parent element|HTML::Object::Element>, if any. The value returned could very well be empty if, for example, it is the L<top element|HTML::Object::Document> or if the element was created independently of any parsing.
2141              
2142             =head2 pindex
2143              
2144             This is an alias for L</pos>
2145              
2146             =head2 pos
2147              
2148             Read-only.
2149              
2150             Returns the position L<integer|Module::Generic::Number> of the current element among its parent's children elements.
2151              
2152             It returns a L<smart undef|Module::Generic/new_null> if the element has no parent.
2153              
2154             If the current element, somehow, could not be found among its parent, this would return C<undef>
2155              
2156             Contrary to the C<HTML::Element> equivalent, you cannot manually change this value.
2157              
2158             =head2 postinsert
2159              
2160             Provided with a list of L<elements|HTML::Object::Element> and this will add them right after the current element in its parent's children.
2161              
2162             It returns the current element object for chaining upon success, and upon error, it returns C<undef> and sets an L<error|HTML::Object::Exception>
2163              
2164             =head2 preinsert
2165              
2166             Provided with a list of L<elements|HTML::Object::Element> and this will add them right before the current element in its parent's children.
2167              
2168             It returns the current element object for chaining upon success, and upon error, it returns C<undef> and sets an L<error|HTML::Object::Exception>
2169              
2170             =head2 push_content
2171              
2172             Provided with a list of L<elements|HTML::Object::Element> and this will add them as children to the current element.
2173              
2174             Contrary to the C<HTML::Element> equivalent, this requires that only object be provided, which is easy to do anyhow.
2175              
2176             If consecutive text or space objects are provided they are automatically merged with their immediate text or space objects, if any.
2177              
2178             For example:
2179              
2180             $e->push_content( $elem1, HTML::Object::Element->new( value => q{some text} ), $elem2 );
2181              
2182             And if two consecutive text objects were provided the second one would have its L<value|HTML::Object::Text/value> merged with the previous one.
2183              
2184             It returns the current element object for chaining.
2185              
2186             =head2 replace_with
2187              
2188             Provided with a list of L<element objects|HTML::Object::Element> and this will replace the current element in its parent's children with the element objects provided.
2189              
2190             This will return an L<error|HTML::Object::Exception> if the current element has no parent, or if the current element cannot be found among its parent's children elements.
2191              
2192             Also, this method will filter out any duplicate objects, and return an error if the element being replaced is also among the objects provided for replacement or if the current element's parent is among the replacement objects.
2193              
2194             Each replacement object is detached from its previous parent and re-attach to the current element's parent before being added to its children.
2195              
2196             It returns the current element object.
2197              
2198             =head2 replace_with_content
2199              
2200             Replaces the current element in its parent's children by its own children element, which, in other words, means that the current element children will be moved up and replace the current element itself.
2201              
2202             It returns the current element object, which will then, have no more parent.
2203              
2204             =head2 reset
2205              
2206             Enable the reset flag for this element, which has the effect of instructing L</as_string> to not use its cache.
2207              
2208             =head2 right
2209              
2210             Returns an L<array object|Module::Generic::Array> of all the sibling objects after the current element.
2211              
2212             =head2 root
2213              
2214             Returns the top most element in the hierarchy, which usually is L<HTML::Object::Document>
2215              
2216             =head2 same_as
2217              
2218             This method will check that 2 element objects are similar, in the sense that they can have different L</eid>, but have identical structure.
2219              
2220             I you want to check if 2 element object are actually the same, by comparing their C<eid>, you can use the comparison signs that have been overloaded. For example:
2221              
2222             say $a eq $b ? 'same' : 'nope';
2223              
2224             =head2 set_checksum
2225              
2226             Calculate and returns the md5 checksum of the current element based on all its attributes.
2227              
2228             =head2 splice_content
2229              
2230             Provided with an C<offset> and a C<length>, and a list of L<element objects|HTML::Object::Element> and this will replace the elements children at offset position C<offset> and for a C<length> number of items by the list of objects supplied.
2231              
2232             If consecutive L<text element|HTML::Object::Text> or L<space element|HTML::Object::Space> are provided they will be merged with their immediate previous sibling of the same type.
2233              
2234             For example:
2235              
2236             $e->splice_content( 3, 2, $elem1, $elem2, HTML::Object::Text->new( value => 'Hello world' ) );
2237              
2238             It returns an error if the C<offset> or C<length> provided is not a valid integer.
2239              
2240             Upon success, it returns the current object for chaining.
2241              
2242             =head2 tag
2243              
2244             Returns the tag name of the current element as a L<scalar object|Module::Generic::Scalar>. Be careful at any change you would make as it would directly change the element tag name.
2245              
2246             Non-element tag, such as L<text|HTML::Object::Text> or L<space|HTML::Object::Space> have a pseudo tag starting with an underscore ("_"), such as C<_text> and C<_space>
2247              
2248             =head2 traverse
2249              
2250             Provided with a reference to an existing subroutine, or an anonymous one, and this will crawl through every element of the descending hierarchy and call the callback code, passing it the element object being evaluated. The local variable C<$_> is also made available and set to the element being evaluated.
2251              
2252             =head2 unshift_content
2253              
2254             This acts like L</push_content>, except that instead of appending the elements, this prepends the given element on top of the element children.
2255              
2256             It returns the current element.
2257              
2258             =head1 AUTHOR
2259              
2260             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
2261              
2262             =head1 SEE ALSO
2263              
2264             L<HTML::Object>, L<HTML::Object::Attribute>, L<HTML::Object::Boolean>, L<HTML::Object::Closing>, L<HTML::Object::Collection>, L<HTML::Object::Comment>, L<HTML::Object::Declaration>, L<HTML::Object::Document>, L<HTML::Object::Element>, L<HTML::Object::Exception>, L<HTML::Object::Literal>, L<HTML::Object::Number>, L<HTML::Object::Root>, L<HTML::Object::Space>, L<HTML::Object::Text>, L<HTML::Object::XQuery>
2265              
2266             L<Mozilla Element documentation|https://developer.mozilla.org/en-US/docs/Web/API/Element>
2267              
2268             =head1 COPYRIGHT & LICENSE
2269              
2270             Copyright (c) 2021 DEGUEST Pte. Ltd.
2271              
2272             All rights reserved
2273              
2274             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
2275              
2276             =cut