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