<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># $Id: Function.pm,v 1.26 2002/12/26 17:24:50 matt Exp $

package XML::XPathEngine::Function;
use XML::XPathEngine::Number;
use XML::XPathEngine::Literal;
use XML::XPathEngine::Boolean;
use XML::XPathEngine::NodeSet;
use strict;

sub new {
    my $class = shift;
    my ($pp, $name, $params) = @_;
    bless { 
        pp =&gt; $pp, 
        name =&gt; $name, 
        params =&gt; $params 
        }, $class;
}

sub as_string {
    my $self = shift;
    my $string = $self-&gt;{name} . "(";
    my $second;
    foreach (@{$self-&gt;{params}}) {
        $string .= "," if $second++;
        $string .= $_-&gt;as_string;
    }
    $string .= ")";
    return $string;
}

sub as_xml {
    my $self = shift;
    my $string = "&lt;Function name=\"$self-&gt;{name}\"";
    my $params = "";
    foreach (@{$self-&gt;{params}}) {
        $params .= "&lt;Param&gt;" . $_-&gt;as_xml . "&lt;/Param&gt;\n";
    }
    if ($params) {
        $string .= "&gt;\n$params&lt;/Function&gt;\n";
    }
    else {
        $string .= " /&gt;\n";
    }
    
    return $string;
}

sub evaluate {
    my $self = shift;
    my $node = shift;
    while ($node-&gt;isa('XML::XPathEngine::NodeSet')) {
        $node = $node-&gt;get_node(1);
    }
    my @params;
    foreach my $param (@{$self-&gt;{params}}) {
        my $results = $param-&gt;evaluate($node);
        push @params, $results;
    }
    $self-&gt;_execute($self-&gt;{name}, $node, @params);
}

sub _execute {
    my $self = shift;
    my ($name, $node, @params) = @_;
    $name =~ s/-/_/g;
    no strict 'refs';
    $self-&gt;$name($node, @params);
}

# All functions should return one of:
# XML::XPathEngine::Number
# XML::XPathEngine::Literal (string)
# XML::XPathEngine::NodeSet
# XML::XPathEngine::Boolean

### NODESET FUNCTIONS ###

sub last {
    my $self = shift;
    my ($node, @params) = @_;
    die "last: function doesn't take parameters\n" if (@params);
    return XML::XPathEngine::Number-&gt;new($self-&gt;{pp}-&gt;_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::XPathEngine::Number-&gt;new($self-&gt;{pp}-&gt;_get_context_pos);
}

sub count {
    my $self = shift;
    my ($node, @params) = @_;
    die "count: Parameter must be a NodeSet\n" unless $params[0]-&gt;isa('XML::XPathEngine::NodeSet');
    return XML::XPathEngine::Number-&gt;new($params[0]-&gt;size);
}

sub id {
    my $self = shift;
    my ($node, @params) = @_;
    die "id: Function takes 1 parameter\n" unless @params == 1;
    my $results = XML::XPathEngine::NodeSet-&gt;new();
    if ($params[0]-&gt;isa('XML::XPathEngine::NodeSet')) {
        # result is the union of applying id() to the
        # string value of each node in the nodeset.
        foreach my $node ($params[0]-&gt;get_nodelist) {
            my $string = $node-&gt;string_value;
            $results-&gt;append($self-&gt;id($node, XML::XPathEngine::Literal-&gt;new($string)));
        }
    }
    else { # The actual id() function...
        my $string = $self-&gt;string($node, $params[0]);
        $_ = $string-&gt;value; # get perl scalar
        my @ids = split; # splits $_
        if ($node-&gt;isAttributeNode) {
            warn "calling \($node-&gt;getParentNode-&gt;getRootNode-&gt;getChildNodes)-&gt;[0] on attribute node\n";
            $node = ($node-&gt;getParentNode-&gt;getRootNode-&gt;getChildNodes)-&gt;[0];
        }
        foreach my $id (@ids) {
            if (my $found = $node-&gt;getElementById($id)) {
                $results-&gt;push($found);
            }
        }
    }
    return $results;
}

sub local_name {
    my $self = shift;
    my ($node, @params) = @_;
    if (@params &gt; 1) {
        die "name() function takes one or no parameters\n";
    }
    elsif (@params) {
        my $nodeset = shift(@params);
        $node = $nodeset-&gt;get_node(1);
    }
    
    return XML::XPathEngine::Literal-&gt;new($node-&gt;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 &gt; 1) {
        die "name() function takes one or no parameters\n";
    }
    elsif (@params) {
        my $nodeset = shift(@params);
        $node = $nodeset-&gt;get_node(1);
    }
    
    return XML::XPathEngine::Literal-&gt;new($node-&gt;getName);
}

### STRING FUNCTIONS ###

sub string {
    my $self = shift;
    my ($node, @params) = @_;
    die "string: Too many parameters\n" if @params &gt; 1;
    if (@params) {
        return XML::XPathEngine::Literal-&gt;new($params[0]-&gt;string_value);
    }
    
    # TODO - this MUST be wrong! - not sure now. -matt
    return XML::XPathEngine::Literal-&gt;new($node-&gt;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 &lt; 2;
    my $string = join('', map {$_-&gt;string_value} @params);
    return XML::XPathEngine::Literal-&gt;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]-&gt;string_value, $params[1]-&gt;string_value);
    if (substr($string1, 0, length($string2)) eq $string2) {
        return XML::XPathEngine::Boolean-&gt;True;
    }
    return XML::XPathEngine::Boolean-&gt;False;
}

sub contains {
    my $self = shift;
    my ($node, @params) = @_;
    die "starts-with: incorrect number of params\n" unless @params == 2;
    my $value = $params[1]-&gt;string_value;
    if ($params[0]-&gt;string_value =~ /(.*?)\Q$value\E(.*)/) {
        return XML::XPathEngine::Boolean-&gt;True;
    }
    return XML::XPathEngine::Boolean-&gt;False;
}

sub substring_before {
    my $self = shift;
    my ($node, @params) = @_;
    die "starts-with: incorrect number of params\n" unless @params == 2;
    my $long = $params[0]-&gt;string_value;
    my $short= $params[1]-&gt;string_value;
    if( $long=~ m{^(.*?)\Q$short})  {
        return XML::XPathEngine::Literal-&gt;new($1); 
    }
    else {
        return XML::XPathEngine::Literal-&gt;new('');
    }
}

sub substring_after {
    my $self = shift;
    my ($node, @params) = @_;
    die "starts-with: incorrect number of params\n" unless @params == 2;
    my $long = $params[0]-&gt;string_value;
    my $short= $params[1]-&gt;string_value;
    if( $long=~ m{\Q$short\E(.*)$}) {
        return XML::XPathEngine::Literal-&gt;new($1);
    }
    else {
        return XML::XPathEngine::Literal-&gt;new('');
    }
}

sub substring {
    my $self = shift;
    my ($node, @params) = @_;
    die "substring: Wrong number of parameters\n" if (@params &lt; 2 || @params &gt; 3);
    my ($str, $offset, $len);
    $str = $params[0]-&gt;string_value;
    $offset = $params[1]-&gt;value;
    $offset--; # uses 1 based offsets
    if (@params == 3) {
        $len = $params[2]-&gt;value;
        return XML::XPathEngine::Literal-&gt;new(substr($str, $offset, $len));
    }
    else {
        return XML::XPathEngine::Literal-&gt;new(substr($str, $offset));
    }
}

sub string_length {
    my $self = shift;
    my ($node, @params) = @_;
    die "string-length: Wrong number of params\n" if @params &gt; 1;
    if (@params) {
        return XML::XPathEngine::Number-&gt;new(length($params[0]-&gt;string_value));
    }
    else {
        return XML::XPathEngine::Number-&gt;new(
                length($node-&gt;string_value)
                );
    }
}

sub normalize_space {
    my $self = shift;
    my ($node, @params) = @_;
    die "normalize-space: Wrong number of params\n" if @params &gt; 1;
    my $str;
    if (@params) {
        $str = $params[0]-&gt;string_value;
    }
    else {
        $str = $node-&gt;string_value;
    }
    $str =~ s/^\s*//;
    $str =~ s/\s*$//;
    $str =~ s/\s+/ /g;
    return XML::XPathEngine::Literal-&gt;new($str);
}

sub translate {
    my $self = shift;
    my ($node, @params) = @_;
    die "translate: Wrong number of params\n" if @params != 3;
    local $_ = $params[0]-&gt;string_value;
    my $find = $params[1]-&gt;string_value;
    my $repl = $params[2]-&gt;string_value;
    $repl= substr( $repl, 0, length( $find));
    my %repl;
    @repl{split //, $find}= split( //, $repl);
    s{(.)}{exists $repl{$1} ? defined $repl{$1} ? $repl{$1} : '' : $1 }ges;
    return XML::XPathEngine::Literal-&gt;new($_);
}


### BOOLEAN FUNCTIONS ###

sub boolean {
    my $self = shift;
    my ($node, @params) = @_;
    die "boolean: Incorrect number of parameters\n" if @params != 1;
    return $params[0]-&gt;to_boolean;
}

sub not {
    my $self = shift;
    my ($node, @params) = @_;
    $params[0] = $params[0]-&gt;to_boolean unless $params[0]-&gt;isa('XML::XPathEngine::Boolean');
    $params[0]-&gt;value ? XML::XPathEngine::Boolean-&gt;False : XML::XPathEngine::Boolean-&gt;True;
}

sub true {
    my $self = shift;
    my ($node, @params) = @_;
    die "true: function takes no parameters\n" if @params &gt; 0;
    XML::XPathEngine::Boolean-&gt;True;
}

sub false {
    my $self = shift;
    my ($node, @params) = @_;
    die "true: function takes no parameters\n" if @params &gt; 0;
    XML::XPathEngine::Boolean-&gt;False;
}

sub lang {
    my $self = shift;
    my ($node, @params) = @_;
    die "lang: function takes 1 parameter\n" if @params != 1;
    my $lang = $node-&gt;findvalue('(ancestor-or-self::*[@xml:lang]/@xml:lang)[1]');
    my $lclang = lc($params[0]-&gt;string_value);
    # warn("Looking for lang($lclang) in $lang\n");
    if (substr(lc($lang), 0, length($lclang)) eq $lclang) {
        return XML::XPathEngine::Boolean-&gt;True;
    }
    else {
        return XML::XPathEngine::Boolean-&gt;False;
    }
}

### NUMBER FUNCTIONS ###

sub number {
    my $self = shift;
    my ($node, @params) = @_;
    die "number: Too many parameters\n" if @params &gt; 1;
    if (@params) {
        if ($params[0]-&gt;isa('XML::XPathEngine::Node')) {
            return XML::XPathEngine::Number-&gt;new(
                    $params[0]-&gt;string_value
                    );
        }
        return $params[0]-&gt;to_number;
    }
    
    return XML::XPathEngine::Number-&gt;new( $node-&gt;string_value );
}

sub sum {
    my $self = shift;
    my ($node, @params) = @_;
    die "sum: Parameter must be a NodeSet\n" unless $params[0]-&gt;isa('XML::XPathEngine::NodeSet');
    my $sum = 0;
    foreach my $node ($params[0]-&gt;get_nodelist) {
        $sum += $self-&gt;number($node)-&gt;value;
    }
    return XML::XPathEngine::Number-&gt;new($sum);
}

sub floor {
    my $self = shift;
    my ($node, @params) = @_;
    require POSIX;
    my $num = $self-&gt;number($node, @params);
    return XML::XPathEngine::Number-&gt;new(
            POSIX::floor($num-&gt;value));
}

sub ceiling {
    my $self = shift;
    my ($node, @params) = @_;
    require POSIX;
    my $num = $self-&gt;number($node, @params);
    return XML::XPathEngine::Number-&gt;new(
            POSIX::ceil($num-&gt;value));
}

sub round {
    my $self = shift;
    my ($node, @params) = @_;
    my $num = $self-&gt;number($node, @params);
    require POSIX;
    return XML::XPathEngine::Number-&gt;new(
            POSIX::floor($num-&gt;value + 0.5)); # Yes, I know the spec says don't do this...
}

1;
</pre></body></html>