File Coverage

lib/XML/Parser/Lite/Tree/XPath/Axis.pm
Criterion Covered Total %
statement 160 161 99.3
branch 60 68 88.2
condition 7 9 77.7
subroutine 21 21 100.0
pod 0 4 0.0
total 248 263 94.3


line stmt bran cond sub pod time code
1             package XML::Parser::Lite::Tree::XPath::Axis;
2              
3 33     33   30202 use strict;
  33         71  
  33         1324  
4 33     33   615 use XML::Parser::Lite::Tree::XPath::Result;
  33         53  
  33         865  
5              
6 33     33   165 use vars qw( $axis );
  33         63  
  33         73926  
7              
8             sub instance {
9 280 100   280 0 1301 return $axis if $axis;
10 25         199 $axis = __PACKAGE__->new;
11             }
12              
13             sub new {
14 25     25 0 174 return bless {}, $_[0];
15             }
16              
17             sub filter {
18 280     280 0 451 my ($self, $token, $context) = @_;
19              
20 280         505 $self->{token} = $token;
21 280 100       803 $self->{axis} = defined($token->{axis}) ? $token->{axis} : 'child';
22              
23 280 100       898 return $self->_axis_child($context) if $self->{axis} eq 'child';
24 115 100       315 return $self->_axis_descendant($context, 0) if $self->{axis} eq 'descendant';
25 109 100       433 return $self->_axis_descendant($context, 1) if $self->{axis} eq 'descendant-or-self';
26 49 100       131 return $self->_axis_parent($context) if $self->{axis} eq 'parent';
27 47 100       118 return $self->_axis_ancestor($context, 0) if $self->{axis} eq 'ancestor';
28 43 100       115 return $self->_axis_ancestor($context, 1) if $self->{axis} eq 'ancestor-or-self';
29 41 100       96 return $self->_axis_following_sibling($context) if $self->{axis} eq 'following-sibling';
30 39 100       91 return $self->_axis_preceding_sibling($context) if $self->{axis} eq 'preceding-sibling';
31 37 100       95 return $self->_axis_following($context) if $self->{axis} eq 'following';
32 33 100       89 return $self->_axis_preceding($context) if $self->{axis} eq 'preceding';
33 29 100       107 return $self->_axis_attribute($context) if $self->{axis} eq 'attribute';
34              
35 3 100       16 return $context if $self->{axis} eq 'self';
36              
37 1         5 return $self->ret('Error', "Unknown axis '$self->{axis}'");
38             }
39              
40             sub ret {
41 278     278 0 468 my ($self, $type, $value) = @_;
42 278         1054 return XML::Parser::Lite::Tree::XPath::Result->new($type, $value);
43             }
44              
45             sub _axis_child {
46 165     165   415 my ($self, $in) = @_;
47              
48 165         463 my $out = $self->ret('nodeset', []);
49              
50 165         230 for my $tag(@{$in->{value}}){
  165         391  
51 745         714 for my $child(@{$tag->{children}}){
  745         1279  
52 757         811 push @{$out->{value}}, $child;
  757         1656  
53             }
54             }
55              
56 165         495 return $out;
57             }
58              
59             sub _axis_descendant {
60 66     66   111 my ($self, $in, $me) = @_;
61              
62 66         249 my $out = $self->ret('nodeset', []);
63              
64 66         108 for my $tag(@{$in->{value}}){
  66         156  
65              
66 682         1231 map{
67 70         263 push @{$out->{value}}, $_;
  682         644  
68              
69             }$self->_axis_descendant_single($tag, $me);
70             }
71              
72 66         253 return $out;
73             }
74              
75             sub _axis_descendant_single {
76 690     690   985 my ($self, $tag, $me) = @_;
77              
78 690         662 my @out;
79              
80 690 100       1350 push @out, $tag if $me;
81              
82 690         684 for my $child(@{$tag->{children}}){
  690         1230  
83              
84 622 100       1353 if ($child->{type} eq 'element'){
85              
86 1788         2841 map{
87 620         1288 push @out, $_;
88             }$self->_axis_descendant_single($child, 1);
89             }
90             }
91              
92 690         1531 return @out;
93             }
94              
95             sub _axis_attribute {
96 26     26   32 my ($self, $input) = @_;
97              
98 26         58 my $out = $self->ret('nodeset', []);
99 26         57 my $nodes = [];
100              
101 26 50       65 if ($input->{type} eq 'nodeset'){
102 26         47 $nodes = $input->{value};
103             }
104              
105 26 50       60 if ($input->{type} eq 'node'){
106 0         0 $nodes = [$input->{value}];
107             }
108              
109 26 50       59 return $self->ret('Error', "attribute axis can only filter nodes and nodesets (not a $input->{type})") unless defined $nodes;
110              
111 26         33 my $i = 0;
112              
113 26         30 for my $node(@{$nodes}){
  26         46  
114 31         34 for my $key(keys %{$node->{attributes}}){
  31         98  
115 30         34 push @{$out->{value}}, {
  30         236  
116             'name' => $key,
117             'value' => $node->{attributes}->{$key},
118             'type' => 'attribute',
119             'order' => ($node->{order} * 10000000) + $i++,
120             };
121             }
122             }
123              
124 26         87 return $out;
125             }
126              
127             sub _axis_parent {
128 2     2   3 my ($self, $in) = @_;
129              
130 2         6 my $out = $self->ret('nodeset', []);
131              
132 2         3 for my $tag(@{$in->{value}}){
  2         4  
133 6 50       13 push @{$out->{value}}, $tag->{parent} if defined $tag->{parent};
  6         11  
134             }
135              
136 2         5 return $out;
137             }
138              
139             sub _axis_ancestor {
140 6     6   12 my ($self, $in, $me) = @_;
141              
142 6         19 my $out = $self->ret('nodeset', []);
143              
144 6         11 for my $tag(@{$in->{value}}){
  6         17  
145              
146 32         59 map{
147 6         26 push @{$out->{value}}, $_;
  32         32  
148              
149             }$self->_axis_ancestor_single($tag, $me);
150             }
151              
152 6         18 return $out;
153             }
154              
155             sub _axis_ancestor_single {
156 36     36   50 my ($self, $tag, $me) = @_;
157              
158 36         37 my @out;
159              
160 36 100       74 push @out, $tag if $me;
161              
162 36 100       69 if (defined $tag->{parent}){
163              
164 91         110 map{
165 30         95 push @out, $_;
166             }$self->_axis_ancestor_single($tag->{parent}, 1);
167             }
168              
169 36         131 return @out;
170             }
171              
172             sub _axis_following_sibling {
173 2     2   3 my ($self, $in) = @_;
174              
175 2         6 my $out = $self->ret('nodeset', []);
176              
177 2         5 for my $tag(@{$in->{value}}){
  2         5  
178 4 50       10 if (defined $tag->{parent}){
179 4         6 my $parent = $tag->{parent};
180 4         6 my $found = 0;
181 4         5 for my $child(@{$parent->{children}}){
  4         8  
182 13 100       23 push @{$out->{value}}, $child if $found;
  5         10  
183 13 100       38 $found = 1 if $child->{order} == $tag->{order};
184             }
185             }
186             }
187              
188 2         8 return $out;
189             }
190              
191             sub _axis_preceding_sibling {
192 2     2   4 my ($self, $in) = @_;
193              
194 2         6 my $out = $self->ret('nodeset', []);
195              
196 2         5 for my $tag(@{$in->{value}}){
  2         5  
197 4 50       12 if (defined $tag->{parent}){
198 4         4 my $parent = $tag->{parent};
199 4         5 my $found = 0;
200 4         5 for my $child(@{$parent->{children}}){
  4         7  
201 13 100       27 $found = 1 if $child->{order} == $tag->{order};
202 13 100       27 push @{$out->{value}}, $child unless $found;
  5         11  
203             }
204             }
205             }
206              
207 2         7 return $out;
208             }
209              
210             sub _axis_following {
211 4     4   6 my ($self, $in) = @_;
212              
213 4         15 my $min_order = 1 + $self->{token}->{max_order};
214 4         5 for my $tag(@{$in->{value}}){
  4         9  
215 4 50       19 $min_order = $tag->{order} if $tag->{order} < $min_order;
216             }
217              
218             # recurse the whole tree, adding after we find $min_order (but don't descend into it!)
219              
220 4         21 my @tags = $self->_axis_following_recurse( $self->{token}->{root}->{value}->[0], $min_order );
221              
222 4         14 return $self->ret('nodeset', \@tags);
223             }
224              
225             sub _axis_following_recurse {
226 54     54   75 my ($self, $tag, $min) = @_;
227              
228 54         53 my @out;
229              
230 54 100       107 push @out, $tag if $tag->{order} > $min;
231              
232 54         57 for my $child(@{$tag->{children}}){
  54         90  
233              
234 54 100 66     212 if (($child->{order}) != $min && ($child->{type} eq 'element')){
235              
236 67         110 map{
237 50         115 push @out, $_;
238             }$self->_axis_following_recurse($child, $min);
239             }
240             }
241              
242 54         116 return @out;
243             }
244              
245             sub _axis_preceding {
246 4     4   8 my ($self, $in) = @_;
247              
248 4         8 my $max_order = -1;
249 4         8 my $parents;
250 4         26 for my $tag(@{$in->{value}}){
  4         12  
251 4 50       16 if ($tag->{order} > $max_order){
252 4         9 $max_order = $tag->{order};
253 4         16 $parents = $self->_get_parent_orders($tag);
254             }
255             }
256              
257             # recurse the whole tree, adding until we find $max_order (but don't descend into it!)
258              
259 4         23 my @tags = $self->_axis_preceding_recurse( $self->{token}->{root}->{value}->[0], $parents, $max_order );
260              
261 4         13 return $self->ret('nodeset', \@tags);
262             }
263              
264             sub _axis_preceding_recurse {
265 49     49   66 my ($self, $tag, $parents, $max) = @_;
266              
267 49         48 my @out;
268              
269 49 100 100     209 push @out, $tag if $tag->{order} < $max && !$parents->{$tag->{order}};
270              
271 49         74 for my $child(@{$tag->{children}}){
  49         85  
272              
273 49 100 66     194 if (($child->{order}) != $max && ($child->{type} eq 'element')){
274              
275 74         119 map{
276 45         105 push @out, $_;
277             }$self->_axis_preceding_recurse($child, $parents, $max);
278             }
279             }
280              
281 49         109 return @out;
282             }
283              
284             sub _get_parent_orders {
285 4     4   8 my ($self, $tag) = @_;
286 4         5 my $parents;
287              
288 4         13 while(defined $tag->{parent}){
289 17         25 $tag = $tag->{parent};
290 17         64 $parents->{$tag->{order}} = 1;
291             }
292              
293 4         13 return $parents;
294             }
295              
296             1;