diff options
Diffstat (limited to 'XPath/Function.pm')
| -rw-r--r-- | XPath/Function.pm | 392 |
1 files changed, 392 insertions, 0 deletions
diff --git a/XPath/Function.pm b/XPath/Function.pm new file mode 100644 index 0000000..e29b379 --- /dev/null +++ b/XPath/Function.pm @@ -0,0 +1,392 @@ +# $Id: Function.pm,v 1.26 2002/12/26 17:24:50 matt Exp $ + +package XML::XPath::Function; +use XML::XPath::Number; +use XML::XPath::Literal; +use XML::XPath::Boolean; +use XML::XPath::NodeSet; +use XML::XPath::Node::Attribute; +use strict; + +sub new { + my $class = shift; + my ($pp, $name, $params) = @_; + bless { + pp => $pp, + name => $name, + params => $params + }, $class; +} + +sub as_string { + my $self = shift; + my $string = $self->{name} . "("; + my $second; + foreach (@{$self->{params}}) { + $string .= "," if $second++; + $string .= $_->as_string; + } + $string .= ")"; + return $string; +} + +sub as_xml { + my $self = shift; + my $string = "<Function name=\"$self->{name}\""; + my $params = ""; + foreach (@{$self->{params}}) { + $params .= "<Param>" . $_->as_string . "</Param>\n"; + } + if ($params) { + $string .= ">\n$params</Function>\n"; + } + else { + $string .= " />\n"; + } + + return $string; +} + +sub evaluate { + my $self = shift; + my $node = shift; + if ($node->isa('XML::XPath::NodeSet')) { + $node = $node->get_node(1); + } + my @params; + foreach my $param (@{$self->{params}}) { + my $results = $param->evaluate($node); + push @params, $results; + } + $self->_execute($self->{name}, $node, @params); +} + +sub _execute { + my $self = shift; + my ($name, $node, @params) = @_; + $name =~ s/-/_/g; + no strict 'refs'; + $self->$name($node, @params); +} + +# All functions should return one of: +# XML::XPath::Number +# XML::XPath::Literal (string) +# XML::XPath::NodeSet +# XML::XPath::Boolean + +### NODESET FUNCTIONS ### + +sub last { + my $self = shift; + my ($node, @params) = @_; + die "last: function doesn't take parameters\n" if (@params); + return XML::XPath::Number->new($self->{pp}->get_context_size); +} + +sub position { + my $self = shift; + my ($node, @params) = @_; + if (@params) { + die "position: function doesn't take parameters [ ", @params, " ]\n"; + } + # return pos relative to axis direction + return XML::XPath::Number->new($self->{pp}->get_context_pos); +} + +sub count { + my $self = shift; + my ($node, @params) = @_; + die "count: Parameter must be a NodeSet\n" unless $params[0]->isa('XML::XPath::NodeSet'); + return XML::XPath::Number->new($params[0]->size); +} + +sub id { + my $self = shift; + my ($node, @params) = @_; + die "id: Function takes 1 parameter\n" unless @params == 1; + my $results = XML::XPath::NodeSet->new(); + if ($params[0]->isa('XML::XPath::NodeSet')) { + # result is the union of applying id() to the + # string value of each node in the nodeset. + foreach my $node ($params[0]->get_nodelist) { + my $string = $node->string_value; + $results->append($self->id($node, XML::XPath::Literal->new($string))); + } + } + else { # The actual id() function... + my $string = $self->string($node, $params[0]); + $_ = $string->value; # get perl scalar + my @ids = split; # splits $_ + foreach my $id (@ids) { + if (my $found = $node->getElementById($id)) { + $results->push($found); + } + } + } + return $results; +} + +sub local_name { + my $self = shift; + my ($node, @params) = @_; + if (@params > 1) { + die "name() function takes one or no parameters\n"; + } + elsif (@params) { + my $nodeset = shift(@params); + $node = $nodeset->get_node(1); + } + + return XML::XPath::Literal->new($node->getLocalName); +} + +sub namespace_uri { + my $self = shift; + my ($node, @params) = @_; + die "namespace-uri: Function not supported\n"; +} + +sub name { + my $self = shift; + my ($node, @params) = @_; + if (@params > 1) { + die "name() function takes one or no parameters\n"; + } + elsif (@params) { + my $nodeset = shift(@params); + $node = $nodeset->get_node(1); + } + + return XML::XPath::Literal->new($node->getName); +} + +### STRING FUNCTIONS ### + +sub string { + my $self = shift; + my ($node, @params) = @_; + die "string: Too many parameters\n" if @params > 1; + if (@params) { + return XML::XPath::Literal->new($params[0]->string_value); + } + + # TODO - this MUST be wrong! - not sure now. -matt + return XML::XPath::Literal->new($node->string_value); + # default to nodeset with just $node in. +} + +sub concat { + my $self = shift; + my ($node, @params) = @_; + die "concat: Too few parameters\n" if @params < 2; + my $string = join('', map {$_->string_value} @params); + return XML::XPath::Literal->new($string); +} + +sub starts_with { + my $self = shift; + my ($node, @params) = @_; + die "starts-with: incorrect number of params\n" unless @params == 2; + my ($string1, $string2) = ($params[0]->string_value, $params[1]->string_value); + if (substr($string1, 0, length($string2)) eq $string2) { + return XML::XPath::Boolean->True; + } + return XML::XPath::Boolean->False; +} + +sub contains { + my $self = shift; + my ($node, @params) = @_; + die "starts-with: incorrect number of params\n" unless @params == 2; + my $value = $params[1]->string_value; + if ($params[0]->string_value =~ /(.*?)\Q$value\E(.*)/) { + # $1 and $2 stored for substring funcs below + # TODO: Fix this nasty implementation! + return XML::XPath::Boolean->True; + } + return XML::XPath::Boolean->False; +} + +sub substring_before { + my $self = shift; + my ($node, @params) = @_; + die "starts-with: incorrect number of params\n" unless @params == 2; + if ($self->contains($node, @params)->value) { + return XML::XPath::Literal->new($1); # hope that works! + } + else { + return XML::XPath::Literal->new(''); + } +} + +sub substring_after { + my $self = shift; + my ($node, @params) = @_; + die "starts-with: incorrect number of params\n" unless @params == 2; + if ($self->contains($node, @params)->value) { + return XML::XPath::Literal->new($2); + } + else { + return XML::XPath::Literal->new(''); + } +} + +sub substring { + my $self = shift; + my ($node, @params) = @_; + die "substring: Wrong number of parameters\n" if (@params < 2 || @params > 3); + my ($str, $offset, $len); + $str = $params[0]->string_value; + $offset = $params[1]->value; + $offset--; # uses 1 based offsets + if (@params == 3) { + $len = $params[2]->value; + } + return XML::XPath::Literal->new(substr($str, $offset, $len)); +} + +sub string_length { + my $self = shift; + my ($node, @params) = @_; + die "string-length: Wrong number of params\n" if @params > 1; + if (@params) { + return XML::XPath::Number->new(length($params[0]->string_value)); + } + else { + return XML::XPath::Number->new( + length($node->string_value) + ); + } +} + +sub normalize_space { + my $self = shift; + my ($node, @params) = @_; + die "normalize-space: Wrong number of params\n" if @params > 1; + my $str; + if (@params) { + $str = $params[0]->string_value; + } + else { + $str = $node->string_value; + } + $str =~ s/^\s*//; + $str =~ s/\s*$//; + $str =~ s/\s+/ /g; + return XML::XPath::Literal->new($str); +} + +sub translate { + my $self = shift; + my ($node, @params) = @_; + die "translate: Wrong number of params\n" if @params != 3; + local $_ = $params[0]->string_value; + my $find = $params[1]->string_value; + my $repl = $params[2]->string_value; + eval "tr/\\Q$find\\E/\\Q$repl\\E/d, 1" or die $@; + return XML::XPath::Literal->new($_); +} + +### BOOLEAN FUNCTIONS ### + +sub boolean { + my $self = shift; + my ($node, @params) = @_; + die "boolean: Incorrect number of parameters\n" if @params != 1; + return $params[0]->to_boolean; +} + +sub not { + my $self = shift; + my ($node, @params) = @_; + $params[0] = $params[0]->to_boolean unless $params[0]->isa('XML::XPath::Boolean'); + $params[0]->value ? XML::XPath::Boolean->False : XML::XPath::Boolean->True; +} + +sub true { + my $self = shift; + my ($node, @params) = @_; + die "true: function takes no parameters\n" if @params > 0; + XML::XPath::Boolean->True; +} + +sub false { + my $self = shift; + my ($node, @params) = @_; + die "true: function takes no parameters\n" if @params > 0; + XML::XPath::Boolean->False; +} + +sub lang { + my $self = shift; + my ($node, @params) = @_; + die "lang: function takes 1 parameter\n" if @params != 1; + my $lang = $node->findvalue('(ancestor-or-self::*[@xml:lang]/@xml:lang)[last()]'); + my $lclang = lc($params[0]->string_value); + # warn("Looking for lang($lclang) in $lang\n"); + if (substr(lc($lang), 0, length($lclang)) eq $lclang) { + return XML::XPath::Boolean->True; + } + else { + return XML::XPath::Boolean->False; + } +} + +### NUMBER FUNCTIONS ### + +sub number { + my $self = shift; + my ($node, @params) = @_; + die "number: Too many parameters\n" if @params > 1; + if (@params) { + if ($params[0]->isa('XML::XPath::Node')) { + return XML::XPath::Number->new( + $params[0]->string_value + ); + } + return $params[0]->to_number; + } + + return XML::XPath::Number->new( $node->string_value ); +} + +sub sum { + my $self = shift; + my ($node, @params) = @_; + die "sum: Parameter must be a NodeSet\n" unless $params[0]->isa('XML::XPath::NodeSet'); + my $sum = 0; + foreach my $node ($params[0]->get_nodelist) { + $sum += $self->number($node)->value; + } + return XML::XPath::Number->new($sum); +} + +sub floor { + my $self = shift; + my ($node, @params) = @_; + require POSIX; + my $num = $self->number($node, @params); + return XML::XPath::Number->new( + POSIX::floor($num->value)); +} + +sub ceiling { + my $self = shift; + my ($node, @params) = @_; + require POSIX; + my $num = $self->number($node, @params); + return XML::XPath::Number->new( + POSIX::ceil($num->value)); +} + +sub round { + my $self = shift; + my ($node, @params) = @_; + my $num = $self->number($node, @params); + require POSIX; + return XML::XPath::Number->new( + POSIX::floor($num->value + 0.5)); # Yes, I know the spec says don't do this... +} + +1; |