File Coverage

lib/HTML/Object/TokenList.pm
Criterion Covered Total %
statement 76 122 62.3
branch 9 32 28.1
condition 4 15 26.6
subroutine 19 31 61.2
pod 21 21 100.0
total 129 221 58.3


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/TokenList.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/09
7             ## Modified 2022/09/18
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTML::Object::TokenList;
15             BEGIN
16             {
17 2     2   6553 use strict;
  2         8  
  2         75  
18 2     2   10 use warnings;
  2         13  
  2         76  
19 2     2   10 use parent qw( Module::Generic );
  2         11  
  2         19  
20 2     2   149 use vars qw( $VERSION );
  2         8  
  2         106  
21 2     2   79 our $VERSION = 'v0.2.0';
22             };
23              
24 2     2   18 use strict;
  2         4  
  2         52  
25 2     2   27 use warnings;
  2         9  
  2         3177  
26              
27             sub init
28             {
29 1     1 1 140 my $self = shift( @_ );
30 1         2 my $tokens = shift( @_ );
31 1         91 $self->{attribute} = undef;
32 1         4 $self->{items} = [];
33 1         2 $self->{element} = undef;
34 1         1 $self->{tokens} = undef;
35 1 50 33     60 if( defined( $tokens ) && CORE::length( $tokens ) )
36             {
37 1         7 $self->{items} = $self->_string2array( $tokens )->unique(1);
38 1         72 $self->{tokens} = $tokens;
39             }
40 1         12 $self->{_init_strict_use_sub} = 1;
41 1 50       16 $self->SUPER::init( @_ ) || return( $self->pass_error );
42 1         1046 return( $self );
43             }
44              
45             sub add
46             {
47 1     1 1 2 my $self = shift( @_ );
48 1         5 my $a = $self->_string2array( @_ );
49 1         41 $self->items->push( $a->list );
50 1         649 $self->items->unique(1);
51 1         591 $self->_reset;
52 1         2 return( $self );
53             }
54              
55 1     1 1 5 sub as_string { return( shift->items->join( ' ' )->scalar ); }
56              
57 7     7 1 71 sub attribute { return( shift->_set_get_scalar_as_object( 'attribute', @_ ) ); }
58              
59 2     2 1 234 sub contains { return( shift->items->has( _trim( @_ ) ) ); }
60              
61 7     7 1 217 sub element { return( shift->_set_get_object_without_init( 'element', 'HTML::Object::Element', @_ ) ); }
62              
63 0     0 1 0 sub entries { return; }
64              
65             sub forEach
66             {
67 0     0 1 0 my $self = shift( @_ );
68 0   0     0 my $code = shift( @_ ) || return( $self->error( "No anonymous subroutine was provided." ) );
69 0 0       0 return( $self->error( "Callback provided is not an anonymous subroutine" ) ) if( ref( $code ) ne 'CODE' );
70 0         0 my $elem = $self->element;
71             # We do not sort on purpose. Change in the order will trigger a cache reset on the associated element
72 0 0       0 my $before = $self->items->join( ',' )->scalar if( $elem );
73 0         0 $self->items->foreach( $code );
74 0 0       0 if( $elem )
75             {
76 0         0 my $after = $self->items->join( ',' )->scalar;
77 0 0       0 $elem->_reset(1) if( $before ne $after );
78             }
79 0         0 return( $self );
80             }
81              
82 0     0 1 0 sub item { return( shift->items->index( shift( @_ ) ) ); }
83              
84             sub items
85             {
86 5     5 1 7 my $self = shift( @_ );
87 5 50       18 if( @_ )
88             {
89 0         0 my $ref = $self->_set_get_array_as_object( 'items', @_ );
90 0         0 $self->_reset;
91 0         0 return( $ref );
92             }
93             else
94             {
95             # Check if the value has changed on the element so we keep in sync
96 5         10 my $attr = $self->attribute;
97 5         4497 my $elem = $self->element;
98 5 50 33     95 if( $attr && $elem )
99             {
100 5         70 my $elem_tokens = $elem->attr( $attr );
101 5 50       3176 if( $elem_tokens eq $self->tokens )
102             {
103 5         4517 return( $self->_set_get_array_as_object( 'items' ) );
104             }
105             # Element attribute value takes precedence over us
106             else
107             {
108 0         0 return( $self->{items} = $self->_string2array( $elem_tokens ) );
109             }
110             }
111 0         0 return( $self->_set_get_array_as_object( 'items' ) );
112             }
113             }
114              
115 0     0 1 0 sub keys { return; }
116              
117             # Property
118 0     0 1 0 sub length { return( shift->items->length ); }
119              
120 0     0 1 0 sub remove { return( shift->items->remove( _trim( @_ )->_reset ) ); }
121              
122             sub replace
123             {
124 0     0 1 0 my $self = shift( @_ );
125 0 0       0 my $ok = $self->items->replace( @_ ) ? $self->true : $self->false;
126 0         0 $self->items->unique(1);
127             # Reset the associated element cache, if any.
128 0         0 $self->_reset;
129 0         0 return( $ok );
130             }
131              
132             sub reset
133             {
134 0     0 1 0 my $self = shift( @_ );
135 0         0 $self->items->reset;
136 0         0 $self->tokens->reset;
137 0         0 $self->_reset;
138 0         0 return( $self );
139             }
140              
141 0     0 1 0 sub supports { return( shift->true ); }
142              
143             sub toggle
144             {
145 0     0 1 0 my $self = shift( @_ );
146 0   0     0 my $token = shift( @_ ) || return( $self->error( "No token was provided to toggle." ) );
147 0         0 $token = _trim( $token );
148 0         0 my $rv;
149 0 0       0 if( $self->items->has( $token ) )
150             {
151 0 0       0 $rv = $self->items->remove( $token ) ? $self->true : $self->false;
152             }
153             else
154             {
155 0         0 $self->items->push( $token );
156 0         0 $rv = $self->true;
157             }
158 0         0 $self->_reset;
159 0         0 return( $rv );
160             }
161              
162 8     8 1 113 sub tokens { return( shift->_set_get_scalar_as_object( 'tokens', @_ ) ); }
163              
164             sub update
165             {
166 2     2 1 4 my $self = shift( @_ );
167 2 50       5 if( scalar( @_ ) )
168             {
169 2 50 33     11 if( scalar( @_ ) == 1 && !defined( $_[0] ) )
170             {
171 0         0 $self->tokens->reset;
172 0         0 $self->items->reset;
173             }
174             else
175             {
176 2         5 my $items = $self->_string2array( @_ );
177 2         82 $self->tokens( $items->join( ' ' )->scalar );
178 2         2049 $self->{items} = $items;
179             }
180             }
181 2         67 return( $self );
182             }
183              
184             # Property
185 0     0 1 0 sub value { return( shift->as_string ); }
186              
187 0     0 1 0 sub values { return; }
188              
189             sub _reset
190             {
191 1     1   3 my $self = shift( @_ );
192 1         4 my $elem = $self->element;
193 1         20 my $tokens = $self->as_string;
194 1         649 $self->tokens( $tokens );
195 1 50       971 return( $self ) if( !ref( $elem ) );
196 1   50     4 my $attr = $self->attribute || return( $self );
197 1         934 $elem->attr( $attr => $tokens );
198 1         3 $elem->reset(1);
199 1         2 return( $self );
200             }
201              
202             sub _string2array
203             {
204 4     4   6 my $self = shift( @_ );
205 4         8 my @tokens = ();
206 4         8 for( @_ )
207             {
208 4 50       23 if( $self->_is_array( $_ ) )
209             {
210 0         0 push( @tokens, @$_ );
211             }
212             # space-delimited tokens
213             else
214             {
215 4         45 push( @tokens, split( /[[:blank:]\h]+/, _trim( @_ ) ) );
216             }
217             }
218 4         17 return( $self->new_array( \@tokens )->unique(1) );
219             }
220              
221             sub _trim
222             {
223 6     6   1223 my $str = shift( @_ );
224 6         36 $str =~ s/^[[:blank:]\h]+|[[:blank:]\h]+$//g;
225 6         21 $str =~ s/[[:blank:]\h]+/ /g;
226 6         29 return( $str );
227             }
228              
229             1;
230             # NOTE: POD
231             __END__
232              
233             =encoding utf-8
234              
235             =head1 NAME
236              
237             HTML::Object::TokenList - HTML Object Token List Class
238              
239             =head1 SYNOPSIS
240              
241             use HTML::Object::TokenList;
242             # standalone, i.e. without connection to an element
243             my $list = HTML::Object::TokenList->new( 'some class to edit' ) ||
244             die( HTML::Object::TokenList->error, "\n" );
245              
246             Or
247              
248             use HTML::Object::Element;
249             my $e = HTML::Object::Element->new( tag => 'div' );
250             my $list = $e->classList;
251              
252             $list->add( 'another-class' );
253             $list->remove( 'edit' );
254             $list->length;
255             $list->value;
256             $list->as_string;
257             $list->contains( 'some' );
258             $list->forEach(sub
259             {
260             my $c = shift( @_ ); # also available as $_
261             # do something
262             });
263             $list->item(3); # 'edit'
264             $list->replace( 'to' = 'other' );
265             $list->toggle( 'visible' ); # activate it
266             $list->toggle( 'visible' ); # now remove it
267              
268             =head1 VERSION
269              
270             v0.2.0
271              
272             =head1 DESCRIPTION
273              
274             The C<TokenList> interface represents a set of space-separated tokens. Such a set is returned by L<HTML::Object::DOM::Element/classList> or L<HTML::Object::DOM::AnchorElement/relList>.
275              
276             A C<TokenList> is indexed beginning with 0 as with perl array. C<TokenList> is always case-sensitive.
277              
278             This module can be used independently or be instantiated by an L<element|HTML::Object::DOM::Element>, and in which case, any modification made will be reflected in the associated element's attribute.
279              
280             =head1 PROPERTIES
281              
282             =head2 length
283              
284             Read-only. This returns an L<integer|Module::Generic::Number> representing the number of objects stored in the object.
285              
286             =head2 value
287              
288             A stringifier property that returns the value of the list as a string. See also L</as_string>
289              
290             =head1 METHODS
291              
292             =head2 add
293              
294             Adds the specified tokens to the list. Returns the current object for chaining.
295              
296             The tokens can be provided either as a list of string, an array reference of strings, or a space-delimited string of tokens.
297              
298             =head2 as_string
299              
300             A stringifier property that returns the value of the list as a string. See also L</value>
301              
302             =head2 attribute
303              
304             Set or get the element attribute to which C<TokenList> is bound. For example a C<class> attribute or a C<rel> attribute
305              
306             This is optional if you want to use this class independently from any element, or if you want to set the element later.
307              
308             =head2 contains
309              
310             Returns true if the list contains the given token, otherwise false.
311              
312             =head2 element
313              
314             Set or get the L<element|HTML::Object::Element>
315              
316             This is optional if you want to use this class independently from any element, or if you want to set the element later.
317              
318             =head2 entries
319              
320             This does nothing.
321              
322             Normally, under JavaScript, this would return an iterator, allowing you to go through all key/value pairs contained in this object.
323              
324             =head2 forEach
325              
326             Executes a provided callback function once for each DOMTokenList element.
327              
328             =head2 item
329              
330             Returns the item in the list by its index, or undefined if the index is greater than or equal to the list's length.
331              
332             =head2 items
333              
334             Sets or gets the list of token items. It returns the L<array object|Module::Generic::Array> containing all the tokens.
335              
336             =head2 keys
337              
338             This does nothing.
339              
340             Normally, under JavaScript, this would return an iterator, allowing you to go through all keys of the key/value pairs contained in this object.
341              
342             =head2 remove
343              
344             Removes the specified tokens from the list.
345              
346             =head2 replace
347              
348             Replaces the token with another one.
349              
350             It returns a boolean value, which is true if the old entry was successfully replaced, or false if not.
351              
352             See the L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/DOMTokenList/replace> for more information.
353              
354             =head2 reset
355              
356             Reset the tokens list to an empty list and, of course, propagate that change to the associated element's attribute, if any was set.
357              
358             Returns the current object.
359              
360             =head2 supports
361              
362             Returns true if the given token is in the associated attribute's supported tokens.
363              
364             For the purpose of the perl environment, this actually always returns true.
365              
366             =head2 toggle
367              
368             Removes the token from the list if it exists, or adds it to the list if it does not. Returns a boolean indicating whether the token is in the list after the operation.
369              
370             =head2 tokens
371              
372             Sets or get the L<array object|Module::Generic::Array> of tokens.
373              
374             =head2 update
375              
376             This method is called by an internal callback in L<HTML::Object::Element> when the value of an registered attribute has been changed. It does not propagate the change back to the element since it is triggered by the element itself.
377              
378             If C<undef> is provided as its sole argument, this will empty the tokens list, otherwise it will set the new tokens list with a space-delimited string of tokens, a list or array reference of tokens.
379              
380             Returns the current object.
381              
382             =head2 values
383              
384             This does nothing.
385              
386             Normally, under JavaScript, this would return an iterator, allowing you to go through all values of the key/value pairs contained in this object.
387              
388             =head1 EXAMPLES
389              
390             In the following simple example, we retrieve the list of classes set on a <p> element as a L<HTML::Object::TokenList> using L<HTML::Object::Element/classList>, add a class using L<HTML::Object::TokenList/add>, and then update the C<textContent> of the <p> to equal the L<HTML::Object::TokenList>.
391              
392             <p class="a b c"></p>
393              
394             my $para = $doc->querySelector("p");
395             my $classes = $para->classList;
396             $para->classList->add("d");
397             $para->textContent = qq{paragraph classList is "${classes}"};
398              
399             would yield:
400              
401             paragraph classList is "a b c d"
402              
403             =head1 WHITESPACE AND DUPLICATES
404              
405             Methods that modify the TokenList (such as L<HTML::Object::TokenList/add>) automatically trim any excess whitespace and remove duplicate values from the list. For example:
406              
407             <span class=" d d e f"></span>
408              
409             my $span = $doc->querySelector("span");
410             my $classes = $span->classList;
411             $span->classList->add("x");
412             $span->textContent = qq{span classList is "${classes}"};
413              
414             would yield:
415              
416             span classList is "d e f x"
417              
418             =head1 AUTHOR
419              
420             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
421              
422             =head1 SEE ALSO
423              
424             L<HTML::Object::Element>
425              
426             L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/DOMTokenList>
427              
428             =head1 COPYRIGHT & LICENSE
429              
430             Copyright(c) 2021 DEGUEST Pte. Ltd.
431              
432             All rights reserved
433              
434             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
435              
436             =cut