File Coverage

blib/lib/XML/XSH/Iterators.pm
Criterion Covered Total %
statement 9 145 6.2
branch 0 72 0.0
condition 0 21 0.0
subroutine 3 32 9.3
pod 0 24 0.0
total 12 294 4.0


line stmt bran cond sub pod time code
1             # $Id: Iterators.pm,v 1.1 2003/03/12 14:01:31 pajas Exp $
2              
3             package XML::XSH::Iterators;
4              
5             #namespace ???
6             #attribute ??
7              
8             sub create_iterator {
9 0     0 0   my ($class,$node,$axis,$filter)=@_;
10 0           my $iterator;
11              
12 0 0         die "Unsupported or unknown axis $axis\n"
13             unless $class->can("iterate_$axis");
14              
15 0 0         if ($class->can("init_$axis")) {
16 0           $node=&{"init_$axis"}($node);
  0            
17             }
18 0 0         return undef unless defined $node;
19              
20 0           $iterator= XML::XSH::FilteredIterator->new($node, $filter);
21 0           $iterator->iterator_function(\&{"iterate_$axis"});
  0            
22 0 0         $iterator->first_filtered() || return undef;
23 0           return $iterator;
24             }
25              
26             sub iterate_self {
27 0     0 0   return undef; # the most trivial iterator :-)
28             }
29              
30             sub init_child {
31 0     0 0   my ($node)=@_;
32 0           return $node->firstChild;
33             }
34              
35             sub iterate_child { # iteration must start at the first child!
36 0     0 0   my ($iter, $dir) = @_;
37 0 0         if ( $dir < 0 ) {
38 0           return $iter->{CURRENT}->previousSibling;
39             } else {
40 0           return $iter->{CURRENT}->nextSibling;
41             }
42             }
43              
44             sub init_following_sibling {
45 0     0 0   my ($node)=@_;
46 0           return $node->nextSibling();
47             }
48              
49             sub iterate_following_sibling {
50 0     0 0   my ($iter, $dir) = @_;
51 0 0         if ( $dir < 0 ) {
52 0 0         if ($iter->{FIRST}->isSameNode( $iter->{CURRENT}->previousSibling )) {
53 0           return undef;
54             }
55 0           return $iter->{CURRENT}->previousSibling;
56             } else {
57 0           return $iter->{CURRENT}->nextSibling;
58             }
59             }
60              
61              
62             sub init_preceding_sibling {
63 0     0 0   my ($node)=@_;
64 0           return $node->nextSibling();
65             }
66              
67             sub iterate_preceding_sibling {
68 0     0 0   my ($iter, $dir) = @_;
69 0 0         if ( $dir < 0 ) {
70 0 0         if ($iter->{FIRST}->isSameNode( $iter->{CURRENT}->nextSibling )) {
71 0           return undef;
72             }
73 0           return $iter->{CURRENT}->nextSibling;
74             } else {
75 0           return $iter->{CURRENT}->previousSibling;
76             }
77             }
78              
79             sub iterate_ancestor_or_self {
80 0     0 0   my ($iter, $dir) = @_;
81 0 0         if ( $dir < 0 ) {
82 0           my $node = undef;
83 0 0         return undef if $iter->{CURRENT}->isSameNode( $iter->{FIRST} );
84 0           $node=$iter->{FIRST};
85 0   0       while ($node->parentNode and
86             not($node->parentNode->isSameNode($iter->{CURRENT}))) {
87 0           $node=$node->parentNode;
88             }
89 0           return $node;
90             } else {
91 0           return $iter->{CURRENT}->parentNode;
92             }
93             }
94              
95             sub init_ancestor {
96 0     0 0   my ($node)=@_;
97 0           return $node->parentNode();
98             }
99             *iterate_ancestor = *iterate_ancestor_or_self;
100              
101             *init_parent = *init_ancestor;
102             *iterate_parent = *iterate_ancestor_or_self;
103              
104             sub iterate_descendant_or_self {
105 0     0 0   my $iter = shift;
106 0           my $dir = shift;
107 0 0         if ( $dir < 0 ) {
108 0 0         return undef if $iter->{CURRENT}->isSameNode( $iter->{FIRST} );
109 0           return get_prev_node($iter->{CURRENT});
110             } else {
111 0           return get_next_node($iter->{CURRENT},$iter->{FIRST});
112             }
113 0           return $node;
114             }
115              
116             sub init_descendant {
117 0     0 0   my ($node)=@_;
118 0           return $node->firstChild;
119             }
120             sub iterate_descendant { # iteration must start at the first child!
121 0     0 0   my $iter = shift;
122 0           my $dir = shift;
123 0 0         if ( $dir < 0 ) {
124 0 0         return undef if $iter->{CURRENT}->isSameNode( $iter->{FIRST} );
125 0           return get_prev_node($iter->{CURRENT});
126             } else {
127 0           return get_next_node($iter->{CURRENT},$iter->{FIRST}->parentNode);
128             }
129             }
130              
131             sub iterate_following_or_self {
132 0     0 0   my $iter = shift;
133 0           my $dir = shift;
134 0 0         if ( $dir < 0 ) {
135 0 0         return undef if $iter->{CURRENT}->isSameNode( $iter->{FIRST} );
136 0           return get_prev_node($iter->{CURRENT});
137             } else {
138 0           return get_next_node($iter->{CURRENT});
139             }
140             }
141              
142             sub iterate_preceding_or_self {
143 0     0 0   my $iter = shift;
144 0           my $dir = shift;
145 0 0         if ( $dir < 0 ) {
146 0 0         return undef if $iter->{CURRENT}->isSameNode( $iter->{FIRST} );
147 0           return get_next_node($iter->{CURRENT});
148             } else {
149 0           return get_prev_node($iter->{CURRENT});
150             }
151             }
152              
153             sub init_following {
154 0     0 0   return get_next_node($_[0]);
155             }
156             *iterate_following = *iterate_following_or_self;
157              
158             sub init_preceding {
159 0     0 0   return get_prev_node($_[0]);
160             }
161             *iterate_preceding = *iterate_preceding_or_self;
162              
163             sub init_first_descendant {
164 0     0 0   return $_[0]->firstChild;
165             }
166              
167             sub iterate_first_descendant_or_self {
168 0     0 0   my ($iter, $dir) = @_;
169              
170 0 0         if ( $dir < 0 ) {
171 0 0         if ($iter->{FIRST}->isSameNode( $iter->{CURRENT} )) {
172 0           return undef;
173             }
174 0           return $iter->{CURRENT}->parent;
175             } else {
176 0           return $iter->{CURRENT}->firstChild;
177             }
178             }
179             sub iterate_first_descendant {
180 0     0 0   iterate_first_descendant_or_self(@_);
181             }
182             #*iterate_first_descendant = *iterate_first_descendant_or_self;
183              
184             sub init_last_descendant {
185 0     0 0   return $_[0]->lastChild;
186             }
187             *iterate_last_descendant = *iterate_last_descendant_or_self;
188              
189             sub iterate_last_descendant_or_self {
190 0     0 0   my ($iter, $dir) = @_;
191 0 0         if ( $dir < 0 ) {
192 0 0         if ($iter->{FIRST}->isSameNode( $iter->{CURRENT} )) {
193 0           return undef;
194             }
195 0           return $iter->{CURRENT}->parent;
196             } else {
197 0           return $iter->{CURRENT}->lastChild;
198             }
199             }
200              
201              
202             #STATIC
203             sub get_prev_node {
204 0     0 0   my ($node) = @_;
205 0 0         if ($node->previousSibling) {
206 0           $node = $node->previousSibling;
207 0 0         if ($node->hasChildNodes) {
208 0           return $node->lastChild;
209             } else {
210 0           return $node;
211             }
212             }
213 0           return $node->parentNode;
214             }
215              
216             #STATIC
217             sub get_next_node {
218 0     0 0   my ($node,$stop) = @_;
219              
220 0 0         if ( $node->hasChildNodes ) {
221 0           return $node->firstChild;
222             } else {
223 0           while ($node) {
224 0 0 0       return undef if ($stop and $node->isSameNode($stop) or
      0        
225             not $node->parentNode);
226 0 0         return $node->nextSibling if $node->nextSibling;
227 0           $node = $node->parentNode;
228             }
229 0           return undef;
230             }
231             }
232              
233             package XML::XSH::FilteredIterator;
234 4     4   17 use strict;
  4         7  
  4         159  
235 4     4   3063 use XML::LibXML::Iterator;
  4         26503  
  4         113  
236 4     4   21 use base qw(XML::LibXML::Iterator);
  4         8  
  4         1770  
237              
238             sub new {
239 0     0     my ($class,$node,$filter)=@_;
240 0   0       $class = ref($class) || $class;
241 0           my $self = $class->SUPER::new($node);
242 0           $self->{FILTER}=$filter;
243 0           return $self;
244             }
245              
246             sub filter {
247 0     0     my $self=shift;
248 0 0         if (@_) { $self->{FILTER}=$_[0]; }
  0            
249 0           return $self->{FILTER};
250             }
251              
252             sub first_filtered {
253 0     0     my $self=shift;
254 0           my ($node)=@_;
255 0           my $filter=$self->filter;
256 0 0         $self->first(@_) || return undef;
257 0 0         if (ref($filter) eq 'CODE') {
258 0   0       while ($self->current() and not &$filter($self->current())) {
259 0 0         $self->next() || return undef;
260             }
261             }
262 0           return $self->current();
263             }
264              
265             sub next {
266 0     0     my $self=shift;
267 0           my ($node)=@_;
268 0           my $filter=$self->filter;
269 0 0         $self->SUPER::next() || return undef;
270 0   0       while ($self->current() and not &$filter($self->current())) {
271 0 0         $self->SUPER::next() || return undef;
272             }
273 0           return $self->current();
274             }
275              
276             sub prev {
277 0     0     my $self=shift;
278 0           my ($node)=@_;
279 0           my $filter=$self->filter;
280 0 0         $self->SUPER::prev() || return undef;
281 0   0       while ($self->current() and not &$filter($self->current())) {
282 0 0         $self->SUPER::prev() || return undef;
283             }
284 0           return $self->current();
285             }
286              
287             1;