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