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