expr.pm

网页留言本,比一般的留言簿管用

# $Id: Expr.pm 4532 2004-05-11 05:15:40Z ezra $

package XML::XPath::Expr;
use strict;

sub new {
    my $class = shift;
    my ($pp) = @_;
    bless { predicates => [], pp => $pp }, $class;
}

sub as_string {
    my $self = shift;
    local $^W; # Use of uninitialized value! grrr
    my $string = "(" . $self->{lhs}->as_string;
    $string .= " " . $self->{op} . " " if defined $self->{op};
    $string .= $self->{rhs}->as_string if defined $self->{rhs};
    $string .= ")";
    foreach my $predicate (@{$self->{predicates}}) {
        $string .= "[" . $predicate->as_string . "]";
    }
    return $string;
}

sub as_xml {
    my $self = shift;
    local $^W; # Use of uninitialized value! grrr
    my $string;
    if (defined $self->{op}) {
        $string .= $self->op_xml();
    }
    else {
        $string .= $self->{lhs}->as_xml();
    }
    foreach my $predicate (@{$self->{predicates}}) {
        $string .= "<Predicate>\n" . $predicate->as_xml() . "</Predicate>\n";
    }
    return $string;
}

sub op_xml {
    my $self = shift;
    my $op = $self->{op};

    my $tag;    
    for ($op) {
        /^or$/    && do {
                    $tag = "Or";
                };
        /^and$/    && do {
                    $tag = "And";
                };
        /^=$/    && do {
                    $tag = "Equals";
                };
        /^!=$/    && do {
                    $tag = "NotEquals";
                };
        /^<=$/    && do {
                    $tag = "LessThanOrEquals";
                };
        /^>=$/    && do {
                    $tag = "GreaterThanOrEquals";
                };
        /^>$/    && do {
                    $tag = "GreaterThan";
                };
        /^<$/    && do {
                    $tag = "LessThan";
                };
        /^\+$/    && do {
                    $tag = "Plus";
                };
        /^-$/    && do {
                    $tag = "Minus";
                };
        /^div$/    && do {
                    $tag = "Div";
                };
        /^mod$/    && do {
                    $tag = "Mod";
                };
        /^\*$/    && do {
                    $tag = "Multiply";
                };
        /^\|$/    && do {
                    $tag = "Union";
                };
    }
    
    return "<$tag>\n" . $self->{lhs}->as_xml() . $self->{rhs}->as_xml() . "</$tag>\n";
}

sub set_lhs {
    my $self = shift;
    $self->{lhs} = $_[0];
}

sub set_op {
    my $self = shift;
    $self->{op} = $_[0];
}

sub set_rhs {
    my $self = shift;
    $self->{rhs} = $_[0];
}

sub push_predicate {
    my $self = shift;
    
    die "Only 1 predicate allowed on FilterExpr in W3C XPath 1.0"
            if @{$self->{predicates}};
    
    push @{$self->{predicates}}, $_[0];
}

sub get_lhs { $_[0]->{lhs}; }
sub get_rhs { $_[0]->{rhs}; }
sub get_op { $_[0]->{op}; }

sub evaluate {
    my $self = shift;
    my $node = shift;
    
    # If there's an op, result is result of that op.
    # If no op, just resolve Expr
    
#    warn "Evaluate Expr: ", $self->as_string, "\n";
    
    my $results;
    
    if ($self->{op}) {
        die ("No RHS of ", $self->as_string) unless $self->{rhs};
        $results = $self->op_eval($node);
    }
    else {
        $results = $self->{lhs}->evaluate($node);
    }
    
    if (my @predicates = @{$self->{predicates}}) {
        if (!$results->isa('XML::XPath::NodeSet')) {
            die "Can't have predicates execute on object type: " . ref($results);
        }
        
        # filter initial nodeset by each predicate
        foreach my $predicate (@{$self->{predicates}}) {
            $results = $self->filter_by_predicate($results, $predicate);
        }
    }
    
    return $results;
}

sub op_eval {
    my $self = shift;
    my $node = shift;
    
    my $op = $self->{op};
    
    for ($op) {
        /^or$/    && do {
                    return op_or($node, $self->{lhs}, $self->{rhs});
                };
        /^and$/    && do {
                    return op_and($node, $self->{lhs}, $self->{rhs});
                };
        /^=$/    && do {
                    return op_equals($node, $self->{lhs}, $self->{rhs});
                };
        /^!=$/    && do {
                    return op_nequals($node, $self->{lhs}, $self->{rhs});
                };
        /^<=$/    && do {
                    return op_le($node, $self->{lhs}, $self->{rhs});
                };
        /^>=$/    && do {
                    return op_ge($node, $self->{lhs}, $self->{rhs});
                };
        /^>$/    && do {
                    return op_gt($node, $self->{lhs}, $self->{rhs});
                };
        /^<$/    && do {
                    return op_lt($node, $self->{lhs}, $self->{rhs});
                };
        /^\+$/    && do {
                    return op_plus($node, $self->{lhs}, $self->{rhs});
                };
        /^-$/    && do {
                    return op_minus($node, $self->{lhs}, $self->{rhs});
                };
        /^div$/    && do {
                    return op_div($node, $self->{lhs}, $self->{rhs});
                };
        /^mod$/    && do {
                    return op_mod($node, $self->{lhs}, $self->{rhs});
                };
        /^\*$/    && do {
                    return op_mult($node, $self->{lhs}, $self->{rhs});
                };
        /^\|$/    && do {
                    return op_union($node, $self->{lhs}, $self->{rhs});
                };
        
        die "No such operator, or operator unimplemented in ", $self->as_string, "\n";
    }
}

# Operators

use XML::XPath::Boolean;

sub op_or {
    my ($node, $lhs, $rhs) = @_;
    if($lhs->evaluate($node)->to_boolean->value) {
        return XML::XPath::Boolean->True;
    }
    else {
        return $rhs->evaluate($node)->to_boolean;
    }
}

sub op_and {
    my ($node, $lhs, $rhs) = @_;
    if( ! $lhs->evaluate($node)->to_boolean->value ) {
        return XML::XPath::Boolean->False;
    }
    else {
        return $rhs->evaluate($node)->to_boolean;
    }
}

sub op_equals {
    my ($node, $lhs, $rhs) = @_;

    my $lh_results = $lhs->evaluate($node);
    my $rh_results = $rhs->evaluate($node);
    
    if ($lh_results->isa('XML::XPath::NodeSet') &&
            $rh_results->isa('XML::XPath::NodeSet')) {
        # True if and only if there is a node in the
        # first set and a node in the second set such
        # that the result of performing the comparison
        # on the string-values of the two nodes is true.
        foreach my $lhnode ($lh_results->get_nodelist) {
            foreach my $rhnode ($rh_results->get_nodelist) {
                if ($lhnode->string_value eq $rhnode->string_value) {
                    return XML::XPath::Boolean->True;
                }
            }
        }
        return XML::XPath::Boolean->False;
    }
    elsif (($lh_results->isa('XML::XPath::NodeSet') ||
            $rh_results->isa('XML::XPath::NodeSet')) &&
            (!$lh_results->isa('XML::XPath::NodeSet') ||
             !$rh_results->isa('XML::XPath::NodeSet'))) {
        # (that says: one is a nodeset, and one is not a nodeset)
        
        my ($nodeset, $other);
        if ($lh_results->isa('XML::XPath::NodeSet')) {
            $nodeset = $lh_results;
            $other = $rh_results;
        }
        else {
            $nodeset = $rh_results;
            $other = $lh_results;
        }
        
        # True if and only if there is a node in the
        # nodeset such that the result of performing
        # the comparison on <type>(string_value($node))
        # is true.
        if ($other->isa('XML::XPath::Number')) {
            foreach my $node ($nodeset->get_nodelist) {
                if ($node->string_value == $other->value) {
                    return XML::XPath::Boolean->True;
                }
            }
        }
        elsif ($other->isa('XML::XPath::Literal')) {
            foreach my $node ($nodeset->get_nodelist) {
                if ($node->string_value eq $other->value) {
                    return XML::XPath::Boolean->True;
                }
            }
        }
        elsif ($other->isa('XML::XPath::Boolean')) {
            if ($nodeset->to_boolean->value == $other->value) {
                return XML::XPath::Boolean->True;
            }
        }

        return XML::XPath::Boolean->False;
    }
    else { # Neither is a nodeset
        if ($lh_results->isa('XML::XPath::Boolean') ||
            $rh_results->isa('XML::XPath::Boolean')) {
            # if either is a boolean
            if ($lh_results->to_boolean->value == $rh_results->to_boolean->value) {
                return XML::XPath::Boolean->True;
            }
            return XML::XPath::Boolean->False;
        }
        elsif ($lh_results->isa('XML::XPath::Number') ||
                $rh_results->isa('XML::XPath::Number')) {
            # if either is a number
            local $^W; # 'number' might result in undef
            if ($lh_results->to_number->value == $rh_results->to_number->value) {
                return XML::XPath::Boolean->True;