[Summary view] [Print] [Text view]

   1  # $Id: Function.pm,v 1.26 2002/12/26 17:24:50 matt Exp $
   2  
   3  package XML::XPath::Function;
   4  use XML::XPath::Number;
   5  use XML::XPath::Literal;
   6  use XML::XPath::Boolean;
   7  use XML::XPath::NodeSet;
   8  use XML::XPath::Node::Attribute;
   9  use strict;
  10  
  11  sub 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  
  21  sub 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  
  33  sub 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  
  50  sub 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  
  64  sub _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  
  80  sub 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  
  87  sub 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  
  97  sub 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  
 104  sub 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  
 130  sub 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  
 144  sub namespace_uri {
 145      my $self = shift;
 146      my ($node, @params) = @_;
 147      die "namespace-uri: Function not supported\n";
 148  }
 149  
 150  sub 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  
 166  sub 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  
 179  sub 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  
 187  sub 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  
 198  sub 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  
 211  sub 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  
 223  sub 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  
 235  sub 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  
 249  sub 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  
 263  sub 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  
 280  sub 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  
 293  sub 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  
 300  sub 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  
 307  sub 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  
 314  sub 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  
 321  sub 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  
 338  sub 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  
 354  sub 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  
 365  sub 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  
 374  sub 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  
 383  sub 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  
 392  1;