File Coverage

File:	lib/XML/Parser/Lite/Tree/XPath/Eval.pm
Coverage:	87.4%

line	stmt	bran	cond	sub	time	code
1						package XML::Parser::Lite::Tree::XPath::Eval;
2
3	29 29 29			29	111 48 147	use XML::Parser::Lite::Tree::XPath::Token;
4	29 29 29			29	128 49 182	use Data::Dumper;
5	29 29 29			29	149 52 112	use strict;
6
7						sub new {
8	130			130	360	my ($class) = @_;
9	130				629	my $self = bless {}, $class;
10	130				400	$self->{error} = 0;
11	130				373	return $self;
12						}
13
14						sub query {
15	130			130	452	my ($self, $xpath, $tree) = @_;
16	130				344	$self->{error} = 0;
17	130				336	$self->{tree} = $tree;
18
19	130				748	$self->{root} = XML::Parser::Lite::Tree::XPath::Result->new('nodeset', [$self->{tree}]);
20	130				572	$self->{max_order} = $self->mark_orders($self->{tree}, 1, undef);
21
22	130				475	$self->{uids} = {};
23	130				508	$self->mark_uids($self->{tree});
24
25	130				462	my $token = $xpath->{tokens}->[0];
26	130	50			402	unless (defined $token){
27	0				0	$self->{error} = "couldn't get root token to eval.";
28	0				0	return 0;
29						}
30
31	130				420	$self->mark_token($token);
32
33	130				645	my $out = $token->eval($self->{root});
34
35	130	100			494	if ($out->is_error){
36	1				5	$self->{error} = $out->{value};
37	1				4	return 0;
38						}
39
40	129				458	return $out;
41
42	0	0			0	if ($out->{type} ne 'nodeset'){
43	0				0	$self->{error} = "Result was not a nodeset (was a $out->{type})";
44	0				0	return 0;
45						}
46
47	0				0	return $out->{value};
48						}
49
50						sub mark_orders {
51	1185			1185	3529	my ($self, $tag, $i, $parent) = @_;
52
53	1185				3322	$tag->{order} = $i++;
54	1185				2959	$tag->{parent} = $parent;
55
56	1185 1185				1840 4087	for my $child(@{$tag->{children}}){
57	1055				3208	$i = $self->mark_orders($child, $i, $tag);
58						}
59
60	1185				3979	return $i;
61						}
62
63						sub mark_token {
64	926			926	2343	my ($self, $token) = @_;
65
66	926				2866	$token->{root} = $self->{root};
67	926				2837	$token->{max_order} = $self->{max_order};
68
69	926 926				1436 4229	for my $child(@{$token->{tokens}}){
70	796				2259	$self->mark_token($child);
71						}
72						}
73
74						sub mark_uids {
75	1185			1185	3111	my ($self, $tag) = @_;
76
77						#
78						# mark
79						#
80
81	1185	100			4507	if ($tag->{type} eq 'element'){
82
83	985				2637	$tag->{uid} = '';
84
85	985				3131	my $id = $tag->{attributes}->{id};
86
87	985	100	67		5731	if (defined $id && length $id){
88	710	50			3022	unless (defined $self->{uids}->{$id}){
89
90	710				1819	$tag->{uid} = $id;
91	710				2880	$self->{uids}->{$id} = 1;
92						}
93						}
94						}
95
96
97						#
98						# descend
99						#
100
101	1185	100	100		9223	if ($tag->{type} eq 'root' \|\| $tag->{type} eq 'element'){
102
103	1115 1115				1755 5199	for my $child (@{$tag->{children}}){
104
105	1055				2982	$self->mark_uids($child);
106						}
107						}
108						}
109
110						1;