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