File Coverage

blib/lib/XML/XPathEngine.pm

Criterion	Covered	Total	%
statement	340	469	72.4
branch	121	212	57.0
condition	23	29	79.3
subroutine	47	60	78.3
pod	15	15	100.0
total	546	785	69.5

package XML::XPathEngine;

use warnings;
use strict;

use vars qw($VERSION $AUTOLOAD $revision);

$VERSION = '0.14';
$XML::XPathEngine::Namespaces = 0;
$XML::XPathEngine::DEBUG = 0;

use vars qw/
        $NCName
        $QName
        $NCWild
        $QNWild
        $NUMBER_RE
        $NODE_TYPE
        $AXIS_NAME
        %AXES
        $LITERAL
        $REGEXP_RE
        $REGEXP_MOD_RE
        %CACHE/;

use XML::XPathEngine::Step;
use XML::XPathEngine::Expr;
use XML::XPathEngine::Function;
use XML::XPathEngine::LocationPath;
use XML::XPathEngine::Variable;
use XML::XPathEngine::Literal;
use XML::XPathEngine::Number;
use XML::XPathEngine::NodeSet;
use XML::XPathEngine::Root;

# Axis name to principal node type mapping
%AXES = (
        'ancestor' => 'element',
        'ancestor-or-self' => 'element',
        'attribute' => 'attribute',
        'namespace' => 'namespace',
        'child' => 'element',
        'descendant' => 'element',
        'descendant-or-self' => 'element',
        'following' => 'element',
        'following-sibling' => 'element',
        'parent' => 'element',
        'preceding' => 'element',
        'preceding-sibling' => 'element',
        'self' => 'element',
        );

$NCName = '([A-Za-z_][\w\\.\\-]*)';
$QName = "($NCName:)?$NCName";
$NCWild = "${NCName}:\\*";
$QNWild = "\\*";
$NODE_TYPE = '((text|comment|processing-instruction|node)\\(\\))';
$AXIS_NAME = '(' . join('|', keys %AXES) . ')::';
$NUMBER_RE = '\d+(\\.\d*)?|\\.\d+';
$LITERAL = '\\"[^\\"]*\\"|\\\'[^\\\']*\\\'';
$REGEXP_RE     = qr{(?:m?/(?:\\.|[^/])*/)};
$REGEXP_MOD_RE = qr{(?:[imsx]+)};

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    _debug("New Parser being created.\n") if( $XML::XPathEngine::DEBUG);
    $self->{context_set} = XML::XPathEngine::NodeSet->new();
    $self->{context_pos} = undef; # 1 based position in array context
    $self->{context_size} = 0; # total size of context
    $self->clear_namespaces();
    $self->{vars} = {};
    $self->{direction} = 'forward';
    $self->{cache} = {};
    return $self;
}

sub find {
    my $self = shift;
    my( $path, $context) = @_;
    my $parsed_path= $self->_parse( $path);
    my $results= $parsed_path->evaluate( $context);
    if( $results->isa( 'XML::XPathEngine::NodeSet'))
      { return $results->sort->remove_duplicates; }
    else
      { return $results; }
}


sub matches {
    my $self = shift;
    my ($node, $path, $context) = @_;

    my @nodes = $self->findnodes( $path, $context);

    if (grep { "$node" eq "$_" } @nodes) { return 1; }
    return;
}

sub findnodes {
    my $self = shift;
    my ($path, $context) = @_;

    my $results = $self->find( $path, $context);

    if ($results->isa('XML::XPathEngine::NodeSet'))
      { return wantarray ? $results->get_nodelist : $results; }
    else
      { return wantarray ? XML::XPathEngine::NodeSet->new($results)
                         : $results;
      } # result should be SCALAR
      #{ return wantarray ? ($results) : $results; } # result should be SCALAR
      #{ return wantarray ? () : XML::XPathEngine::NodeSet->new();   }
}


sub findnodes_as_string {
    my $self = shift;
    my ($path, $context) = @_;

    my $results = $self->find( $path, $context);


    if ($results->isa('XML::XPathEngine::NodeSet')) {
        return join '', map { $_->toString } $results->get_nodelist;
    }
    elsif ($results->isa('XML::XPathEngine::Boolean')) {
        return ''; # to behave like XML::LibXML
    }
    elsif ($results->isa('XML::XPathEngine::Node')) {
        return $results->toString;
    }
    else {
        return _xml_escape_text($results->value);
    }
}

sub findnodes_as_strings {
    my $self = shift;
    my ($path, $context) = @_;

    my $results = $self->find( $path, $context);

    if ($results->isa('XML::XPathEngine::NodeSet')) {
        return map { $_->getValue } $results->get_nodelist;
    }
    elsif ($results->isa('XML::XPathEngine::Boolean')) {
        return (); # to behave like XML::LibXML
    }
    elsif ($results->isa('XML::XPathEngine::Node')) {
        return $results->getValue;
    }
    else {
        return _xml_escape_text($results->value);
    }
}

sub findvalue {
    my $self = shift;
    my ($path, $context) = @_;
    my $results = $self->find( $path, $context);
    if ($results->isa('XML::XPathEngine::NodeSet'))
      { return $results->to_final_value; }
      #{ return $results->to_literal; }
    return $results->value;
}

sub findvalues {
    my $self = shift;
    my ($path, $context) = @_;
    my $results = $self->find( $path, $context);
    if ($results->isa('XML::XPathEngine::NodeSet'))
      { return $results->string_values; }
    return ($results->string_value);
}


sub exists
{
    my $self = shift;
    my ($path, $context) = @_;
    $self = '/' if (!defined $self);
    my @nodeset = $self->findnodes( $path, $context);
    return scalar( @nodeset ) ? 1 : 0;
}

sub get_var {
    my $self = shift;
    my $var = shift;
    $self->{vars}->{$var};
}

sub set_var {
    my $self = shift;
    my $var = shift;
    my $val = shift;
    $self->{vars}->{$var} = $val;
}

sub set_namespace {
    my $self = shift;
    my ($prefix, $expanded) = @_;
    $self->{uses_namespaces}=1;
    $self->{namespaces}{$prefix} = $expanded;
}

sub clear_namespaces {
    my $self = shift;
    $self->{uses_namespaces}=0;
    $self->{namespaces} = {};
}

sub get_namespace {
    my $self = shift;
    my ($prefix, $node) = @_;

    my $ns= $node                    ? $node->getNamespace($prefix)
          : $self->{uses_namespaces} ? $self->{namespaces}->{$prefix}
          :                            $prefix;
  return $ns;
}

sub set_strict_namespaces {
    my( $self, $strict) = @_;
    $self->{strict_namespaces}= $strict;
}

sub _get_context_set { $_[0]->{context_set}; }
sub _set_context_set { $_[0]->{context_set} = $_[1]; }
sub _get_context_pos { $_[0]->{context_pos}; }
sub _set_context_pos { $_[0]->{context_pos} = $_[1]; }
sub _get_context_size { $_[0]->{context_set}->size; }
sub _get_context_node { $_[0]->{context_set}->get_node($_[0]->{context_pos}); }

sub _parse {
    my $self = shift;
    my $path = shift;

    my $context= join( '&&', $path, map { "$_=>$self->{namespaces}->{$_}" } sort keys %{$self->{namespaces}});
    #warn "context: $context\n";

    if ($CACHE{$context}) { return $CACHE{$context}; }

    my $tokens = $self->_tokenize($path);

    $self->{_tokpos} = 0;
    my $tree = $self->_analyze($tokens);

    if ($self->{_tokpos} < scalar(@$tokens)) {
        # didn't manage to parse entire expression - throw an exception
        die "Parse of expression $path failed - junk after end of expression: $tokens->[$self->{_tokpos}]";
    }

    $tree->{uses_namespaces}= $self->{uses_namespaces};
    $tree->{strict_namespaces}= $self->{strict_namespaces};

    $CACHE{$context} = $tree;

    _debug("PARSED Expr to:\n", $tree->as_string, "\n") if( $XML::XPathEngine::DEBUG);

    return $tree;
}

sub _tokenize {
    my $self = shift;
    my $path = shift;
    study $path;

    my @tokens;

    _debug("Parsing: $path\n") if( $XML::XPathEngine::DEBUG);

    # Bug: We don't allow "'@' NodeType" which is in the grammar, but I think is just plain stupid.

    my $expected=''; # used to desambiguate conflicts (for REs)

    while( length($path))
      { my $token='';
        if( $expected eq 'RE' && ($path=~ m{\G\s*($REGEXP_RE $REGEXP_MOD_RE?)\s*}gcxso))
          { # special case: regexp expected after =~ or !~, regular parsing rules do not apply
            # ( the / is now the regexp delimiter)
            $token= $1; $expected='';
          }
        elsif($path =~ m/\G
            \s* # ignore all whitespace
            ( # tokens
                $LITERAL|
                $NUMBER_RE|                            # digits
                \.\.|                                  # parent
                \.|                                    # current
                ($AXIS_NAME)?$NODE_TYPE|               # tests
                processing-instruction|
                \@($NCWild|$QName|$QNWild)|            # attrib
                \$$QName|                              # variable reference
                ($AXIS_NAME)?($NCWild|$QName|$QNWild)| # NCName,NodeType,Axis::Test
                \!=|<=|\-|>=|\/\/|and|or|mod|div|      # multi-char seps
                =~|\!~|                                # regexp (not in the XPath spec)
                [,\+=\|<>\/\(\[\]\)]|                  # single char seps
                (?
                (?
                $                                      # end of query
            )
            \s*                                        # ignore all whitespace
            /gcxso)
          {
            $token = $1;
            $expected= ($token=~ m{^[=!]~$}) ? 'RE' : '';
          }
        else
          { $token=''; last; }

        if (length($token)) {
            _debug("TOKEN: $token\n") if( $XML::XPathEngine::DEBUG);
            push @tokens, $token;
        }

        }

    if (pos($path) < length($path)) {
        my $marker = ("." x (pos($path)-1));
        $path = substr($path, 0, pos($path) + 8) . "...";
        $path =~ s/\n/ /g;
        $path =~ s/\t/ /g;
        die "Query:\n",
            "$path\n",
            $marker, "^^^\n",
            "Invalid query somewhere around here (I think)\n";
    }

    return \@tokens;
}

sub _analyze {
    my $self = shift;
    my $tokens = shift;
    # lexical analysis

    return _expr($self, $tokens);
}

sub _match {
    my ($self, $tokens, $match, $fatal) = @_;

    $self->{_curr_match} = '';
    return 0 unless $self->{_tokpos} < @$tokens;

    local $^W;

#    _debug ("match: $match\n") if( $XML::XPathEngine::DEBUG);

    if ($tokens->[$self->{_tokpos}] =~ /^$match$/) {
        $self->{_curr_match} = $tokens->[$self->{_tokpos}];
        $self->{_tokpos}++;
        return 1;
    }
    else {
        if ($fatal) {
            die "Invalid token: ", $tokens->[$self->{_tokpos}], "\n";
        }
        else {
            return 0;
        }
    }
}

sub _expr {
    my ($self, $tokens) = @_;

    _debug( "in _exprexpr\n") if( $XML::XPathEngine::DEBUG);

    return _or_expr($self, $tokens);
}

sub _or_expr {
    my ($self, $tokens) = @_;

    _debug( "in _or_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _and_expr($self, $tokens);
    while (_match($self, $tokens, 'or')) {
        my $or_expr = XML::XPathEngine::Expr->new($self);
        $or_expr->set_lhs($expr);
        $or_expr->set_op('or');

        my $rhs = _and_expr($self, $tokens);

        $or_expr->set_rhs($rhs);
        $expr = $or_expr;
    }

    return $expr;
}

sub _and_expr {
    my ($self, $tokens) = @_;

    _debug( "in _and_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _match_expr($self, $tokens);
    while (_match($self, $tokens, 'and')) {
        my $and_expr = XML::XPathEngine::Expr->new($self);
        $and_expr->set_lhs($expr);
        $and_expr->set_op('and');

        my $rhs = _match_expr($self, $tokens);

        $and_expr->set_rhs($rhs);
        $expr = $and_expr;
    }

    return $expr;
}

sub _match_expr {
    my ($self, $tokens) = @_;

    _debug( "in _match_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _equality_expr($self, $tokens);

    while (_match($self, $tokens, '[=!]~')) {
        my $match_expr = XML::XPathEngine::Expr->new($self);
        $match_expr->set_lhs($expr);
        $match_expr->set_op($self->{_curr_match});

        my $rhs = _equality_expr($self, $tokens);

        $match_expr->set_rhs($rhs);
        $expr = $match_expr;
    }

    return $expr;
}


sub _equality_expr {
    my ($self, $tokens) = @_;

    _debug( "in _equality_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _relational_expr($self, $tokens);
    while (_match($self, $tokens, '!?=')) {
        my $eq_expr = XML::XPathEngine::Expr->new($self);
        $eq_expr->set_lhs($expr);
        $eq_expr->set_op($self->{_curr_match});

        my $rhs = _relational_expr($self, $tokens);

        $eq_expr->set_rhs($rhs);
        $expr = $eq_expr;
    }

    return $expr;
}

sub _relational_expr {
    my ($self, $tokens) = @_;

    _debug( "in _relational_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _additive_expr($self, $tokens);
    while (_match($self, $tokens, '(<|>|<=|>=)')) {
        my $rel_expr = XML::XPathEngine::Expr->new($self);
        $rel_expr->set_lhs($expr);
        $rel_expr->set_op($self->{_curr_match});

        my $rhs = _additive_expr($self, $tokens);

        $rel_expr->set_rhs($rhs);
        $expr = $rel_expr;
    }

    return $expr;
}

sub _additive_expr {
    my ($self, $tokens) = @_;

    _debug( "in _additive_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _multiplicative_expr($self, $tokens);
    while (_match($self, $tokens, '[\\+\\-]')) {
        my $add_expr = XML::XPathEngine::Expr->new($self);
        $add_expr->set_lhs($expr);
        $add_expr->set_op($self->{_curr_match});

        my $rhs = _multiplicative_expr($self, $tokens);

        $add_expr->set_rhs($rhs);
        $expr = $add_expr;
    }

    return $expr;
}

sub _multiplicative_expr {
    my ($self, $tokens) = @_;

    _debug( "in _multiplicative_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _unary_expr($self, $tokens);
    while (_match($self, $tokens, '(\\*|div|mod)')) {
        my $mult_expr = XML::XPathEngine::Expr->new($self);
        $mult_expr->set_lhs($expr);
        $mult_expr->set_op($self->{_curr_match});

        my $rhs = _unary_expr($self, $tokens);

        $mult_expr->set_rhs($rhs);
        $expr = $mult_expr;
    }

    return $expr;
}

sub _unary_expr {
    my ($self, $tokens) = @_;

    _debug( "in _unary_expr\n") if( $XML::XPathEngine::DEBUG);

    if (_match($self, $tokens, '-')) {
        my $expr = XML::XPathEngine::Expr->new($self);
        $expr->set_lhs(XML::XPathEngine::Number->new(0));
        $expr->set_op('-');
        $expr->set_rhs(_unary_expr($self, $tokens));
        return $expr;
    }
    else {
        return _union_expr($self, $tokens);
    }
}

sub _union_expr {
    my ($self, $tokens) = @_;

    _debug( "in _union_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _path_expr($self, $tokens);
    while (_match($self, $tokens, '\\|')) {
        my $un_expr = XML::XPathEngine::Expr->new($self);
        $un_expr->set_lhs($expr);
        $un_expr->set_op('|');

        my $rhs = _path_expr($self, $tokens);

        $un_expr->set_rhs($rhs);
        $expr = $un_expr;
    }

    return $expr;
}

sub _path_expr {
    my ($self, $tokens) = @_;

    _debug( "in _path_expr\n") if( $XML::XPathEngine::DEBUG);

    # _path_expr is _location_path | _filter_expr | _filter_expr '//?' _relative_location_path

    # Since we are being predictive we need to find out which function to call next, then.

    # LocationPath either starts with "/", "//", ".", ".." or a proper Step.

    my $expr = XML::XPathEngine::Expr->new($self);

    my $test = $tokens->[$self->{_tokpos}];

    # Test for AbsoluteLocationPath and AbbreviatedRelativeLocationPath
    if ($test =~ /^(\/\/?|\.\.?)$/) {
        # LocationPath
        $expr->set_lhs(_location_path($self, $tokens));
    }
    # Test for AxisName::...
    elsif (_is_step($self, $tokens)) {
        $expr->set_lhs(_location_path($self, $tokens));
    }
    else {
        # Not a LocationPath
        # Use _filter_expr instead:

        $expr = _filter_expr($self, $tokens);
        if (_match($self, $tokens, '//?')) {
            my $loc_path = XML::XPathEngine::LocationPath->new();
            push @$loc_path, $expr;
            if ($self->{_curr_match} eq '//') {
                push @$loc_path, XML::XPathEngine::Step->new($self, 'descendant-or-self',
                                        XML::XPathEngine::Step::test_nt_node() );
            }
            push @$loc_path, _relative_location_path($self, $tokens);
            my $new_expr = XML::XPathEngine::Expr->new($self);
            $new_expr->set_lhs($loc_path);
            return $new_expr;
        }
    }

    return $expr;
}

sub _filter_expr {
    my ($self, $tokens) = @_;

    _debug( "in _filter_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = _primary_expr($self, $tokens);
    while (_match($self, $tokens, '\\[')) {
        # really PredicateExpr...
        $expr->push_predicate(_expr($self, $tokens));
        _match($self, $tokens, '\\]', 1);
    }

    return $expr;
}

sub _primary_expr {
    my ($self, $tokens) = @_;

    _debug( "in _primary_expr\n") if( $XML::XPathEngine::DEBUG);

    my $expr = XML::XPathEngine::Expr->new($self);

    if (_match($self, $tokens, $LITERAL)) {
        # new Literal with $self->{_curr_match}...
        $self->{_curr_match} =~ m/^(["'])(.*)\1$/;
        $expr->set_lhs(XML::XPathEngine::Literal->new($2));
    }
    elsif (_match($self, $tokens, "$REGEXP_RE$REGEXP_MOD_RE?")) {
        # new Literal with $self->{_curr_match} turned into a regexp...
        my( $regexp, $mod)= $self->{_curr_match} =~  m{($REGEXP_RE)($REGEXP_MOD_RE?)};
        $regexp=~ s{^m?s*/}{};
        $regexp=~ s{/$}{};
        if( $mod) { $regexp=~ "(?$mod:$regexp)"; } # move the mods inside the regexp
        $expr->set_lhs(XML::XPathEngine::Literal->new($regexp));
    }
    elsif (_match($self, $tokens, $NUMBER_RE)) {
        # new Number with $self->{_curr_match}...
        $expr->set_lhs(XML::XPathEngine::Number->new($self->{_curr_match}));
    }
    elsif (_match($self, $tokens, '\\(')) {
        $expr->set_lhs(_expr($self, $tokens));
        _match($self, $tokens, '\\)', 1);
    }
    elsif (_match($self, $tokens, "\\\$$QName")) {
        # new Variable with $self->{_curr_match}...
        $self->{_curr_match} =~ /^\$(.*)$/;
        $expr->set_lhs(XML::XPathEngine::Variable->new($self, $1));
    }
    elsif (_match($self, $tokens, $QName)) {
        # check match not Node_Type - done in lexer...
        # new Function
        my $func_name = $self->{_curr_match};
        _match($self, $tokens, '\\(', 1);
        $expr->set_lhs(
                XML::XPathEngine::Function->new(
                    $self,
                    $func_name,
                    _arguments($self, $tokens)
                )
            );
        _match($self, $tokens, '\\)', 1);
    }
    else {
        die "Not a _primary_expr at ", $tokens->[$self->{_tokpos}], "\n";
    }

    return $expr;
}

sub _arguments {
    my ($self, $tokens) = @_;

    _debug( "in _arguments\n") if( $XML::XPathEngine::DEBUG);

    my @args;

    if($tokens->[$self->{_tokpos}] eq ')') {
        return \@args;
    }

    push @args, _expr($self, $tokens);
    while (_match($self, $tokens, ',')) {
        push @args, _expr($self, $tokens);
    }

    return \@args;
}

sub _location_path {
    my ($self, $tokens) = @_;

    _debug( "in _location_path\n") if( $XML::XPathEngine::DEBUG);

    my $loc_path = XML::XPathEngine::LocationPath->new();

    if (_match($self, $tokens, '/')) {
        # root
        _debug("h: Matched root\n") if( $XML::XPathEngine::DEBUG);
        push @$loc_path, XML::XPathEngine::Root->new();
        if (_is_step($self, $tokens)) {
            _debug("Next is step\n") if( $XML::XPathEngine::DEBUG);
            push @$loc_path, _relative_location_path($self, $tokens);
        }
    }
    elsif (_match($self, $tokens, '//')) {
        # root
        push @$loc_path, XML::XPathEngine::Root->new();
        my $optimised = _optimise_descendant_or_self($self, $tokens);
        if (!$optimised) {
            push @$loc_path, XML::XPathEngine::Step->new($self, 'descendant-or-self',
                                XML::XPathEngine::Step::test_nt_node);
            push @$loc_path, _relative_location_path($self, $tokens);
        }
        else {
            push @$loc_path, $optimised, _relative_location_path($self, $tokens);
        }
    }
    else {
        push @$loc_path, _relative_location_path($self, $tokens);
    }

    return $loc_path;
}

sub _optimise_descendant_or_self {
    my ($self, $tokens) = @_;

    _debug( "in _optimise_descendant_or_self\n") if( $XML::XPathEngine::DEBUG);

    my $tokpos = $self->{_tokpos};

    # // must be followed by a Step.
    if ($tokens->[$tokpos+1] && $tokens->[$tokpos+1] eq '[') {
        # next token is a predicate
        return;
    }
    elsif ($tokens->[$tokpos] =~ /^\.\.?$/) {
        # abbreviatedStep - can't optimise.
        return;
    }
    else {
        _debug("Trying to optimise //\n") if( $XML::XPathEngine::DEBUG);
        my $step = _step($self, $tokens);
        if ($step->{axis} ne 'child') {
            # can't optimise axes other than child for now...
            $self->{_tokpos} = $tokpos;
            return;
        }
        $step->{axis} = 'descendant';
        $step->{axis_method} = 'axis_descendant';
        $self->{_tokpos}--;
        $tokens->[$self->{_tokpos}] = '.';
        return $step;
    }
}

sub _relative_location_path {
    my ($self, $tokens) = @_;

    _debug( "in _relative_location_path\n") if( $XML::XPathEngine::DEBUG);

    my @steps;

    push @steps,_step($self, $tokens);
    while (_match($self, $tokens, '//?')) {
        if ($self->{_curr_match} eq '//') {
            my $optimised = _optimise_descendant_or_self($self, $tokens);
            if (!$optimised) {
                push @steps, XML::XPathEngine::Step->new($self, 'descendant-or-self',
                                        XML::XPathEngine::Step::test_nt_node);
            }
            else {
                push @steps, $optimised;
            }
        }
        push @steps, _step($self, $tokens);
        if (@steps > 1 &&
                $steps[-1]->{axis} eq 'self' &&
                $steps[-1]->{test} == XML::XPathEngine::Step::test_nt_node) {
            pop @steps;
        }
    }

    return @steps;
}

sub _step {
    my ($self, $tokens) = @_;

    _debug( "in _step\n") if( $XML::XPathEngine::DEBUG);

    if (_match($self, $tokens, '\\.')) {
        # self::node()
        return XML::XPathEngine::Step->new($self, 'self', XML::XPathEngine::Step::test_nt_node);
    }
    elsif (_match($self, $tokens, '\\.\\.')) {
        # parent::node()
        return XML::XPathEngine::Step->new($self, 'parent', XML::XPathEngine::Step::test_nt_node);
    }
    else {
        # AxisSpecifier NodeTest Predicate(s?)
        my $token = $tokens->[$self->{_tokpos}];

        _debug("p: Checking $token\n") if( $XML::XPathEngine::DEBUG);

        my $step;
        if ($token eq 'processing-instruction') {
            $self->{_tokpos}++;
            _match($self, $tokens, '\\(', 1);
            _match($self, $tokens, $LITERAL);
            $self->{_curr_match} =~ /^["'](.*)["']$/;
            $step = XML::XPathEngine::Step->new($self, 'child',
                                    XML::XPathEngine::Step::test_nt_pi,
                        XML::XPathEngine::Literal->new($1));
            _match($self, $tokens, '\\)', 1);
        }
        elsif ($token =~ /^\@($NCWild|$QName|$QNWild)$/o) {
            $self->{_tokpos}++;
                        if ($token eq '@*') {
                            $step = XML::XPathEngine::Step->new($self,
                                    'attribute',
                                    XML::XPathEngine::Step::test_attr_any,
                                    '*');
                        }
                        elsif ($token =~ /^\@($NCName):\*$/o) {
                            $step = XML::XPathEngine::Step->new($self,
                                    'attribute',
                                    XML::XPathEngine::Step::test_attr_ncwild,
                                    $1);
                        }
                        elsif ($token =~ /^\@($QName)$/o) {
                            $step = XML::XPathEngine::Step->new($self,
                                    'attribute',
                                    XML::XPathEngine::Step::test_attr_qname,
                                    $1);
                        }
        }
        elsif ($token =~ /^($NCName):\*$/o) { # ns:*
            $self->{_tokpos}++;
            $step = XML::XPathEngine::Step->new($self, 'child',
                                XML::XPathEngine::Step::test_ncwild,
                                $1);
        }
        elsif ($token =~ /^$QNWild$/o) { # *
            $self->{_tokpos}++;
            $step = XML::XPathEngine::Step->new($self, 'child',
                                XML::XPathEngine::Step::test_any,
                                $token);
        }
        elsif ($token =~ /^$QName$/o) { # name:name
            $self->{_tokpos}++;
            $step = XML::XPathEngine::Step->new($self, 'child',
                                XML::XPathEngine::Step::test_qname,
                                $token);
        }
        elsif ($token eq 'comment()') {
                    $self->{_tokpos}++;
            $step = XML::XPathEngine::Step->new($self, 'child',
                            XML::XPathEngine::Step::test_nt_comment);
        }
        elsif ($token eq 'text()') {
            $self->{_tokpos}++;
            $step = XML::XPathEngine::Step->new($self, 'child',
                    XML::XPathEngine::Step::test_nt_text);
        }
        elsif ($token eq 'node()') {
            $self->{_tokpos}++;
            $step = XML::XPathEngine::Step->new($self, 'child',
                    XML::XPathEngine::Step::test_nt_node);
        }
        elsif ($token eq 'processing-instruction()') {
            $self->{_tokpos}++;
            $step = XML::XPathEngine::Step->new($self, 'child',
                    XML::XPathEngine::Step::test_nt_pi);
        }
        elsif ($token =~ /^$AXIS_NAME($NCWild|$QName|$QNWild|$NODE_TYPE)$/o) {
                    my $axis = $1;
                    $self->{_tokpos}++;
                    $token = $2;
            if ($token eq 'processing-instruction') {
                _match($self, $tokens, '\\(', 1);
                _match($self, $tokens, $LITERAL);
                $self->{_curr_match} =~ /^["'](.*)["']$/;
                $step = XML::XPathEngine::Step->new($self, $axis,
                                        XML::XPathEngine::Step::test_nt_pi,
                            XML::XPathEngine::Literal->new($1));
                _match($self, $tokens, '\\)', 1);
            }
            elsif ($token =~ /^($NCName):\*$/o) { # ns:*
                $step = XML::XPathEngine::Step->new($self, $axis,
                                    (($axis eq 'attribute') ?
                                    XML::XPathEngine::Step::test_attr_ncwild
                                        :
                                    XML::XPathEngine::Step::test_ncwild),
                                    $1);
            }
            elsif ($token =~ /^$QNWild$/o) { # *
                $step = XML::XPathEngine::Step->new($self, $axis,
                                    (($axis eq 'attribute') ?
                                    XML::XPathEngine::Step::test_attr_any
                                        :
                                    XML::XPathEngine::Step::test_any),
                                    $token);
            }
            elsif ($token =~ /^$QName$/o) { # name:name
                $step = XML::XPathEngine::Step->new($self, $axis,
                                    (($axis eq 'attribute') ?
                                    XML::XPathEngine::Step::test_attr_qname
                                        :
                                    XML::XPathEngine::Step::test_qname),
                                    $token);
            }
            elsif ($token eq 'comment()') {
                $step = XML::XPathEngine::Step->new($self, $axis,
                                XML::XPathEngine::Step::test_nt_comment);
            }
            elsif ($token eq 'text()') {
                $step = XML::XPathEngine::Step->new($self, $axis,
                        XML::XPathEngine::Step::test_nt_text);
            }
            elsif ($token eq 'node()') {
                $step = XML::XPathEngine::Step->new($self, $axis,
                        XML::XPathEngine::Step::test_nt_node);
            }
            elsif ($token eq 'processing-instruction()') {
                $step = XML::XPathEngine::Step->new($self, $axis,
                        XML::XPathEngine::Step::test_nt_pi);
            }
            else {
                die "Shouldn't get here";
            }
        }
        else {
            die "token $token doesn't match format of a 'Step'\n";
        }

        while (_match($self, $tokens, '\\[')) {
            push @{$step->{predicates}}, _expr($self, $tokens);
            _match($self, $tokens, '\\]', 1);
        }

        return $step;
    }
}

sub _is_step {
    my ($self, $tokens) = @_;

    my $token = $tokens->[$self->{_tokpos}];

    return unless defined $token;

    _debug("p: Checking if '$token' is a step\n") if( $XML::XPathEngine::DEBUG);

    local $^W=0;

    if(   ($token eq 'processing-instruction')
       || ($token =~ /^\@($NCWild|$QName|$QNWild)$/o)
       || (    ($token =~ /^($NCWild|$QName|$QNWild)$/o )
            && ( ($tokens->[$self->{_tokpos}+1] || '') ne '(') )
       || ($token =~ /^$NODE_TYPE$/o)
       || ($token =~ /^$AXIS_NAME($NCWild|$QName|$QNWild|$NODE_TYPE)$/o)
      )
      { return 1; }
    else
      { _debug("p: '$token' not a step\n") if( $XML::XPathEngine::DEBUG);
        return;
      }
}

{ my %ENT;
  BEGIN { %ENT= ( '&' => '&', '<' => '<', '>' => '>', '"' => '"e;'); }

  sub _xml_escape_text
    { my( $text)= @_;
      $text=~ s{([&<>])}{$ENT{$1}}g;
      return $text;
    }
}

sub _debug {

    my ($pkg, $file, $line, $sub) = caller(1);

    $sub =~ s/^$pkg\:://;

    while (@_) {
        my $x = shift;
        $x =~ s/\bPKG\b/$pkg/g;
        $x =~ s/\bLINE\b/$line/g;
        $x =~ s/\bg\b/$sub/g;
        print STDERR $x;
    }
}


__END__