File Coverage

blib/lib/HTML/DOM/Collection.pm
Criterion Covered Total %
statement 58 62 93.5
branch 15 18 83.3
condition 8 9 88.8
subroutine 18 19 94.7
pod 3 5 60.0
total 102 113 90.2


line stmt bran cond sub pod time code
1             package HTML::DOM::Collection;
2              
3 26     26   51180 use strict;
  26         51  
  26         617  
4 26     26   101 use warnings;
  26         42  
  26         763  
5              
6 26     26   122 use Scalar::Util 'weaken';
  26         39  
  26         2419  
7              
8             our $VERSION = '0.058';
9              
10             # Internals: \[$nodelist, $tie]
11              
12             # Field constants:
13             sub nodelist(){0}
14             sub tye(){1}
15             sub seen(){2} # whether this key has been seen
16             sub position(){3} # current (array) position used by NEXTKEY
17             sub ids(){4} # whether we are iterating through ids
18             # Number 5 is taken by ::Options (inside Element/Form.pm).
19 26     26   127 { no warnings 'misc';
  26         54  
  26         2906  
20             undef &nodelist; undef &tye; undef &seen; undef &position;
21             }
22              
23             use overload fallback => 1,
24             '%{}' => sub {
25 39     39   56 my $self = shift;
26             $$$self[tye] or
27 39 100       184 weaken(tie %{ $$$self[tye] }, __PACKAGE__, $self),
  9         45  
28             $$$self[tye];
29             },
30 26     26   1064 '@{}' => sub { ${+shift}->[nodelist] };
  26     106   866  
  26         210  
  106         643  
  106         381  
31              
32              
33             sub new {
34 180     180 0 422 bless \[$_[1]], shift;
35             }
36              
37             my %NameableElements = map +($_ => 1), qw/
38             a area object param applet input select textarea button frame
39             iframe meta form img map
40             /;
41              
42             sub namedItem {
43 25     25 1 6989 my($self, $name) = @_;
44 25         46 my $list = $$self->[nodelist];
45 25         31 my $named_elem; my $elem;
46 25         61 for(0..$list->length - 1) {
47 26     26   3985 no warnings 'uninitialized';
  26         45  
  26         13137  
48 253 100       1285 ($elem = $list->item($_))->id eq $name and return $elem;
49 251 100 66     825 exists $NameableElements{$elem->tag} and
50             $elem->attr('name') eq $name and
51             $named_elem = $elem;
52             }
53             $named_elem ||()
54 23 100       214 }
55              
56             # Delegated methosd
57             for (qw/length item/) {
58 74     74 1 649 eval "sub $_ { \${+shift}->[" . nodelist . "]->$_(\@_) }"
  74     57 1 215  
  57         940  
  57         199  
59             }
60              
61              
62 9     9   85 sub TIEHASH { $_[1] }
63 34     34   160 sub FETCH { $_[0]->namedItem($_[1]) }
64 2     2   5 sub EXISTS { $_[0]->namedItem($_[1]) } # nodes are true, undef is false
65             sub FIRSTKEY {
66 3     3   4 my $self = shift;
67 3         8 (my $guts = $$self)->[seen] = {};
68 3         4 my($id,$item);
69 3         5 $guts->[ids] = 1;
70 3         68 for (0..$self->length - 1) {
71             defined($id = ($item = $self->item($_))->id)
72 2 50       30 and ++$guts->[seen]{$id}, $guts->[position] = $_,
73             return($id);
74             }
75             # If none of the items has an id...
76 1         2 $guts->[ids] = 0;
77 1         15 for (0..$self->length - 1) {
78             defined($id = ($item = $self->item($_))->attr('name'))
79 0 0       0 and ++$guts->[seen]{$id}, $guts->[position] = $_,
80             return($id);
81             }
82 1         4 return; # empty list
83             }
84              
85             sub NEXTKEY{
86 8     8   75 my $self = shift;
87 8         9 my $guts = $$self;
88 8         9 my($id,$item);
89 8 100       16 if($guts->[ids]) {
90 6         84 for ($guts->[position]..$self->length - 1) {
91             defined($id = ($item = $self->item($_))->id)
92 13 100 100     218 and !$guts->[seen]{$id}++
93             and $guts->[position] = $_,
94             return($id);
95             }
96             }
97             # If we've exhausted all ids...
98 3         8 $guts->[ids] = 0;
99 3         43 for (0..$self->length - 1) {
100             defined($id = ($item = $self->item($_))->attr('name'))
101 16 100 100     292 and !$guts->[seen]{$id}++
102             and $guts->[position] = $_,
103             return($id);
104             }
105 1         11 return;
106             }
107              
108             sub SCALAR {
109 2     2   5 defined FIRSTKEY @_;
110             }
111              
112 0     0 0   sub DDS_freeze { my $self = shift; delete $$$self[tye]; $self }
  0            
  0            
113              
114             1
115              
116             __END__