File Coverage

File:lib/XML/Parser/Lite/Tree/XPath/Test.pm
Coverage:60.3%

linestmtbrancondsubtimecode
1package XML::Parser::Lite::Tree::XPath::Test;
2
3
28
28
28
28
97
42
97
use strict;
4
28
28
28
28
179
40
304
use vars qw(@ISA @EXPORT);
5
28
28
28
28
131
58
155
use Test::More;
6
7
28
28
28
28
233
48
197
use XML::Parser::Lite::Tree;
8
28
28
28
28
191
58
238
use XML::Parser::Lite::Tree::XPath;
9
28
28
28
28
142
51
129
use Data::Dumper;
10
11require Exporter;
12@ISA = qw(Exporter);
13@EXPORT = qw(
14        set_xml
15        test_tree
16        test_nodeset
17        test_number
18        test_string
19        test_error
20        test_boolean
21);
22
23our $xpath;
24
25sub set_xml {
26
29
29
120
        my ($xml) = @_;
27
28
29
262
        $xml =~ s/>\s+</></sg;
29
29
625
        $xml =~ s/^\s*(.*?)\s*$/$1/;
30
31
29
172
        my $parser = new XML::Parser::Lite::Tree(process_ns => 1);
32
29
9580
        my $tree = $parser->parse($xml);
33
29
39951
        $xpath = new XML::Parser::Lite::Tree::XPath($tree);
34}
35
36sub test_tree {
37
41
41
156
        my ($path, $dump) = @_;
38
39
41
153
        my $tokener = XML::Parser::Lite::Tree::XPath::Tokener->new();
40
41
50
141
        if (!$tokener->parse($path)){
41
0
0
                print "Path: $path\n";
42
0
0
                print "Failed toke: ($tokener->{error})\n";
43
0
0
                ok(0);
44
0
0
                return;
45        }
46
47
41
160
        my $tree = XML::Parser::Lite::Tree::XPath::Tree->new();
48
41
50
170
        if (!$tree->build_tree($tokener->{tokens})){
49
0
0
                print "Path: $path\n";
50
0
0
                print "Failed tree: ($tree->{error})\n";
51                #print Dumper $tree;
52
0
0
                ok(0);
53
0
0
                return;
54        }
55
56
41
141
        my $dump_got = $tree->dump_flat();
57
58
41
203
        ok($dump_got eq $dump);
59
60
41
50
132
        unless ($dump_got eq $dump){
61
0
0
                print "Path: $path\n";
62
0
0
                print "Expected: $dump\n";
63
0
0
                print "Dump: $dump_got\n";
64
0
0
                print $tree->dump_tree();
65        }
66
67
41
342
        return $dump_got;
68}
69
70sub test_nodeset {
71
73
73
282
        my ($path, $expected) = @_;
72
73
73
315
        my $nodes = $xpath->select_nodes($path);
74
75
73
50
355
        unless ('ARRAY' eq ref $nodes){
76
77
0
0
                print "Error: $xpath->{error}\n";
78
79
0
0
                ok(0);
80
0
0
0
0
0
0
                ok(0) for @{$expected};
81
0
0
                return;
82        }
83
84
73
162
        my $bad = 0;
85
86
73
73
73
127
186
217
        my $ok = scalar(@{$nodes}) == scalar(@{$expected});
87
73
50
268
        $bad++ unless $ok;
88
73
273
        ok($ok);
89
90
73
50
248
        if (!$ok){
91
0
0
0
0
0
0
                print "# wrong node count. got ".scalar(@{$nodes}).", expected ".scalar(@{$expected})."\n";
92        }
93
94
95
73
158
        my $i = 0;
96
73
73
139
251
        for my $xnode(@{$expected}){
97
98                # $xnode is a hash ref which should match stuff in $nodes[$i]
99
100
247
247
418
1027
                for my $key(keys %{$xnode}){
101
102
473
100
100
100
100
2385
                        if ($key eq 'nodename'){
103
104
241
1079
                                $ok = $nodes->[$i]->{name} eq $xnode->{$key};
105
106
241
50
684
                                print "# node name - expected: $xnode->{$key}, got: $nodes->[$i]->{name}\n" unless $ok;
107
108                        }elsif ($key eq 'attributecount'){
109
110
1
1
2
6
                                $ok = scalar(keys %{$nodes->[$i]->{attributes}}) == $xnode->{$key};
111
112
1
0
50
5
0
                                print "# attribute count - expected: $xnode->{$key}, got: ".scalar(keys %{$nodes->[$i]->{attributes}})."\n" unless $ok;
113
114                        }elsif ($key eq 'type'){
115
116
8
40
                                $ok = $nodes->[$i]->{type} eq $xnode->{$key};
117
118
8
50
31
                                print "# node type - expected: $xnode->{$key}, got: $nodes->[$i]->{type}\n" unless $ok;
119
120                        }elsif ($key eq 'value'){
121
122
2
11
                                $ok = $nodes->[$i]->{value} eq $xnode->{$key};
123
124
2
50
6
                                print "# value - expected: $xnode->{$key}, got: $nodes->[$i]->{value}\n" unless $ok;
125
126                        }else{
127
221
1149
                                $ok = $nodes->[$i]->{attributes}->{$key} eq $xnode->{$key};
128
129
221
50
624
                                print "# attribute $key - expected: $xnode->{$key}, got: $nodes->[$i]->{attributes}->{$key}\n" unless $ok;
130                        }
131
132
473
50
1198
                        $bad++ unless $ok;
133
473
1294
                        ok($ok);
134                }
135
136
247
816
                $i++;
137        }
138
139
73
50
316
        if ($bad){
140
0
0
                print "# codes don't match. got:\n";
141
0
0
0
0
                for my $node(@{$nodes}){
142
0
0
                        print "# \t";
143
0
0
                        print "($node->{type} : $node->{order}) ";
144
0
0
                        print "$node->{name}";
145
0
0
0
0
                        for my $key(keys %{$node->{attributes}}){
146
0
0
                                print ", $key=$node->{attributes}->{$key}";
147                        }
148
0
0
                        print "\n";
149                }
150
0
0
                print "# expected:\n";
151
0
0
                my $i = 1;
152
0
0
0
0
                for my $node(@{$expected}){
153
0
0
                        print "# \t$i";
154
0
0
0
0
                        for my $key(keys %{$node}){
155
0
0
                                print ", $key={$node->{$key}}";
156                        }
157
0
0
                        print "\n";
158
0
0
                        $i++;
159                }
160
0
0
                print Dumper $nodes;
161        }
162}
163
164sub test_number {
165
15
15
48
        my ($path, $expected) = @_;
166
167
15
53
        my $ret = $xpath->query($path);
168
169
15
50
47
        if (!$ret){
170
0
0
                print "Error: $xpath->{error}\n";
171
0
0
                ok(0);
172
0
0
                ok(0);
173
0
0
                return;
174        }
175
176
15
67
        ok($ret->{type} eq 'number');
177
178
15
50
59
        if ($ret->{type} eq 'number'){
179
15
59
                ok($ret->{value} == $expected);
180
181
15
50
87
                if ($ret->{value} != $expected){
182
0
0
                        print "expected $expected, got $ret->{value}\n";
183                }
184        }else{
185
0
0
                print "got a $ret->{type} result\n";
186
0
0
                ok(0);
187        }
188}
189
190sub test_string {
191
31
31
102
        my ($path, $expected) = @_;
192
193
31
111
        my $ret = $xpath->query($path);
194
195
31
50
100
        if (!$ret){
196
0
0
                print "Error: $xpath->{error}\n";
197
0
0
                ok(0);
198
0
0
                ok(0);
199
0
0
                return;
200        }
201
202
31
126
        ok($ret->{type} eq 'string');
203
204
31
50
116
        if ($ret->{type} eq 'string'){
205
31
124
                ok($ret->{value} eq $expected);
206
207
31
50
181
                if ($ret->{value} ne $expected){
208
0
0
                        print "# expected $expected, got $ret->{value}\n";
209                }
210        }else{
211
0
0
                print "# got a $ret->{type} result\n";
212
0
0
                ok(0);
213        }
214}
215
216sub test_error {
217
1
1
5
        my ($path, $expected) = @_;
218
219
1
4
        my $ret = $xpath->query($path);
220
221
1
50
4
        if ($ret){
222
0
0
                print "# no error - but we expected one!\n";
223
0
0
                ok(0);
224        }else{
225
1
50
8
                if ($xpath->{error} =~ $expected){
226
227
1
3
                        ok(1);
228                }else{
229
0
0
                        print "# wrong error\n";
230
0
0
                        print "# expected: $expected\n";
231
0
0
                        print "# got: $xpath->{error}\n";
232
0
0
                        ok(0);
233                }
234        }
235}
236
237sub test_boolean {
238
10
10
32
        my ($path, $expected) = @_;
239
240
10
35
        my $ret = $xpath->query($path);
241
242
10
50
33
        if (!$ret){
243
0
0
                print "Error: $xpath->{error}\n";
244
0
0
                ok(0);
245
0
0
                ok(0);
246
0
0
                return;
247        }
248
249
10
42
        ok($ret->{type} eq 'boolean');
250
251
10
50
41
        if ($ret->{type} eq 'boolean'){
252
10
19
                my $ok = 0;
253
10
100
67
69
                $ok = 1 if $expected && $ret->{value};
254
10
100
67
54
                $ok = 1 if !$expected && !$ret->{value};
255
256
10
30
                ok($ok);
257
258
10
50
48
                unless ($ok){
259
0
                        print "# expected $expected, got $ret->{value}\n";
260                }
261        }else{
262
0
                print "# got a $ret->{type} result\n";
263
0
                ok(0);
264        }
265}
266
2671;