File Coverage

lib/XML/Parser/Lite/Tree/XPath/Result.pm
Criterion Covered Total %
statement 79 80 98.7
branch 65 70 92.8
condition n/a
subroutine 12 12 100.0
pod 0 10 0.0
total 156 172 90.7


line stmt bran cond sub pod time code
1             package XML::Parser::Lite::Tree::XPath::Result;
2            
3 34     34   29299 use strict;
  34         95  
  34         1105  
4 34     34   43828 use Data::Dumper;
  34         432631  
  34         56055  
5            
6             #
7             # types:
8             #
9             # Error - value is error message string
10             # number - value is numeric scalar
11             # boolean - value is boolean scalar
12             # string - value is string scalar
13             # nodeset - value is arrayref of nodes and/or attributes
14             # node - value is node
15             # attribute - value is attribute
16             #
17            
18             sub new {
19 1691     1691 0 3224 my $class = shift;
20 1691         4853 my $self = bless {}, $class;
21            
22 1691         3475 $self->{type} = shift;
23 1691         2649 $self->{value} = shift;
24            
25 1691         7625 return $self;
26             }
27            
28             sub is_error {
29 3823     3823 0 4345 my ($self) = @_;
30 3823 100       13875 return ($self->{type} eq 'Error') ? 1 : 0;
31             }
32            
33             sub normalize {
34 288     288 0 406 my ($self) = @_;
35            
36 288 50       737 if ($self->{type} eq 'nodeset'){
37            
38             # uniquify and sort
39 288         509 my %seen = ();
40 1703         3801 my @tags = sort {
41 1107         7852 $a->{order} <=> $b->{order}
42             } grep {
43 288         594 ! $seen{$_->{order}} ++
44 288         346 } @{$self->{value}};
45            
46 288         1756 $self->{value} = \@tags;
47             }
48             }
49            
50             sub ret {
51 145     145 0 231 my ($self, $a, $b) = @_;
52 145         355 return XML::Parser::Lite::Tree::XPath::Result->new($a, $b);
53             }
54            
55             sub get_type {
56 179     179 0 218 my ($self, $type) = @_;
57            
58 179 50       303 return $self if $self->is_error;
59            
60 179 100       491 return $self->get_number if $type eq 'number';
61 46 100       113 return $self->get_boolean if $type eq 'boolean';
62 23 100       49 return $self->get_string if $type eq 'string';
63 22 100       68 return $self->get_nodeset if $type eq 'nodeset';
64 3 100       10 return $self->get_node if $type eq 'node';
65            
66 2         9 return $self->ret('Error', "Can't get type '$type'");
67             }
68            
69             sub get_boolean {
70 36     36 0 46 my ($self) = @_;
71            
72 36 100       138 return $self if $self->{type} eq 'boolean';
73 12 100       27 return $self if $self->is_error;
74            
75 11 100       33 if ($self->{type} eq 'number'){
76 3 100       24 return $self->ret('boolean', 0) if $self->{value} eq 'NaN';
77 2         8 return $self->ret('boolean', $self->{value} != 0);
78             }
79            
80 8 100       20 if ($self->{type} eq 'string'){
81 2         8 return $self->ret('boolean', length $self->{value} > 0);
82             }
83            
84 6 100       17 if ($self->{type} eq 'nodeset'){
85 4         7 return $self->ret('boolean', scalar(@{$self->{value}}) > 0);
  4         14  
86             }
87            
88 2 50       7 if ($self->{type} eq 'node'){
89             # todo
90             }
91            
92 2         12 return $self->ret('Error', "can't convert type $self->{type} to boolean");
93             }
94            
95             sub get_string {
96 128     128 0 178 my ($self) = @_;
97            
98 128 100       485 return $self if $self->{type} eq 'string';
99 20 100       41 return $self if $self->is_error;
100            
101            
102 19 100       57 if ($self->{type} eq 'nodeset'){
103 3 100       2 return $self->ret('string', '') unless scalar @{$self->{value}};
  3         11  
104            
105 2         10 my $node = $self->ret('node', $self->{value}->[0]);
106            
107 2         6 return $node->get_string;
108             }
109            
110 16 100       48 if ($self->{type} eq 'node'){
111            
112 7 50       34 return $self->ret('string', $self->{value}->{value}) if $self->{value}->{type} eq 'attribute';
113            
114 0         0 die "can't convert a node of type $self->{value}->{type} to a string";
115             }
116            
117 9 100       24 if ($self->{type} eq 'number'){
118 5         78 return $self->ret('string', "$self->{value}");
119             }
120            
121 4 100       11 if ($self->{type} eq 'boolean'){
122 2 100       14 return $self->ret('string', $self->{value} ? 'true' : 'false');
123             }
124            
125 2         8 return $self->ret('Error', "can't convert type $self->{type} to string");
126             }
127            
128             sub get_nodeset {
129 166     166 0 216 my ($self) = @_;
130            
131 166 100       500 return $self if $self->{type} eq 'nodeset';
132 100 100       180 return $self if $self->is_error;
133            
134 99 100       246 if ($self->{type} eq 'node'){
135 94         314 return $self->ret('nodeset', [$self->{value}]);
136             }
137            
138 5         22 return $self->ret('Error', "can't convert type $self->{type} to nodeset");
139             }
140            
141             sub get_node {
142 6     6 0 9 my ($self) = @_;
143            
144 6 50       18 return $self if $self->{type} eq 'node';
145 6 100       16 return $self if $self->is_error;
146            
147 5         23 return $self->ret('Error', "can't convert type $self->{type} to node");
148             }
149            
150             sub get_number {
151 167     167 0 185 my ($self) = @_;
152            
153 167 100       661 return $self if $self->{type} eq 'number';
154 10 100       20 return $self if $self->is_error;
155            
156 9 100       26 if ($self->{type} eq 'string'){
157 5 100       29 if ($self->{value} =~ m!^[\x20\x09\x0D\x0A]*(-?([0-9]+(\.([0-9]+)?)?)|(\.[0-9]+))[\x20\x09\x0D\x0A]*$!){
158            
159 4         13 return $self->ret('number', $1);
160             }else{
161 1         5 return $self->ret('number', 'NaN');
162             }
163             }
164            
165 4 100       11 if ($self->{type} eq 'boolean'){
166 2 100       10 return $self->ret('number', $self->{value}?1:0);
167             }
168            
169 2         9 return $self->ret('Error', "can't convert type $self->{type} to number");
170             }
171            
172             1;