File Coverage

File:lib/XML/Parser/Lite/Tree/XPath/Result.pm
Coverage:96.3%

linestmtbrancondsubtimecode
1package XML::Parser::Lite::Tree::XPath::Result;
2
3
34
34
34
34
120
56
127
use strict;
4
34
34
34
34
155
52
334
use Data::Dumper;
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
18sub new {
19
1691
1691
4031
        my $class = shift;
20
1691
6054
        my $self = bless {}, $class;
21
22
1691
5570
        $self->{type} = shift;
23
1691
5155
        $self->{value} = shift;
24
25
1691
6686
        return $self;
26}
27
28sub is_error {
29
3823
3823
9234
        my ($self) = @_;
30
3823
100
20587
        return ($self->{type} eq 'Error') ? 1 : 0;
31}
32
33sub normalize {
34
288
288
765
        my ($self) = @_;
35
36
288
50
1139
        if ($self->{type} eq 'nodeset'){
37
38                # uniquify and sort
39
288
637
                my %seen = ();
40
1703
5594
                my @tags = sort {
41
1107
4418
                        $a->{order} <=> $b->{order}
42                } grep {
43
288
1014
                        ! $seen{$_->{order}} ++
44
288
582
                } @{$self->{value}};
45
46
288
2218
                $self->{value} = \@tags;
47        }
48}
49
50sub ret {
51
145
145
496
        my ($self, $a, $b) = @_;
52
145
584
        return XML::Parser::Lite::Tree::XPath::Result->new($a, $b);
53}
54
55sub get_type {
56
179
179
467
        my ($self, $type) = @_;
57
58
179
50
438
        return $self if $self->is_error;
59
60
179
100
707
        return $self->get_number if $type eq 'number';
61
46
100
171
        return $self->get_boolean if $type eq 'boolean';
62
23
100
70
        return $self->get_string if $type eq 'string';
63
22
100
98
        return $self->get_nodeset if $type eq 'nodeset';
64
3
100
11
        return $self->get_node if $type eq 'node';
65
66
2
9
        return $self->ret('Error', "Can't get type '$type'");
67}
68
69sub get_boolean {
70
36
36
86
        my ($self) = @_;
71
72
36
100
187
        return $self if $self->{type} eq 'boolean';
73
12
100
35
        return $self if $self->is_error;
74
75
11
100
42
        if ($self->{type} eq 'number'){
76
3
100
14
                return $self->ret('boolean', 0) if $self->{value} eq 'NaN';
77
2
10
                return $self->ret('boolean', $self->{value} != 0);
78        }
79
80
8
100
32
        if ($self->{type} eq 'string'){
81
2
10
                return $self->ret('boolean', length $self->{value} > 0);
82        }
83
84
6
100
22
        if ($self->{type} eq 'nodeset'){
85
4
4
9
17
                return $self->ret('boolean', scalar(@{$self->{value}}) > 0);
86        }
87
88
2
50
8
        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
95sub get_string {
96
128
128
314
        my ($self) = @_;
97
98
128
100
617
        return $self if $self->{type} eq 'string';
99
20
100
54
        return $self if $self->is_error;
100
101
102
19
100
73
        if ($self->{type} eq 'nodeset'){
103
3
3
100
5
13
                return $self->ret('string', '') unless scalar @{$self->{value}};
104
105
2
9
                my $node = $self->ret('node', $self->{value}->[0]);
106
107
2
12
                return $node->get_string;
108        }
109
110
16
100
59
        if ($self->{type} eq 'node'){
111
112
7
50
51
                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
35
        if ($self->{type} eq 'number'){
118
5
26
                return $self->ret('string', "$self->{value}");
119        }
120
121
4
100
15
        if ($self->{type} eq 'boolean'){
122
2
100
11
                return $self->ret('string', $self->{value} ? 'true' : 'false');
123        }
124
125
2
12
        return $self->ret('Error', "can't convert type $self->{type} to string");
126}
127
128sub get_nodeset {
129
166
166
408
        my ($self) = @_;
130
131
166
100
722
        return $self if $self->{type} eq 'nodeset';
132
100
100
243
        return $self if $self->is_error;
133
134
99
100
379
        if ($self->{type} eq 'node'){
135
94
432
                return $self->ret('nodeset', [$self->{value}]);
136        }
137
138
5
24
        return $self->ret('Error', "can't convert type $self->{type} to nodeset");
139}
140
141sub get_node {
142
6
6
16
        my ($self) = @_;
143
144
6
50
22
        return $self if $self->{type} eq 'node';
145
6
100
15
        return $self if $self->is_error;
146
147
5
25
        return $self->ret('Error', "can't convert type $self->{type} to node");
148}
149
150sub get_number {
151
167
167
394
        my ($self) = @_;
152
153
167
100
901
        return $self if $self->{type} eq 'number';
154
10
100
27
        return $self if $self->is_error;
155
156
9
100
40
        if ($self->{type} eq 'string'){
157
5
100
38
                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
4
                        return $self->ret('number', 'NaN');
162                }
163        }
164
165
4
100
15
        if ($self->{type} eq 'boolean'){
166
2
100
14
                return $self->ret('number', $self->{value}?1:0);
167        }
168
169
2
12
        return $self->ret('Error', "can't convert type $self->{type} to number");
170}
171
1721;