expr.pm

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

            }
            return XML::XPath::Boolean->False;
        }
        else {
            if ($lh_results->to_literal->value eq $rh_results->to_literal->value) {
                return XML::XPath::Boolean->True;
            }
            return XML::XPath::Boolean->False;
        }
    }
}

sub op_nequals {
    my ($node, $lhs, $rhs) = @_;
    if (op_equals($node, $lhs, $rhs)->value) {
        return XML::XPath::Boolean->False;
    }
    return XML::XPath::Boolean->True;
}

sub op_le {
    my ($node, $lhs, $rhs) = @_;
    op_gt($node, $rhs, $lhs);
}

sub op_ge {
    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')) {

        foreach my $lhnode ($lh_results->get_nodelist) {
            foreach my $rhnode ($rh_results->get_nodelist) {
                my $lhNum = XML::XPath::Number->new($lhnode->string_value);
                my $rhNum = XML::XPath::Number->new($rhnode->string_value);
                if ($lhNum->value >= $rhNum->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);
        my ($true, $false);
        if ($lh_results->isa('XML::XPath::NodeSet')) {
            $nodeset = $lh_results;
            $other = $rh_results;
            # we do this because unlike ==, these ops are direction dependant
            ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
        }
        else {
            $nodeset = $rh_results;
            $other = $lh_results;
            # ditto above comment
            ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
        }
        
        # 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.
        foreach my $node ($nodeset->get_nodelist) {
            if ($node->to_number->value >= $other->to_number->value) {
                return $true;
            }
        }
        return $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->to_number->value
                    >= $rh_results->to_boolean->to_number->value) {
                return XML::XPath::Boolean->True;
            }
        }
        else {
            if ($lh_results->to_number->value >= $rh_results->to_number->value) {
                return XML::XPath::Boolean->True;
            }
        }
        return XML::XPath::Boolean->False;
    }
}

sub op_gt {
    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')) {

        foreach my $lhnode ($lh_results->get_nodelist) {
            foreach my $rhnode ($rh_results->get_nodelist) {
                my $lhNum = XML::XPath::Number->new($lhnode->string_value);
                my $rhNum = XML::XPath::Number->new($rhnode->string_value);
                if ($lhNum->value > $rhNum->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);
        my ($true, $false);
        if ($lh_results->isa('XML::XPath::NodeSet')) {
            $nodeset = $lh_results;
            $other = $rh_results;
            # we do this because unlike ==, these ops are direction dependant
            ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
        }
        else {
            $nodeset = $rh_results;
            $other = $lh_results;
            # ditto above comment
            ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
        }
        
        # 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.
        foreach my $node ($nodeset->get_nodelist) {
            if ($node->to_number->value > $other->to_number->value) {
                return $true;
            }
        }
        return $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;
            }
        }
        else {
            if ($lh_results->to_number->value > $rh_results->to_number->value) {
                return XML::XPath::Boolean->True;
            }
        }
        return XML::XPath::Boolean->False;
    }
}

sub op_lt {
    my ($node, $lhs, $rhs) = @_;
    op_gt($node, $rhs, $lhs);
}

sub op_plus {
    my ($node, $lhs, $rhs) = @_;
    my $lh_results = $lhs->evaluate($node);
    my $rh_results = $rhs->evaluate($node);
    
    my $result =
        $lh_results->to_number->value
            +
        $rh_results->to_number->value
            ;
    return XML::XPath::Number->new($result);
}

sub op_minus {
    my ($node, $lhs, $rhs) = @_;
    my $lh_results = $lhs->evaluate($node);
    my $rh_results = $rhs->evaluate($node);
    
    my $result =
        $lh_results->to_number->value
            -
        $rh_results->to_number->value
            ;
    return XML::XPath::Number->new($result);
}

sub op_div {
    my ($node, $lhs, $rhs) = @_;
    my $lh_results = $lhs->evaluate($node);
    my $rh_results = $rhs->evaluate($node);

    my $result = eval {
        $lh_results->to_number->value
            /
        $rh_results->to_number->value
            ;
    };
    if ($@) {
        # assume divide by zero
        # This is probably a terrible way to handle this! 
        # Ah well... who wants to live forever...
        return XML::XPath::Literal->new('Infinity');
    }
    return XML::XPath::Number->new($result);
}

sub op_mod {
    my ($node, $lhs, $rhs) = @_;
    my $lh_results = $lhs->evaluate($node);
    my $rh_results = $rhs->evaluate($node);
    
    my $result =
        $lh_results->to_number->value
            %
        $rh_results->to_number->value
            ;
    return XML::XPath::Number->new($result);
}

sub op_mult {
    my ($node, $lhs, $rhs) = @_;
    my $lh_results = $lhs->evaluate($node);
    my $rh_results = $rhs->evaluate($node);
    
    my $result =
        $lh_results->to_number->value
            *
        $rh_results->to_number->value
            ;
    return XML::XPath::Number->new($result);
}

sub op_union {
    my ($node, $lhs, $rhs) = @_;
    my $lh_result = $lhs->evaluate($node);
    my $rh_result = $rhs->evaluate($node);
    
    if ($lh_result->isa('XML::XPath::NodeSet') &&
            $rh_result->isa('XML::XPath::NodeSet')) {
        my %found;
        my $results = XML::XPath::NodeSet->new;
        foreach my $lhnode ($lh_result->get_nodelist) {
            $found{"$lhnode"}++;
            $results->push($lhnode);
        }
        foreach my $rhnode ($rh_result->get_nodelist) {
            $results->push($rhnode)
                    unless exists $found{"$rhnode"};
        }
                $results->sort;
        return $results;
    }
    die "Both sides of a union must be Node Sets\n";
}

sub filter_by_predicate {
    my $self = shift;
    my ($nodeset, $predicate) = @_;
    
    # See spec section 2.4, paragraphs 2 & 3:
    # For each node in the node-set to be filtered, the predicate Expr
    # is evaluated with that node as the context node, with the number
    # of nodes in the node set as the context size, and with the
    # proximity position of the node in the node set with respect to
    # the axis as the context position.
    
    if (!ref($nodeset)) { # use ref because nodeset has a bool context
        die "No nodeset!!!";
    }
    
#    warn "Filter by predicate: $predicate\n";
    
    my $newset = XML::XPath::NodeSet->new();
    
    for(my $i = 1; $i <= $nodeset->size; $i++) {
        # set context set each time 'cos a loc-path in the expr could change it
        $self->{pp}->set_context_set($nodeset);
        $self->{pp}->set_context_pos($i);
        my $result = $predicate->evaluate($nodeset->get_node($i));
        if ($result->isa('XML::XPath::Boolean')) {
            if ($result->value) {
                $newset->push($nodeset->get_node($i));
            }
        }
        elsif ($result->isa('XML::XPath::Number')) {
            if ($result->value == $i) {
                $newset->push($nodeset->get_node($i));
            }
        }
        else {
            if ($result->to_boolean->value) {
                $newset->push($nodeset->get_node($i));
            }
        }
    }
    
    return $newset;
}

1;