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