File Coverage

blib/lib/XML/LibXML/NodeList/Iterator.pm
Criterion Covered Total %
statement 75 98 76.5
branch 18 34 52.9
condition 2 9 22.2
subroutine 14 21 66.6
pod 13 13 100.0
total 122 175 69.7


line stmt bran cond sub pod time code
1             # $Id: Iterator.pm,v 1.1.1.1 2002/11/08 17:18:36 phish Exp $
2             #
3             package XML::LibXML::NodeList::Iterator;
4             $XML::LibXML::NodeList::Iterator::VERSION = '1.05';
5 2     2   68988 use strict;
  2         14  
  2         66  
6 2     2   486 use XML::NodeFilter qw(:results);
  2         1805  
  2         238  
7              
8 2     2   15 use vars qw($VERSION);
  2         4  
  2         245  
9             $VERSION = "1.03";
10              
11             use overload
12 0     0   0 '++' => sub { $_[0]->nextNode(); $_[0]; },
  0         0  
13 0     0   0 '--' => sub { $_[0]->previousNode(); $_[0] },
  0         0  
14 0 0   0   0 '<>' => sub { return wantarray ? $_[0]->_get_all : $_[0]->nextNode(); },
15 2     2   23 ;
  2         4  
  2         51  
16              
17             sub new
18             {
19 9     9 1 2998 my $class = shift;
20 9         15 my $list = shift;
21 9         16 my $self = undef;
22 9 50       20 if ( defined $list )
23             {
24 9         29 $self = bless [ $list, -1, [], ], $class;
25             }
26              
27 9         21 return $self;
28             }
29              
30             sub set_filter
31             {
32 0     0 1 0 my $self = shift;
33 0         0 $self->[2] = [@_];
34             }
35              
36             sub add_filter
37             {
38 1     1 1 48 my $self = shift;
39 1         2 push @{ $self->[2] }, @_;
  1         5  
40             }
41              
42             # helper function.
43             sub accept_node
44             {
45 29     29 1 46 foreach ( @{ $_[0][2] } )
  29         63  
46             {
47 1         4 my $r = $_->accept_node( $_[1] );
48 1 50       11 return $r if $r;
49             }
50              
51             # no filters or all decline ...
52 29         65 return FILTER_ACCEPT;
53             }
54              
55             sub first
56             {
57 2     2 1 23 $_[0][1] = 0;
58 2         3 my $s = scalar( @{ $_[0][0] } );
  2         4  
59 2         7 while ( $_[0][1] < $s )
60             {
61 2 50       7 last if $_[0]->accept_node( $_[0][0][ $_[0][1] ] ) == FILTER_ACCEPT;
62 0         0 $_[0][1]++;
63             }
64 2 50       6 return undef if $_[0][1] == $s;
65 2         5 return $_[0][0][ $_[0][1] ];
66             }
67              
68             sub last
69             {
70 3     3 1 14 my $i = scalar( @{ $_[0][0] } ) - 1;
  3         7  
71 3         10 while ( $i >= 0 )
72             {
73 3 50       9 if ( $_[0]->accept_node( $_[0][0][$i] ) == FILTER_ACCEPT )
74             {
75 3         7 $_[0][1] = $i;
76 3         5 last;
77             }
78 0         0 $i--;
79             }
80              
81 3 50       40 if ( $i < 0 )
82             {
83             # this costs a lot, but is more safe
84 0         0 return $_[0]->first;
85             }
86 3         10 return $_[0][0][$i];
87             }
88              
89             sub current
90             {
91 14 50 33 14 1 76 if ( $_[0][1] >= 0 || $_[0][1] < scalar @{ $_[0][0] } )
  0         0  
92             {
93 14         57 return $_[0][0][ $_[0][1] ];
94             }
95 0         0 return undef;
96             }
97              
98             sub index
99             {
100 0 0 0 0 1 0 if ( $_[0][1] >= 0 || $_[0][1] < scalar @{ $_[0][0] } )
  0         0  
101             {
102 0         0 return $_[0][1];
103             }
104 0         0 return undef;
105             }
106              
107 9     9 1 56 sub next { return $_[0]->nextNode(); }
108 0     0 1 0 sub previous { return $_[0]->previousNode(); }
109              
110             sub nextNode
111             {
112 23     23 1 88 my $nlen = scalar @{ $_[0][0] };
  23         88  
113 23 100       52 if ( $nlen <= ( $_[0][1] + 1 ) )
114             {
115 5         14 return undef;
116             }
117 18         27 my $i = $_[0][1];
118 18 100       38 $i = -1 if $i < 0; # assure that we end up with the first
119             # element in the first iteration
120 18         22 while (1)
121             {
122 18         27 $i++;
123 18 50       30 return undef if $i >= $nlen;
124 18 50       38 if ( $_[0]->accept_node( $_[0][0]->[$i] ) == FILTER_ACCEPT )
125             {
126 18         31 $_[0][1] = $i;
127 18         25 last;
128             }
129             }
130 18         45 return $_[0][0]->[ $_[0][1] ];
131             }
132              
133             sub previousNode
134             {
135 8 100   8 1 50 if ( $_[0][1] <= 0 )
136             {
137 2         4 return undef;
138             }
139 6         9 my $i = $_[0][1];
140 6         10 while (1)
141             {
142 6         8 $i--;
143 6 50       12 return undef if $i < 0;
144 6 50       11 if ( $_[0]->accept_node( $_[0][0]->[$i] ) == FILTER_ACCEPT )
145             {
146 6         8 $_[0][1] = $i;
147 6         10 last;
148             }
149             }
150 6         13 return $_[0][0][ $_[0][1] ];
151             }
152              
153             sub iterate
154             {
155 2     2 1 21 my $self = shift;
156 2         4 my $funcref = shift;
157 2         3 my $rv;
158              
159 2 50 33     14 return unless defined $funcref && ref($funcref) eq 'CODE';
160              
161 2         5 $self->[1] = -1; # first element
162 2         6 while ( my $node = $self->next )
163             {
164 6         54 $rv = $funcref->( $self, $node );
165             }
166 2         5 return $rv;
167             }
168              
169             # helper function for the <> operator
170             # returns all nodes that have not yet been accessed
171             sub _get_all
172             {
173 0     0     my $self = shift;
174 0           my @retval = ();
175 0           my $node;
176 0           while ( $node = $self->next() )
177             {
178 0           push @retval, $node;
179             }
180 0           return @retval;
181             }
182              
183             1;
184              
185             __END__