source: trunk/gsdl/perllib/cpan/XML/XPath/Function.pm@ 7909

Last change on this file since 7909 was 7909, checked in by mdewsnip, 17 years ago

CPAN module for processing XPath expressions.

  • Property svn:keywords set to Author Date Id Revision
File size: 10.0 KB
Line 
1# $Id: Function.pm 7909 2004-08-06 05:11:55Z mdewsnip $
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;
Note: See TracBrowser for help on using the repository browser.