File Coverage

blib/lib/Tree/XPathEngine/Function.pm
Criterion Covered Total %
statement 155 215 72.0
branch 43 82 52.4
condition 1 3 33.3
subroutine 28 35 80.0
pod 28 28 100.0
total 255 363 70.2


line stmt bran cond sub pod time code
1             # $Id: /tree-xpathengine/trunk/lib/Tree/XPathEngine/Function.pm 26 2006-02-15T15:46:06.515200Z mrodrigu $
2              
3             package Tree::XPathEngine::Function;
4 5     5   30 use Tree::XPathEngine::Number;
  5         10  
  5         137  
5 5     5   25 use Tree::XPathEngine::Literal;
  5         10  
  5         92  
6 5     5   26 use Tree::XPathEngine::Boolean;
  5         11  
  5         90  
7 5     5   3118 use Tree::XPathEngine::NodeSet;
  5         17  
  5         138  
8 5     5   35 use strict;
  5         10  
  5         1665  
9              
10             sub new {
11 46     46 1 83 my $class = shift;
12 46         90 my ($pp, $name, $params) = @_;
13 46         520 bless {
14             pp => $pp,
15             name => $name,
16             params => $params
17             }, $class;
18             }
19              
20             sub as_string {
21 0     0 1 0 my $self = shift;
22 0         0 my $string = $self->{name} . "(";
23 0         0 my $second;
24 0         0 foreach (@{$self->{params}}) {
  0         0  
25 0 0       0 $string .= "," if $second++;
26 0         0 $string .= $_->as_string;
27             }
28 0         0 $string .= ")";
29 0         0 return $string;
30             }
31              
32             sub evaluate {
33 144     144 1 180 my $self = shift;
34 144         182 my $node = shift;
35 144 50       981 if ($node->isa('Tree::XPathEngine::NodeSet')) {
36 0         0 $node = $node->get_node(1);
37             }
38 144         186 my @params;
39 144         153 foreach my $param (@{$self->{params}}) {
  144         388  
40 54         302 my $results = $param->evaluate($node);
41 54         137 push @params, $results;
42             }
43 144         431 $self->_execute($self->{name}, $node, @params);
44             }
45              
46             sub _execute {
47 144     144   198 my $self = shift;
48 144         292 my ($name, $node, @params) = @_;
49 144         262 $name =~ s/-/_/g;
50 5     5   33 no strict 'refs';
  5         10  
  5         15437  
51 144         450 $self->$name($node, @params);
52             }
53              
54             # All functions should return one of:
55             # Tree::XPathEngine::Number
56             # Tree::XPathEngine::Literal (string)
57             # Tree::XPathEngine::NodeSet
58             # Tree::XPathEngine::Boolean
59              
60             ### NODESET FUNCTIONS ###
61              
62             sub last {
63 3     3 1 5 my $self = shift;
64 3         7 my ($node, @params) = @_;
65 3 100       22 die "last: function doesn't take parameters\n" if (@params);
66 2         10 return Tree::XPathEngine::Number->new($self->{pp}->_get_context_size);
67             }
68              
69             sub position {
70 4     4 1 8 my $self = shift;
71 4         9 my ($node, @params) = @_;
72 4 100       14 if (@params) {
73 1         48 die "position: function doesn't take parameters [ ", @params, " ]\n";
74             }
75             # return pos relative to axis direction
76 3         12 return Tree::XPathEngine::Number->new($self->{pp}->_get_context_pos);
77             }
78              
79             sub count {
80 2     2 1 4 my $self = shift;
81 2         7 my ($node, @params) = @_;
82 2 100       26 die "count: Parameter must be a NodeSet\n" unless $params[0]->isa('Tree::XPathEngine::NodeSet');
83 1         4 return Tree::XPathEngine::Number->new($params[0]->size);
84             }
85              
86             sub id {
87 0     0 1 0 my $self = shift;
88 0         0 my ($node, @params) = @_;
89 0 0       0 die "id: Function takes 1 parameter\n" unless @params == 1;
90 0         0 my $results = Tree::XPathEngine::NodeSet->new();
91 0 0       0 if ($params[0]->isa('Tree::XPathEngine::NodeSet')) {
92             # result is the union of applying id() to the
93             # string value of each node in the nodeset.
94 0         0 foreach my $node ($params[0]->get_nodelist) {
95 0         0 my $string = $node->xpath_string_value;
96 0         0 $results->append($self->id($node, Tree::XPathEngine::Literal->new($string)));
97             }
98             }
99             else { # The actual id() function...
100 0         0 my $string = $self->string($node, $params[0]);
101 0         0 $_ = $string->value; # get perl scalar
102 0         0 my @ids = split; # splits $_
103 0         0 foreach my $id (@ids) {
104 0 0       0 if (my $found = $node->get_element_by_id($id)) {
105 0         0 $results->push($found);
106             }
107             }
108             }
109 0         0 return $results;
110             }
111              
112             sub name {
113 0     0 1 0 my $self = shift;
114 0         0 my ($node, @params) = @_;
115 0 0       0 if (@params > 1) {
    0          
116 0         0 die "name() function takes one or no parameters\n";
117             }
118             elsif (@params) {
119 0         0 my $nodeset = shift(@params);
120 0         0 $node = $nodeset->get_node(1);
121             }
122            
123 0         0 return Tree::XPathEngine::Literal->new($node->xpath_get_name);
124             }
125              
126             ### STRING FUNCTIONS ###
127              
128             sub string {
129 101     101 1 167 my $self = shift;
130 101         141 my ($node, @params) = @_;
131 101 50       245 die "string: Too many parameters\n" if @params > 1;
132 101 50       219 if (@params) {
133 0         0 return Tree::XPathEngine::Literal->new($params[0]->xpath_string_value);
134             }
135            
136             # TODO - this MUST be wrong! - not sure now. -matt
137 101         277 return Tree::XPathEngine::Literal->new($node->xpath_string_value);
138             # default to nodeset with just $node in.
139             }
140              
141             sub concat {
142 1     1 1 2 my $self = shift;
143 1         2 my ($node, @params) = @_;
144 1 50       4 die "concat: Too few parameters\n" if @params < 2;
145 1         3 my $string = join('', map {$_->xpath_string_value} @params);
  2         7  
146 1         5 return Tree::XPathEngine::Literal->new($string);
147             }
148              
149             sub starts_with {
150 2     2 1 5 my $self = shift;
151 2         7 my ($node, @params) = @_;
152 2 50       5 die "starts-with: incorrect number of params\n" unless @params == 2;
153 2         11 my ($string1, $string2) = ($params[0]->xpath_string_value, $params[1]->xpath_string_value);
154 2 100       10 if (substr($string1, 0, length($string2)) eq $string2) {
155 1         7 return Tree::XPathEngine::Boolean->_true;
156             }
157 1         7 return Tree::XPathEngine::Boolean->_false;
158             }
159              
160             sub contains {
161 2     2 1 4 my $self = shift;
162 2         4 my ($node, @params) = @_;
163 2 50       8 die "starts-with: incorrect number of params\n" unless @params == 2;
164 2         9 my $value = $params[1]->xpath_string_value;
165 2 100       6 if ($params[0]->xpath_string_value =~ /\Q$value\E/) {
166 1         6 return Tree::XPathEngine::Boolean->_true;
167             }
168 1         6 return Tree::XPathEngine::Boolean->_false;
169             }
170              
171             sub substring_before {
172 3     3 1 5 my $self = shift;
173 3         6 my ($node, @params) = @_;
174 3 50       10 die "starts-with: incorrect number of params\n" unless @params == 2;
175 3         14 my $long = $params[0]->xpath_string_value;
176 3         10 my $short= $params[1]->xpath_string_value;
177 3 100       48 if( $long=~ m{^(.*?)\Q$short}) {
178 1         5 return Tree::XPathEngine::Literal->new($1);
179             }
180             else {
181 2         9 return Tree::XPathEngine::Literal->new('');
182             }
183             }
184              
185             sub substring_after {
186 1     1 1 2 my $self = shift;
187 1         3 my ($node, @params) = @_;
188 1 50       6 die "starts-with: incorrect number of params\n" unless @params == 2;
189 1         5 my $long = $params[0]->xpath_string_value;
190 1         4 my $short= $params[1]->xpath_string_value;
191 1 50       16 if( $long=~ m{\Q$short\E(.*)$}) {
192 1         6 return Tree::XPathEngine::Literal->new($1);
193             }
194             else {
195 0         0 return Tree::XPathEngine::Literal->new('');
196             }
197             }
198              
199              
200             sub substring {
201 3     3 1 5 my $self = shift;
202 3         7 my ($node, @params) = @_;
203 3 50 33     20 die "substring: Wrong number of parameters\n" if (@params < 2 || @params > 3);
204 3         5 my ($str, $offset, $len);
205 3         14 $str = $params[0]->xpath_string_value;
206 3         14 $offset = $params[1]->value;
207 3         9 $offset--; # uses 1 based offsets
208 3 100       8 if (@params == 3) {
209 2         8 $len = $params[2]->value;
210 2         11 return Tree::XPathEngine::Literal->new(substr($str, $offset, $len));
211             }
212             else {
213 1         7 return Tree::XPathEngine::Literal->new(substr($str, $offset));
214             }
215             }
216              
217             sub string_length {
218 2     2 1 4 my $self = shift;
219 2         4 my ($node, @params) = @_;
220 2 50       14 die "string-length: Wrong number of params\n" if @params > 1;
221 2 50       8 if (@params) {
222 2         9 return Tree::XPathEngine::Number->new(length($params[0]->xpath_string_value));
223             }
224             else {
225 0         0 return Tree::XPathEngine::Number->new(
226             length($node->xpath_string_value)
227             );
228             }
229             }
230              
231             sub normalize_space {
232 4     4 1 5 my $self = shift;
233 4         8 my ($node, @params) = @_;
234 4 50       11 die "normalize-space: Wrong number of params\n" if @params > 1;
235 4         7 my $str;
236 4 50       9 if (@params) {
237 4         14 $str = $params[0]->xpath_string_value;
238             }
239             else {
240 0         0 $str = $node->xpath_string_value;
241             }
242 4         14 $str =~ s/^\s*//;
243 4         18 $str =~ s/\s*$//;
244 4         16 $str =~ s/\s+/ /g;
245 4         16 return Tree::XPathEngine::Literal->new($str);
246             }
247              
248             sub translate {
249 3     3 1 5 my $self = shift;
250 3         7 my ($node, @params) = @_;
251 3 50       9 die "translate: Wrong number of params\n" if @params != 3;
252 3         13 local $_ = $params[0]->xpath_string_value;
253 3         11 my $find = $params[1]->xpath_string_value;
254 3         9 my $repl = $params[2]->xpath_string_value;
255 3         9 $repl= substr( $repl, 0, length( $find));
256 3         6 my %repl;
257 3         19 @repl{split //, $find}= split( //, $repl);
258 3 100       20 s{(.)}{exists $repl{$1} ? defined $repl{$1} ? $repl{$1} : '' : $1 }ges;
  18 100       70  
259 3         15 return Tree::XPathEngine::Literal->new($_);
260             }
261              
262             ### BOOLEAN FUNCTIONS ###
263              
264             sub boolean {
265 2     2 1 3 my $self = shift;
266 2         6 my ($node, @params) = @_;
267 2 50       6 die "boolean: Incorrect number of parameters\n" if @params != 1;
268 2         13 return $params[0]->xpath_to_boolean;
269             }
270              
271             sub not {
272 1     1 1 3 my $self = shift;
273 1         2 my ($node, @params) = @_;
274 1 50       8 $params[0] = $params[0]->xpath_to_boolean unless $params[0]->isa('Tree::XPathEngine::Boolean');
275 1 50       9 $params[0]->value ? Tree::XPathEngine::Boolean->_false : Tree::XPathEngine::Boolean->_true;
276             }
277              
278             sub true {
279 1     1 1 2 my $self = shift;
280 1         3 my ($node, @params) = @_;
281 1 50       5 die "true: function takes no parameters\n" if @params > 0;
282 1         9 Tree::XPathEngine::Boolean->_true;
283             }
284              
285             sub false {
286 2     2 1 3 my $self = shift;
287 2         3 my ($node, @params) = @_;
288 2 50       7 die "true: function takes no parameters\n" if @params > 0;
289 2         10 Tree::XPathEngine::Boolean->_false;
290             }
291              
292             sub lang {
293 0     0 1 0 my $self = shift;
294 0         0 my ($node, @params) = @_;
295 0 0       0 die "lang: function takes 1 parameter\n" if @params != 1;
296 0         0 my $lang = $node->findvalue('(ancestor-or-self::*[@xml:lang]/@xml:lang)[last()]');
297 0         0 my $lclang = lc($params[0]->xpath_string_value);
298             # warn("Looking for lang($lclang) in $lang\n");
299 0 0       0 if (substr(lc($lang), 0, length($lclang)) eq $lclang) {
300 0         0 return Tree::XPathEngine::Boolean->_true;
301             }
302             else {
303 0         0 return Tree::XPathEngine::Boolean->_false;
304             }
305             }
306              
307             ### NUMBER FUNCTIONS ###
308              
309             sub number {
310 11     11 1 19 my $self = shift;
311 11         21 my ($node, @params) = @_;
312 11 50       36 die "number: Too many parameters\n" if @params > 1;
313 11 100       58 if (@params) {
314 5 50       38 if ($params[0]->isa('Tree::XPathEngine::Node')) {
315 0         0 return Tree::XPathEngine::Number->new(
316             $params[0]->xpath_string_value
317             );
318             }
319 5         28 return $params[0]->xpath_to_number;
320             }
321            
322 6         20 return Tree::XPathEngine::Number->new( $node->xpath_string_value );
323             }
324              
325             sub sum {
326 1     1 1 3 my $self = shift;
327 1         5 my ($node, @params) = @_;
328 1 50       9 die "sum: Parameter must be a NodeSet\n" unless $params[0]->isa('Tree::XPathEngine::NodeSet');
329 1         2 my $sum = 0;
330 1         6 foreach my $node ($params[0]->get_nodelist) {
331 5         12 $sum += $self->number($node)->value;
332             }
333 1         6 return Tree::XPathEngine::Number->new($sum);
334             }
335              
336             sub floor {
337 0     0 1   my $self = shift;
338 0           my ($node, @params) = @_;
339 0           require POSIX;
340 0           my $num = $self->number($node, @params);
341 0           return Tree::XPathEngine::Number->new(
342             POSIX::floor($num->value));
343             }
344              
345             sub ceiling {
346 0     0 1   my $self = shift;
347 0           my ($node, @params) = @_;
348 0           require POSIX;
349 0           my $num = $self->number($node, @params);
350 0           return Tree::XPathEngine::Number->new(
351             POSIX::ceil($num->value));
352             }
353              
354             sub round {
355 0     0 1   my $self = shift;
356 0           my ($node, @params) = @_;
357 0           my $num = $self->number($node, @params);
358 0           require POSIX;
359 0           return Tree::XPathEngine::Number->new(
360             POSIX::floor($num->value + 0.5)); # Yes, I know the spec says don't do this...
361             }
362              
363             1;
364              
365             __END__