File Coverage

blib/lib/XML/LibXML/NodeList/Iterator.pm
Criterion Covered Total %
statement 12 98 12.2
branch 0 34 0.0
condition 0 9 0.0
subroutine 4 21 19.0
pod 0 13 0.0
total 16 175 9.1


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