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
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
598
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
6
|
1
|
|
|
1
|
|
6
|
use XML::NodeFilter qw(:results); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
120
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
149
|
|
9
|
|
|
|
|
|
|
$VERSION = "1.03"; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use overload |
12
|
0
|
|
|
0
|
|
|
'++' => sub { $_[0]->nextNode(); $_[0]; }, |
|
0
|
|
|
|
|
|
|
13
|
0
|
|
|
0
|
|
|
'--' => sub { $_[0]->previousNode(); $_[0] }, |
|
0
|
|
|
|
|
|
|
14
|
0
|
0
|
|
0
|
|
|
'<>' => sub {return wantarray ? $_[0]->_get_all : $_[0]->nextNode(); }, |
15
|
1
|
|
|
1
|
|
5
|
; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
16
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
19
|
0
|
|
|
|
|
|
my $list = shift; |
20
|
0
|
|
|
|
|
|
my $self = undef; |
21
|
0
|
0
|
|
|
|
|
if ( defined $list ) { |
22
|
0
|
|
|
|
|
|
$self = bless [ |
23
|
|
|
|
|
|
|
$list, |
24
|
|
|
|
|
|
|
-1, |
25
|
|
|
|
|
|
|
[], |
26
|
|
|
|
|
|
|
], $class; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
return $self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub set_filter { |
33
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
34
|
0
|
|
|
|
|
|
$self->[2] = [ @_ ]; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub add_filter { |
38
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
39
|
0
|
|
|
|
|
|
push @{$self->[2]}, @_; |
|
0
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# helper function. |
43
|
|
|
|
|
|
|
sub accept_node { |
44
|
0
|
|
|
0
|
0
|
|
foreach ( @{$_[0][2]} ) { |
|
0
|
|
|
|
|
|
|
45
|
0
|
|
|
|
|
|
my $r = $_->accept_node($_[1]); |
46
|
0
|
0
|
|
|
|
|
return $r if $r; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
# no filters or all decline ... |
49
|
0
|
|
|
|
|
|
return FILTER_ACCEPT; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub first { |
53
|
0
|
|
|
0
|
0
|
|
$_[0][1]=0; |
54
|
0
|
|
|
|
|
|
my $s = scalar(@{$_[0][0]}); |
|
0
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
|
while ( $_[0][1] < $s ) { |
56
|
0
|
0
|
|
|
|
|
last if $_[0]->accept_node($_[0][0][$_[0][1]]) == FILTER_ACCEPT; |
57
|
0
|
|
|
|
|
|
$_[0][1]++; |
58
|
|
|
|
|
|
|
} |
59
|
0
|
0
|
|
|
|
|
return undef if $_[0][1] == $s; |
60
|
0
|
|
|
|
|
|
return $_[0][0][$_[0][1]]; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub last { |
64
|
0
|
|
|
0
|
0
|
|
my $i = scalar(@{$_[0][0]})-1; |
|
0
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
while($i >= 0){ |
66
|
0
|
0
|
|
|
|
|
if ( $_[0]->accept_node($_[0][0][$i]) == FILTER_ACCEPT ) { |
67
|
0
|
|
|
|
|
|
$_[0][1] = $i; |
68
|
0
|
|
|
|
|
|
last; |
69
|
|
|
|
|
|
|
} |
70
|
0
|
|
|
|
|
|
$i--; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
0
|
0
|
|
|
|
|
if ( $i < 0 ) { |
74
|
|
|
|
|
|
|
# this costs a lot, but is more safe |
75
|
0
|
|
|
|
|
|
return $_[0]->first; |
76
|
|
|
|
|
|
|
} |
77
|
0
|
|
|
|
|
|
return $_[0][0][$i]; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub current { |
81
|
0
|
0
|
0
|
0
|
0
|
|
if ( $_[0][1] >= 0 || $_[0][1] < scalar @{$_[0][0]} ) { |
|
0
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
return $_[0][0][$_[0][1]]; |
83
|
|
|
|
|
|
|
} |
84
|
0
|
|
|
|
|
|
return undef; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub index { |
88
|
0
|
0
|
0
|
0
|
0
|
|
if ( $_[0][1] >= 0 || $_[0][1] < scalar @{$_[0][0]} ) { |
|
0
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
return $_[0][1]; |
90
|
|
|
|
|
|
|
} |
91
|
0
|
|
|
|
|
|
return undef; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
0
|
0
|
|
sub next { return $_[0]->nextNode(); } |
95
|
0
|
|
|
0
|
0
|
|
sub previous { return $_[0]->previousNode(); } |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub nextNode { |
98
|
0
|
|
|
0
|
0
|
|
my $nlen = scalar @{$_[0][0]}; |
|
0
|
|
|
|
|
|
|
99
|
0
|
0
|
|
|
|
|
if ( $nlen <= ($_[0][1] + 1)) { |
100
|
0
|
|
|
|
|
|
return undef; |
101
|
|
|
|
|
|
|
} |
102
|
0
|
|
|
|
|
|
my $i = $_[0][1]; |
103
|
0
|
0
|
|
|
|
|
$i = -1 if $i < 0; # assure that we end up with the first |
104
|
|
|
|
|
|
|
# element in the first iteration |
105
|
0
|
|
|
|
|
|
while ( 1 ) { |
106
|
0
|
|
|
|
|
|
$i++; |
107
|
0
|
0
|
|
|
|
|
return undef if $i >= $nlen; |
108
|
0
|
0
|
|
|
|
|
if ( $_[0]->accept_node( $_[0][0]->[$i] ) == FILTER_ACCEPT ) { |
109
|
0
|
|
|
|
|
|
$_[0][1] = $i; |
110
|
0
|
|
|
|
|
|
last; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
} |
113
|
0
|
|
|
|
|
|
return $_[0][0]->[$_[0][1]]; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub previousNode { |
117
|
0
|
0
|
|
0
|
0
|
|
if ( $_[0][1] <= 0 ) { |
118
|
0
|
|
|
|
|
|
return undef; |
119
|
|
|
|
|
|
|
} |
120
|
0
|
|
|
|
|
|
my $i = $_[0][1]; |
121
|
0
|
|
|
|
|
|
while ( 1 ) { |
122
|
0
|
|
|
|
|
|
$i--; |
123
|
0
|
0
|
|
|
|
|
return undef if $i < 0; |
124
|
0
|
0
|
|
|
|
|
if ( $_[0]->accept_node( $_[0][0]->[$i] ) == FILTER_ACCEPT ) { |
125
|
0
|
|
|
|
|
|
$_[0][1] = $i; |
126
|
0
|
|
|
|
|
|
last; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
} |
129
|
0
|
|
|
|
|
|
return $_[0][0][$_[0][1]]; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub iterate { |
133
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
134
|
0
|
|
|
|
|
|
my $funcref = shift; |
135
|
0
|
|
|
|
|
|
my $rv; |
136
|
|
|
|
|
|
|
|
137
|
0
|
0
|
0
|
|
|
|
return unless defined $funcref && ref( $funcref ) eq 'CODE'; |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
$self->[1] = -1; # first element |
140
|
0
|
|
|
|
|
|
while ( my $node = $self->next ) { |
141
|
0
|
|
|
|
|
|
$rv = $funcref->( $self, $node ); |
142
|
|
|
|
|
|
|
} |
143
|
0
|
|
|
|
|
|
return $rv; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# helper function for the <> operator |
147
|
|
|
|
|
|
|
# returns all nodes that have not yet been accessed |
148
|
|
|
|
|
|
|
sub _get_all { |
149
|
0
|
|
|
0
|
|
|
my $self = shift; |
150
|
0
|
|
|
|
|
|
my @retval = (); |
151
|
0
|
|
|
|
|
|
my $node; |
152
|
0
|
|
|
|
|
|
while ( $node = $self->next() ) { |
153
|
0
|
|
|
|
|
|
push @retval, $node; |
154
|
|
|
|
|
|
|
} |
155
|
0
|
|
|
|
|
|
return @retval; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
1; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=pod |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head1 NAME |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
XML::LibXML::NodeList::Iterator - Iteration Class for XML::LibXML XPath results |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head1 SYNOPSIS |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
use XML::LibXML; |
169
|
|
|
|
|
|
|
use XML::LibXML::NodeList::Iterator; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
my $doc = XML::LibXML->new->parse_string( $somedata ); |
172
|
|
|
|
|
|
|
my $nodelist = $doc->findnodes( $somexpathquery ); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
my $iter= XML::LibXML::NodeList::Iterator->new( $nodelist ); |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# more control on the flow |
177
|
|
|
|
|
|
|
while ( $iter->nextNode ) { |
178
|
|
|
|
|
|
|
# do something |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# operate on the entire tree |
182
|
|
|
|
|
|
|
$iter->iterate( \&operate ); |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head1 DESCRIPTION |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
XML::LibXML::NodeList::Iterator is very similar to |
187
|
|
|
|
|
|
|
XML::LibXML::Iterator, but it does not iterate on the tree structure |
188
|
|
|
|
|
|
|
but on a XML::LibXML::NodeList object. Because XML::LibXML::NodeList |
189
|
|
|
|
|
|
|
is basicly an array the functionality of |
190
|
|
|
|
|
|
|
XML::LibXML::NodeList::Iterator is more restircted to stepwise |
191
|
|
|
|
|
|
|
foreward and backward than XML::LibXML::Iterator is. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head1 SEE ALSO |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
L, L, L |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 AUTHOR |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
Christian Glahn, Ephish@cpan.orgE |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head1 COPYRIGHT |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
(c) 2002-2007, Christian Glahn. All rights reserved. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
This package is free software; you can redistribute it and/or modify |
206
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=cut |