File Coverage

lib/HTML/Object/DOM/Collection.pm
Criterion Covered Total %
statement 51 61 83.6
branch 7 22 31.8
condition 4 6 66.6
subroutine 17 21 80.9
pod 2 2 100.0
total 81 112 72.3


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/DOM/Collection.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/24
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::DOM::Collection;
15             BEGIN
16             {
17 5     5   5865 use strict;
  5         14  
  5         171  
18 5     5   27 use warnings;
  5         17  
  5         196  
19 5     5   29 use parent qw( Module::Generic::Array );
  5         17  
  5         35  
20 5     5   400 use vars qw( $AUTOLOAD $VERSION );
  5         13  
  5         307  
21 5     5   37 use Module::Generic::Null;
  5         8  
  5         153  
22 5     5   28 use Scalar::Util ();
  5         11  
  5         116  
23 5     5   26 use Want;
  5         12  
  5         1006  
24             use overload (
25 1     1   364 'eq' => sub{ Scalar::Util::refaddr( $_[0] ) eq Scalar::Util::refaddr( $_[1] ) },
26 0     0   0 '==' => sub{ Scalar::Util::refaddr( $_[0] ) eq Scalar::Util::refaddr( $_[1] ) },
27 952     952   3572 bool => sub{ $_[0] },
28 5         80 fallback => 1,
29 5     5   49 );
  5         12  
30 5     5   684 our $AUTOLOAD;
31 5         148 our $VERSION = 'v0.2.0';
32             };
33              
34 5     5   30 use strict;
  5         22  
  5         152  
35 5     5   27 use warnings;
  5         16  
  5         1450  
36              
37 0     0 1 0 sub item { return( shift->index( @_ ) ); }
38              
39             sub namedItem
40             {
41 2     2 1 7 my $self = shift( @_ );
42 2         8 my $name = shift( @_ );
43 2         8 for( @$self )
44             {
45 4 100 66     744 return( $_ ) if( $self->_can( $_ => 'id' ) && $_->id eq $name );
46 2 50 66     86 return( $_ ) if( $self->_can( $_ => 'name' ) && $_->name eq $name );
47             }
48 0 0       0 if( Want::want( 'OBJECT' ) )
    0          
    0          
    0          
    0          
49             {
50 0         0 return( Module::Generic::Null->new( @_ ) );
51             }
52             elsif( Want::want( 'ARRAY' ) )
53             {
54 0         0 return( [] );
55             }
56             elsif( Want::want( 'HASH' ) )
57             {
58 0         0 return( {} );
59             }
60             elsif( Want::want( 'CODE' ) )
61             {
62 0     0   0 return( sub{ return; } );
  0         0  
63             }
64             elsif( Want::want( 'REFSCALAR' ) )
65             {
66 0         0 return( \undef );
67             }
68             else
69             {
70 0         0 return;
71             }
72             }
73              
74             sub _can
75             {
76 6     6   40 my $self = shift( @_ );
77 5     5   43 no overloading;
  5         14  
  5         1250  
78             # Nothing provided
79 6 50       14 return if( !scalar( @_ ) );
80 6 50       17 return if( !defined( $_[0] ) );
81 6 50       26 return if( !Scalar::Util::blessed( $_[0] ) );
82 6         81 return( $_[0]->can( $_[1] ) );
83             }
84              
85             # NOTE: AUTOLOAD
86             sub AUTOLOAD
87             {
88 1     1   38883 my( $meth ) = our $AUTOLOAD =~ /([^:]+)$/;
89 1         3 my $self = shift( @_ );
90 1 50       6 die( "No class function \"$meth\" exists in this package \"", __PACKAGE__, "\".\n" ) if( !defined( $self ) );
91 1         6 return( $self->namedItem( $meth ) );
92             };
93              
94             # To avoid being caught by AUTOLOAD
95       0     sub DESTROY {};
96              
97             1;
98             # NOTE: POD
99             __END__
100              
101             =encoding utf-8
102              
103             =head1 NAME
104              
105             HTML::Object::DOM::Collection - HTML Object DOM Collection
106              
107             =head1 SYNOPSIS
108              
109             use HTML::Object::DOM::Collection;
110             my $this = HTML::Object::DOM::Collection->new || die( HTML::Object::DOM::Collection->error, "\n" );
111              
112             my $html = <<EOT;
113             <html>
114             <head><title>Demo</title></head>
115             <body>
116             <form id="myForm">
117             <input type="text" />
118             <button>Ok</button>
119             </form>
120             </body>
121             </html>
122             EOT
123              
124             my( $elem1, $elem2 );
125             my $p = HTML::Object::DOM->new;
126             my $doc = $p->parse_data( $html );
127             # $doc->forms is an HTML::Object::DOM::Collection
128              
129             $elem1 = $doc->forms->[0];
130             $elem2 = $doc->forms->item(0);
131              
132             say( $elem1 == $elem2 ); # returns: "1" (i.e. true)
133             # or, similarly
134             say( $elem1 eq $elem2 ); # returns: "1" (i.e. true)
135              
136             $elem1 = $doc->forms->myForm;
137             $elem2 = $doc->forms->namedItem("myForm");
138              
139             say( $elem1 == $elem2 ); # returns: "1" (i.e. true)
140             # or, similarly
141             say( $elem1 eq $elem2 ); # returns: "1" (i.e. true)
142              
143             # This is possible under JavaScript, but not possible under perl
144             # $elem1 = $doc->forms->[ 'named.item.with.periods' ];
145              
146             =head1 VERSION
147              
148             v0.2.0
149              
150             =head1 DESCRIPTION
151              
152             The C<Collection> interface represents a generic collection (array-like object inheriting from L<Module::Generic::Array>) of a list of elements (in document order) and offers methods and properties for selecting from that list.
153              
154             This is fundamentally different from L<HTML::Object::Collection>, which is used by L<HTML::Object::XQuery>
155              
156             =head1 PROPERTIES
157              
158             =head2 length
159              
160             Returns the number of items in the collection.
161              
162             =head1 METHODS
163              
164             =head2 item
165              
166             Provided with an integer representing an C<index> and this returns the specific L<node|HTML::Object::DOM::Node> at the given zero-based C<index> into the list. Returns C<undef> if the index is out of range.
167              
168             This is also an alternative to accessing C<$collection->[$i]> (which instead returns C<undef> when C<$i> is out-of-bounds).
169              
170             Example:
171              
172             my $c = $doc->images; # This is an HTMLCollection
173             my $img0 = $c->item(0); # You can use the item() method this way
174             my $img1 = $c->[1]; # But this notation is easier and more common
175              
176             See L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/HTMLCollection/item>
177              
178             =head2 namedItem
179              
180             Provided with a C<name> and this returns the specific L<node|HTML::Object::DOM::Node> whose C<ID> or, as a fallback, C<name> matches the string specified by C<name>. Matching by C<name> is only done as a last resort, only in HTML, and only if the referenced element supports the C<name> attribute. Returns C<undef> if no L<node|HTML::Object::DOM::Node> exists by the given C<name>.
181              
182             An alternative to accessing C<$collection->[ $name ]> (which is possible in JavaScript, but not under perl).
183              
184             Example:
185              
186             <div id="personal">
187             <span name="title">Dr.</span>
188             <span name="firstname">John</span>
189             <span name="lastname">Doe</span>
190             </div>
191              
192             my $container = $doc->getElementById('personal');
193             # Returns the span element object with the name "title" if no such element exists undef is returned
194             my $titleSpan = $container->children->namedItem('title');
195             # The following variants return undefined instead of null if there's no element with a matching name or id
196             # Not possible in perl!
197             # my $firstnameSpan = $container->children->['firstname'];
198             my $firstnameSpan = $container->children->[1];
199             my $lastnameSpan = $container->children->lastname;
200              
201             See L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/HTMLCollection/namedItem>
202              
203             =head1 AUTHOR
204              
205             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
206              
207             =head1 SEE ALSO
208              
209             L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/API/HTMLCollection>, L<HTML::Object::Collection>
210              
211             =head1 COPYRIGHT & LICENSE
212              
213             Copyright(c) 2021 DEGUEST Pte. Ltd.
214              
215             All rights reserved
216              
217             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
218              
219             =cut