File Coverage

blib/lib/HTML/DOM/NodeList/Magic.pm
Criterion Covered Total %
statement 36 48 75.0
branch 4 10 40.0
condition 6 6 100.0
subroutine 14 17 82.3
pod 0 5 0.0
total 60 86 69.7


line stmt bran cond sub pod time code
1             package HTML::DOM::NodeList::Magic;
2              
3 25     25   928 use strict;
  25         42  
  25         631  
4 25     25   104 use warnings;
  25         44  
  25         764  
5 25     25   101 use overload fallback => 1, '@{}' => \&_get_tie;
  25         42  
  25         141  
6              
7 25     25   1469 use Scalar::Util 'weaken';
  25         43  
  25         12994  
8              
9             our $VERSION = '0.058';
10              
11             # Innards: {
12             # get => sub { ... }, # sub that gets the list
13             # list => [ ... ], # the list, or undef
14             # tie => \@tied_array, # or undef, if the array has not been
15             # # accessed yet
16             # }
17              
18              
19             # new NodeList sub { ... }
20             # new NodeList sub { ... }, $doc
21             # The sub needs to return the list of nodes.
22              
23             sub new {
24 219     219 0 1299 my $self = bless {get => $_[1]}, shift;
25 219   100     924 ($_[1]||return $self)->_register_magic_node_list($self);
26 1         9 $self;
27             }
28              
29             sub item {
30 506     506 0 594 my $self = shift;
31             # Oh boy! Look at these brackets!
32 506   100     504 ${$$self{list} ||= [&{$$self{get}}]}[$_[0]];
  506         1686  
  76         172  
33             }
34              
35             sub length {
36 183     183 0 241 my $self = shift;
37             # Oh no, here we go again.
38 183   100     205 scalar @{$$self{list} ||= [&{$$self{get}}]};
  183         607  
  106         224  
39             }
40              
41             sub _you_are_stale {
42 191     191   439 delete $_[0]{list};
43             }
44              
45             sub DOES {
46 3 50   3 0 466 return !0 if $_[1] eq 'HTML::DOM::NodeList';
47 0 0       0 eval { shift->SUPER::DOES(@_) } || !1
  0         0  
48             }
49              
50             # ---------- TIES --------- #
51              
52             sub _get_tie {
53 158     158   1274 my $self = shift;
54             $$self{tie} or
55 98         377 weaken(tie @{ $$self{tie} }, __PACKAGE__, $self),
56 158 100       525 $$self{tie};
57             }
58              
59 98     98   614 sub TIEARRAY { $_[1] }
60 289     289   846 sub FETCH { $_[0]->item($_[1]) }
61 94     94   1296 sub FETCHSIZE { $_[0]->length }
62 0     0   0 sub EXISTS { $_[0]->item($_[1]) } # nodes are true, undef is false
63 0     0 0 0 sub DDS_freeze { my $self = shift; delete $$self{tie}; $self }
  0         0  
  0         0  
64              
65             # These are here solely to make HTML::DOM::Collection::Options work:
66             sub STORE {
67 1     1   4 my($self,$indx,$val) = @_;
68 1 50       4 if(defined $val) {
69 0 0       0 if(my $deletee = $self->item($indx)) {
70 0         0 $deletee->replace_with($val)->delete;
71             }
72             else {
73 0         0 $self->item($self->length-1)->parentElement
74             ->appendChild($val);
75             }
76             }
77             else {
78 1         3 (my $thing = $self->item($indx))->ownerDocument;
79 1         4 $self->item($indx)->detach
80             }
81 1         3 $self->_you_are_stale;
82             }
83             sub DELETE {
84 0     0     for(shift) {
85 0           $_->item(shift)->detach;
86 0           $_->_you_are_stale;
87             }
88             }
89              
90             1;
91              
92             __END__