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   690 use strict;
  25         26  
  25         623  
4 25     25   71 use warnings;
  25         23  
  25         683  
5 25     25   75 use overload fallback => 1, '@{}' => \&_get_tie;
  25         27  
  25         128  
6              
7 25     25   1157 use Scalar::Util 'weaken';
  25         26  
  25         9441  
8              
9             our $VERSION = '0.056';
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 218     218 0 712 my $self = bless {get => $_[1]}, shift;
25 218   100     817 ($_[1]||return $self)->_register_magic_node_list($self);
26 1         2 $self;
27             }
28              
29             sub item {
30 505     505 0 387 my $self = shift;
31             # Oh boy! Look at these brackets!
32 505   100     308 ${$$self{list} ||= [&{$$self{get}}]}[$_[0]];
  505         1653  
  75         179  
33             }
34              
35             sub length {
36 183     183 0 158 my $self = shift;
37             # Oh no, here we go again.
38 183   100     136 scalar @{$$self{list} ||= [&{$$self{get}}]};
  183         574  
  106         204  
39             }
40              
41             sub _you_are_stale {
42 191     191   414 delete $_[0]{list};
43             }
44              
45             sub DOES {
46 3 50   3 0 201 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 157     157   967 my $self = shift;
54             $$self{tie} or
55 97         331 weaken(tie @{ $$self{tie} }, __PACKAGE__, $self),
56 157 100       466 $$self{tie};
57             }
58              
59 97     97   610 sub TIEARRAY { $_[1] }
60 288     288   635 sub FETCH { $_[0]->item($_[1]) }
61 94     94   2128 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   1 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         2 (my $thing = $self->item($indx))->ownerDocument;
79 1         1 $self->item($indx)->detach
80             }
81 1         2 $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__