home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / XML / XPath / Parser.pm < prev    next >
Encoding:
Perl POD Document  |  2001-11-26  |  22.9 KB  |  822 lines
  1. # $Id: Parser.pm,v 1.33 2001/11/26 17:41:18 matt Exp $
  2.  
  3. package XML::XPath::Parser;
  4.  
  5. use strict;
  6. use vars qw/
  7.         $NCName 
  8.         $QName 
  9.         $NCWild
  10.         $QNWild
  11.         $NUMBER_RE 
  12.         $NODE_TYPE 
  13.         $AXIS_NAME 
  14.         %AXES 
  15.         $LITERAL
  16.         %CACHE/;
  17.  
  18. use XML::XPath::XMLParser;
  19. use XML::XPath::Step;
  20. use XML::XPath::Expr;
  21. use XML::XPath::Function;
  22. use XML::XPath::LocationPath;
  23. use XML::XPath::Variable;
  24. use XML::XPath::Literal;
  25. use XML::XPath::Number;
  26. use XML::XPath::NodeSet;
  27.  
  28. # Axis name to principal node type mapping
  29. %AXES = (
  30.         'ancestor' => 'element',
  31.         'ancestor-or-self' => 'element',
  32.         'attribute' => 'attribute',
  33.         'namespace' => 'namespace',
  34.         'child' => 'element',
  35.         'descendant' => 'element',
  36.         'descendant-or-self' => 'element',
  37.         'following' => 'element',
  38.         'following-sibling' => 'element',
  39.         'parent' => 'element',
  40.         'preceding' => 'element',
  41.         'preceding-sibling' => 'element',
  42.         'self' => 'element',
  43.         );
  44.  
  45. $NCName = '([A-Za-z_][\w\\.\\-]*)';
  46. $QName = "($NCName:)?$NCName";
  47. $NCWild = "${NCName}:\\*";
  48. $QNWild = "\\*";
  49. $NODE_TYPE = '((text|comment|processing-instruction|node)\\(\\))';
  50. $AXIS_NAME = '(' . join('|', keys %AXES) . ')::';
  51. $NUMBER_RE = '\d+(\\.\d*)?|\\.\d+';
  52. $LITERAL = '\\"[^\\"]*\\"|\\\'[^\\\']*\\\'';
  53.  
  54. sub new {
  55.     my $class = shift;
  56.     my $self = bless {}, $class;
  57.     debug("New Parser being created.\n");
  58.     $self->{context_set} = XML::XPath::NodeSet->new();
  59.     $self->{context_pos} = undef; # 1 based position in array context
  60.     $self->{context_size} = 0; # total size of context
  61.     $self->clear_namespaces();
  62.     $self->{vars} = {};
  63.     $self->{direction} = 'forward';
  64.     $self->{cache} = {};
  65.     return $self;
  66. }
  67.  
  68. sub get_var {
  69.     my $self = shift;
  70.     my $var = shift;
  71.     $self->{vars}->{$var};
  72. }
  73.  
  74. sub set_var {
  75.     my $self = shift;
  76.     my $var = shift;
  77.     my $val = shift;
  78.     $self->{vars}->{$var} = $val;
  79. }
  80.  
  81. sub set_namespace {
  82.     my $self = shift;
  83.     my ($prefix, $expanded) = @_;
  84.     $self->{namespaces}{$prefix} = $expanded;
  85. }
  86.  
  87. sub clear_namespaces {
  88.     my $self = shift;
  89.     $self->{namespaces} = {};
  90. }
  91.  
  92. sub get_namespace {
  93.     my $self = shift;
  94.     my ($prefix, $node) = @_;
  95.     if (my $ns = $self->{namespaces}{$prefix}) {
  96.         return $ns;
  97.     }
  98.     if (my $nsnode = $node->getNamespace($prefix)) {
  99.         return $nsnode->getValue();
  100.     }
  101. }
  102.  
  103. sub get_context_set { $_[0]->{context_set}; }
  104. sub set_context_set { $_[0]->{context_set} = $_[1]; }
  105. sub get_context_pos { $_[0]->{context_pos}; }
  106. sub set_context_pos { $_[0]->{context_pos} = $_[1]; }
  107. sub get_context_size { $_[0]->{context_set}->size; }
  108. sub get_context_node { $_[0]->{context_set}->get_node($_[0]->{context_pos}); }
  109.  
  110. sub my_sub {
  111.     return (caller(1))[3];
  112. }
  113.  
  114. sub parse {
  115.     my $self = shift;
  116.     my $path = shift;
  117.     if ($CACHE{$path}) {
  118.         return $CACHE{$path};
  119.     }
  120.     my $tokens = $self->tokenize($path);
  121.  
  122.     $self->{_tokpos} = 0;
  123.     my $tree = $self->analyze($tokens);
  124.     
  125.     if ($self->{_tokpos} < scalar(@$tokens)) {
  126.         # didn't manage to parse entire expression - throw an exception
  127.         die "Parse of expression $path failed - junk after end of expression: $tokens->[$self->{_tokpos}]";
  128.     }
  129.     
  130.     $CACHE{$path} = $tree;
  131.     
  132.     debug("PARSED Expr to:\n", $tree->as_string, "\n") if $XML::XPath::Debug;
  133.     
  134.     return $tree;
  135. }
  136.  
  137. sub tokenize {
  138.     my $self = shift;
  139.     my $path = shift;
  140.     study $path;
  141.     
  142.     my @tokens;
  143.     
  144.     debug("Parsing: $path\n");
  145.     
  146.     # Bug: We don't allow "'@' NodeType" which is in the grammar, but I think is just plain stupid.
  147.  
  148.     while($path =~ m/\G
  149.         \s* # ignore all whitespace
  150.         ( # tokens
  151.             $LITERAL|
  152.             $NUMBER_RE| # Match digits
  153.             \.\.| # match parent
  154.             \.| # match current
  155.             ($AXIS_NAME)?$NODE_TYPE| # match tests
  156.             processing-instruction|
  157.             \@($NCWild|$QName|$QNWild)| # match attrib
  158.             \$$QName| # match variable reference
  159.             ($AXIS_NAME)?($NCWild|$QName|$QNWild)| # match NCName,NodeType,Axis::Test
  160.             \!=|<=|\-|>=|\/\/|and|or|mod|div| # multi-char seps
  161.             [,\+=\|<>\/\(\[\]\)]| # single char seps
  162.             (?<!(\@|\(|\[))\*| # multiply operator rules (see xpath spec)
  163.             (?<!::)\*|
  164.             $ # match end of query
  165.         )
  166.         \s* # ignore all whitespace
  167.         /gcxso) {
  168.  
  169.         my ($token) = ($1);
  170.  
  171.         if (length($token)) {
  172.             debug("TOKEN: $token\n");
  173.             push @tokens, $token;
  174.         }
  175.         
  176.     }
  177.     
  178.     if (pos($path) < length($path)) {
  179.         my $marker = ("." x (pos($path)-1));
  180.         $path = substr($path, 0, pos($path) + 8) . "...";
  181.         $path =~ s/\n/ /g;
  182.         $path =~ s/\t/ /g;
  183.         die "Query:\n",
  184.             "$path\n",
  185.             $marker, "^^^\n",
  186.             "Invalid query somewhere around here (I think)\n";
  187.     }
  188.     
  189.     return \@tokens;
  190. }
  191.  
  192. sub analyze {
  193.     my $self = shift;
  194.     my $tokens = shift;
  195.     # lexical analysis
  196.     
  197.     return Expr($self, $tokens);
  198. }
  199.  
  200. sub match {
  201.     my ($self, $tokens, $match, $fatal) = @_;
  202.     
  203.     $self->{_curr_match} = '';
  204.     return 0 unless $self->{_tokpos} < @$tokens;
  205.  
  206.     local $^W;
  207.     
  208. #    debug ("match: $match\n");
  209.     
  210.     if ($tokens->[$self->{_tokpos}] =~ /^$match$/) {
  211.         $self->{_curr_match} = $tokens->[$self->{_tokpos}];
  212.         $self->{_tokpos}++;
  213.         return 1;
  214.     }
  215.     else {
  216.         if ($fatal) {
  217.             die "Invalid token: ", $tokens->[$self->{_tokpos}], "\n";
  218.         }
  219.         else {
  220.             return 0;
  221.         }
  222.     }
  223. }
  224.  
  225. sub Expr {
  226.     my ($self, $tokens) = @_;
  227.     
  228.     debug("in SUB\n");
  229.     
  230.     return OrExpr($self, $tokens);
  231. }
  232.  
  233. sub OrExpr {
  234.     my ($self, $tokens) = @_;
  235.     
  236.     debug("in SUB\n");
  237.     
  238.     my $expr = AndExpr($self, $tokens); 
  239.     while (match($self, $tokens, 'or')) {
  240.         my $or_expr = XML::XPath::Expr->new($self);
  241.         $or_expr->set_lhs($expr);
  242.         $or_expr->set_op('or');
  243.  
  244.         my $rhs = AndExpr($self, $tokens);
  245.  
  246.         $or_expr->set_rhs($rhs);
  247.         $expr = $or_expr;
  248.     }
  249.     
  250.     return $expr;
  251. }
  252.  
  253. sub AndExpr {
  254.     my ($self, $tokens) = @_;
  255.     
  256.     debug("in SUB\n");
  257.     
  258.     my $expr = EqualityExpr($self, $tokens);
  259.     while (match($self, $tokens, 'and')) {
  260.         my $and_expr = XML::XPath::Expr->new($self);
  261.         $and_expr->set_lhs($expr);
  262.         $and_expr->set_op('and');
  263.         
  264.         my $rhs = EqualityExpr($self, $tokens);
  265.         
  266.         $and_expr->set_rhs($rhs);
  267.         $expr = $and_expr;
  268.     }
  269.     
  270.     return $expr;
  271. }
  272.  
  273. sub EqualityExpr {
  274.     my ($self, $tokens) = @_;
  275.     
  276.     debug("in SUB\n");
  277.     
  278.     my $expr = RelationalExpr($self, $tokens);
  279.     while (match($self, $tokens, '!?=')) {
  280.         my $eq_expr = XML::XPath::Expr->new($self);
  281.         $eq_expr->set_lhs($expr);
  282.         $eq_expr->set_op($self->{_curr_match});
  283.         
  284.         my $rhs = RelationalExpr($self, $tokens);
  285.         
  286.         $eq_expr->set_rhs($rhs);
  287.         $expr = $eq_expr;
  288.     }
  289.     
  290.     return $expr;
  291. }
  292.  
  293. sub RelationalExpr {
  294.     my ($self, $tokens) = @_;
  295.     
  296.     debug("in SUB\n");
  297.     
  298.     my $expr = AdditiveExpr($self, $tokens);
  299.     while (match($self, $tokens, '(<|>|<=|>=)')) {
  300.         my $rel_expr = XML::XPath::Expr->new($self);
  301.         $rel_expr->set_lhs($expr);
  302.         $rel_expr->set_op($self->{_curr_match});
  303.         
  304.         my $rhs = AdditiveExpr($self, $tokens);
  305.         
  306.         $rel_expr->set_rhs($rhs);
  307.         $expr = $rel_expr;
  308.     }
  309.     
  310.     return $expr;
  311. }
  312.  
  313. sub AdditiveExpr {
  314.     my ($self, $tokens) = @_;
  315.     
  316.     debug("in SUB\n");
  317.     
  318.     my $expr = MultiplicativeExpr($self, $tokens);
  319.     while (match($self, $tokens, '[\\+\\-]')) {
  320.         my $add_expr = XML::XPath::Expr->new($self);
  321.         $add_expr->set_lhs($expr);
  322.         $add_expr->set_op($self->{_curr_match});
  323.         
  324.         my $rhs = MultiplicativeExpr($self, $tokens);
  325.         
  326.         $add_expr->set_rhs($rhs);
  327.         $expr = $add_expr;
  328.     }
  329.     
  330.     return $expr;
  331. }
  332.  
  333. sub MultiplicativeExpr {
  334.     my ($self, $tokens) = @_;
  335.     
  336.     debug("in SUB\n");
  337.     
  338.     my $expr = UnaryExpr($self, $tokens);
  339.     while (match($self, $tokens, '(\\*|div|mod)')) {
  340.         my $mult_expr = XML::XPath::Expr->new($self);
  341.         $mult_expr->set_lhs($expr);
  342.         $mult_expr->set_op($self->{_curr_match});
  343.         
  344.         my $rhs = UnaryExpr($self, $tokens);
  345.         
  346.         $mult_expr->set_rhs($rhs);
  347.         $expr = $mult_expr;
  348.     }
  349.     
  350.     return $expr;
  351. }
  352.  
  353. sub UnaryExpr {
  354.     my ($self, $tokens) = @_;
  355.     
  356.     debug("in SUB\n");
  357.     
  358.     if (match($self, $tokens, '-')) {
  359.         my $expr = XML::XPath::Expr->new($self);
  360.         $expr->set_lhs(XML::XPath::Number->new(0));
  361.         $expr->set_op('-');
  362.         $expr->set_rhs(UnaryExpr($self, $tokens));
  363.         return $expr;
  364.     }
  365.     else {
  366.         return UnionExpr($self, $tokens);
  367.     }
  368. }
  369.  
  370. sub UnionExpr {
  371.     my ($self, $tokens) = @_;
  372.     
  373.     debug("in SUB\n");
  374.     
  375.     my $expr = PathExpr($self, $tokens);
  376.     while (match($self, $tokens, '\\|')) {
  377.         my $un_expr = XML::XPath::Expr->new($self);
  378.         $un_expr->set_lhs($expr);
  379.         $un_expr->set_op('|');
  380.         
  381.         my $rhs = PathExpr($self, $tokens);
  382.         
  383.         $un_expr->set_rhs($rhs);
  384.         $expr = $un_expr;
  385.     }
  386.     
  387.     return $expr;
  388. }
  389.  
  390. sub PathExpr {
  391.     my ($self, $tokens) = @_;
  392.  
  393.     debug("in SUB\n");
  394.     
  395.     # PathExpr is LocationPath | FilterExpr | FilterExpr '//?' RelativeLocationPath
  396.     
  397.     # Since we are being predictive we need to find out which function to call next, then.
  398.         
  399.     # LocationPath either starts with "/", "//", ".", ".." or a proper Step.
  400.     
  401.     my $expr = XML::XPath::Expr->new($self);
  402.     
  403.     my $test = $tokens->[$self->{_tokpos}];
  404.     
  405.     # Test for AbsoluteLocationPath and AbbreviatedRelativeLocationPath
  406.     if ($test =~ /^(\/\/?|\.\.?)$/) {
  407.         # LocationPath
  408.         $expr->set_lhs(LocationPath($self, $tokens));
  409.     }
  410.     # Test for AxisName::...
  411.     elsif (is_step($self, $tokens)) {
  412.         $expr->set_lhs(LocationPath($self, $tokens));
  413.     }
  414.     else {
  415.         # Not a LocationPath
  416.         # Use FilterExpr instead:
  417.         
  418.         $expr = FilterExpr($self, $tokens);
  419.         if (match($self, $tokens, '//?')) {
  420.             my $loc_path = XML::XPath::LocationPath->new();
  421.             push @$loc_path, $expr;
  422.             if ($self->{_curr_match} eq '//') {
  423.                 push @$loc_path, XML::XPath::Step->new($self, 'descendant-or-self', 
  424.                                         XML::XPath::Step::test_nt_node);
  425.             }
  426.             push @$loc_path, RelativeLocationPath($self, $tokens);
  427.             my $new_expr = XML::XPath::Expr->new($self);
  428.             $new_expr->set_lhs($loc_path);
  429.             return $new_expr;
  430.         }
  431.     }
  432.     
  433.     return $expr;
  434. }
  435.  
  436. sub FilterExpr {
  437.     my ($self, $tokens) = @_;
  438.     
  439.     debug("in SUB\n");
  440.     
  441.     my $expr = PrimaryExpr($self, $tokens);
  442.     while (match($self, $tokens, '\\[')) {
  443.         # really PredicateExpr...
  444.         $expr->push_predicate(Expr($self, $tokens));
  445.         match($self, $tokens, '\\]', 1);
  446.     }
  447.     
  448.     return $expr;
  449. }
  450.  
  451. sub PrimaryExpr {
  452.     my ($self, $tokens) = @_;
  453.  
  454.     debug("in SUB\n");
  455.     
  456.     my $expr = XML::XPath::Expr->new($self);
  457.     
  458.     if (match($self, $tokens, $LITERAL)) {
  459.         # new Literal with $self->{_curr_match}...
  460.         $self->{_curr_match} =~ m/^(["'])(.*)\1$/;
  461.         $expr->set_lhs(XML::XPath::Literal->new($2));
  462.     }
  463.     elsif (match($self, $tokens, $NUMBER_RE)) {
  464.         # new Number with $self->{_curr_match}...
  465.         $expr->set_lhs(XML::XPath::Number->new($self->{_curr_match}));
  466.     }
  467.     elsif (match($self, $tokens, '\\(')) {
  468.         $expr->set_lhs(Expr($self, $tokens));
  469.         match($self, $tokens, '\\)', 1);
  470.     }
  471.     elsif (match($self, $tokens, "\\\$$QName")) {
  472.         # new Variable with $self->{_curr_match}...
  473.         $self->{_curr_match} =~ /^\$(.*)$/;
  474.         $expr->set_lhs(XML::XPath::Variable->new($self, $1));
  475.     }
  476.     elsif (match($self, $tokens, $QName)) {
  477.         # check match not Node_Type - done in lexer...
  478.         # new Function
  479.         my $func_name = $self->{_curr_match};
  480.         match($self, $tokens, '\\(', 1);
  481.         $expr->set_lhs(
  482.                 XML::XPath::Function->new(
  483.                     $self,
  484.                     $func_name,
  485.                     Arguments($self, $tokens)
  486.                 )
  487.             );
  488.         match($self, $tokens, '\\)', 1);
  489.     }
  490.     else {
  491.         die "Not a PrimaryExpr at ", $tokens->[$self->{_tokpos}], "\n";
  492.     }
  493.     
  494.     return $expr;
  495. }
  496.  
  497. sub Arguments {
  498.     my ($self, $tokens) = @_;
  499.     
  500.     debug("in SUB\n");
  501.     
  502.     my @args;
  503.     
  504.     if($tokens->[$self->{_tokpos}] eq ')') {
  505.         return \@args;
  506.     }
  507.     
  508.     push @args, Expr($self, $tokens);
  509.     while (match($self, $tokens, ',')) {
  510.         push @args, Expr($self, $tokens);
  511.     }
  512.     
  513.     return \@args;
  514. }
  515.  
  516. sub LocationPath {
  517.     my ($self, $tokens) = @_;
  518.  
  519.     debug("in SUB\n");
  520.     
  521.     my $loc_path = XML::XPath::LocationPath->new();
  522.     
  523.     if (match($self, $tokens, '/')) {
  524.         # root
  525.         debug("SUB: Matched root\n");
  526.         push @$loc_path, XML::XPath::Root->new();
  527.         if (is_step($self, $tokens)) {
  528.             debug("Next is step\n");
  529.             push @$loc_path, RelativeLocationPath($self, $tokens);
  530.         }
  531.     }
  532.     elsif (match($self, $tokens, '//')) {
  533.         # root
  534.         push @$loc_path, XML::XPath::Root->new();
  535.         my $optimised = optimise_descendant_or_self($self, $tokens);
  536.         if (!$optimised) {
  537.             push @$loc_path, XML::XPath::Step->new($self, 'descendant-or-self',
  538.                                 XML::XPath::Step::test_nt_node);
  539.             push @$loc_path, RelativeLocationPath($self, $tokens);
  540.         }
  541.         else {
  542.             push @$loc_path, $optimised, RelativeLocationPath($self, $tokens);
  543.         }
  544.     }
  545.     else {
  546.         push @$loc_path, RelativeLocationPath($self, $tokens);
  547.     }
  548.     
  549.     return $loc_path;
  550. }
  551.  
  552. sub optimise_descendant_or_self {
  553.     my ($self, $tokens) = @_;
  554.     
  555.     debug("in SUB\n");
  556.     
  557.     my $tokpos = $self->{_tokpos};
  558.     
  559.     # // must be followed by a Step.
  560.     if ($tokens->[$tokpos+1] && $tokens->[$tokpos+1] eq '[') {
  561.         # next token is a predicate
  562.         return;
  563.     }
  564.     elsif ($tokens->[$tokpos] =~ /^\.\.?$/) {
  565.         # abbreviatedStep - can't optimise.
  566.         return;
  567.     }                                                                                              
  568.     else {
  569.         debug("Trying to optimise //\n");
  570.         my $step = Step($self, $tokens);
  571.         if ($step->{axis} ne 'child') {
  572.             # can't optimise axes other than child for now...
  573.             $self->{_tokpos} = $tokpos;
  574.             return;
  575.         }
  576.         $step->{axis} = 'descendant';
  577.         $step->{axis_method} = 'axis_descendant';
  578.         $self->{_tokpos}--;
  579.         $tokens->[$self->{_tokpos}] = '.';
  580.         return $step;
  581.     }
  582. }
  583.  
  584. sub RelativeLocationPath {
  585.     my ($self, $tokens) = @_;
  586.     
  587.     debug("in SUB\n");
  588.     
  589.     my @steps;
  590.     
  591.     push @steps, Step($self, $tokens);
  592.     while (match($self, $tokens, '//?')) {
  593.         if ($self->{_curr_match} eq '//') {
  594.             my $optimised = optimise_descendant_or_self($self, $tokens);
  595.             if (!$optimised) {
  596.                 push @steps, XML::XPath::Step->new($self, 'descendant-or-self',
  597.                                         XML::XPath::Step::test_nt_node);
  598.             }
  599.             else {
  600.                 push @steps, $optimised;
  601.             }
  602.         }
  603.         push @steps, Step($self, $tokens);
  604.         if (@steps > 1 && 
  605.                 $steps[-1]->{axis} eq 'self' && 
  606.                 $steps[-1]->{test} == XML::XPath::Step::test_nt_node) {
  607.             pop @steps;
  608.         }
  609.     }
  610.     
  611.     return @steps;
  612. }
  613.  
  614. sub Step {
  615.     my ($self, $tokens) = @_;
  616.  
  617.     debug("in SUB\n");
  618.     
  619.     if (match($self, $tokens, '\\.')) {
  620.         # self::node()
  621.         return XML::XPath::Step->new($self, 'self', XML::XPath::Step::test_nt_node);
  622.     }
  623.     elsif (match($self, $tokens, '\\.\\.')) {
  624.         # parent::node()
  625.         return XML::XPath::Step->new($self, 'parent', XML::XPath::Step::test_nt_node);
  626.     }
  627.     else {
  628.         # AxisSpecifier NodeTest Predicate(s?)
  629.         my $token = $tokens->[$self->{_tokpos}];
  630.         
  631.         debug("SUB: Checking $token\n");
  632.         
  633.         my $step;
  634.         if ($token eq 'processing-instruction') {
  635.             $self->{_tokpos}++;
  636.             match($self, $tokens, '\\(', 1);
  637.             match($self, $tokens, $LITERAL);
  638.             $self->{_curr_match} =~ /^["'](.*)["']$/;
  639.             $step = XML::XPath::Step->new($self, 'child',
  640.                                     XML::XPath::Step::test_nt_pi,
  641.                         XML::XPath::Literal->new($1));
  642.             match($self, $tokens, '\\)', 1);
  643.         }
  644.         elsif ($token =~ /^\@($NCWild|$QName|$QNWild)$/o) {
  645.             $self->{_tokpos}++;
  646.                         if ($token eq '@*') {
  647.                             $step = XML::XPath::Step->new($self,
  648.                                     'attribute',
  649.                                     XML::XPath::Step::test_attr_any,
  650.                                     '*');
  651.                         }
  652.                         elsif ($token =~ /^\@($NCName):\*$/o) {
  653.                             $step = XML::XPath::Step->new($self,
  654.                                     'attribute',
  655.                                     XML::XPath::Step::test_attr_ncwild,
  656.                                     $1);
  657.                         }
  658.                         elsif ($token =~ /^\@($QName)$/o) {
  659.                             $step = XML::XPath::Step->new($self,
  660.                                     'attribute',
  661.                                     XML::XPath::Step::test_attr_qname,
  662.                                     $1);
  663.                         }
  664.         }
  665.         elsif ($token =~ /^($NCName):\*$/o) { # ns:*
  666.             $self->{_tokpos}++;
  667.             $step = XML::XPath::Step->new($self, 'child', 
  668.                                 XML::XPath::Step::test_ncwild,
  669.                                 $1);
  670.         }
  671.         elsif ($token =~ /^$QNWild$/o) { # *
  672.             $self->{_tokpos}++;
  673.             $step = XML::XPath::Step->new($self, 'child', 
  674.                                 XML::XPath::Step::test_any,
  675.                                 $token);
  676.         }
  677.         elsif ($token =~ /^$QName$/o) { # name:name
  678.             $self->{_tokpos}++;
  679.             $step = XML::XPath::Step->new($self, 'child', 
  680.                                 XML::XPath::Step::test_qname,
  681.                                 $token);
  682.         }
  683.         elsif ($token eq 'comment()') {
  684.                     $self->{_tokpos}++;
  685.             $step = XML::XPath::Step->new($self, 'child',
  686.                             XML::XPath::Step::test_nt_comment);
  687.         }
  688.         elsif ($token eq 'text()') {
  689.             $self->{_tokpos}++;
  690.             $step = XML::XPath::Step->new($self, 'child',
  691.                     XML::XPath::Step::test_nt_text);
  692.         }
  693.         elsif ($token eq 'node()') {
  694.             $self->{_tokpos}++;
  695.             $step = XML::XPath::Step->new($self, 'child',
  696.                     XML::XPath::Step::test_nt_node);
  697.         }
  698.         elsif ($token eq 'processing-instruction()') {
  699.             $self->{_tokpos}++;
  700.             $step = XML::XPath::Step->new($self, 'child',
  701.                     XML::XPath::Step::test_nt_pi);
  702.         }
  703.         elsif ($token =~ /^$AXIS_NAME($NCWild|$QName|$QNWild|$NODE_TYPE)$/o) {
  704.                     my $axis = $1;
  705.                     $self->{_tokpos}++;
  706.                     $token = $2;
  707.             if ($token eq 'processing-instruction') {
  708.                 match($self, $tokens, '\\(', 1);
  709.                 match($self, $tokens, $LITERAL);
  710.                 $self->{_curr_match} =~ /^["'](.*)["']$/;
  711.                 $step = XML::XPath::Step->new($self, $axis,
  712.                                         XML::XPath::Step::test_nt_pi,
  713.                             XML::XPath::Literal->new($1));
  714.                 match($self, $tokens, '\\)', 1);
  715.             }
  716.             elsif ($token =~ /^($NCName):\*$/o) { # ns:*
  717.                 $step = XML::XPath::Step->new($self, $axis, 
  718.                                     (($axis eq 'attribute') ? 
  719.                                     XML::XPath::Step::test_attr_ncwild
  720.                                         :
  721.                                     XML::XPath::Step::test_ncwild),
  722.                                     $1);
  723.             }
  724.             elsif ($token =~ /^$QNWild$/o) { # *
  725.                 $step = XML::XPath::Step->new($self, $axis, 
  726.                                     (($axis eq 'attribute') ?
  727.                                     XML::XPath::Step::test_attr_any
  728.                                         :
  729.                                     XML::XPath::Step::test_any),
  730.                                     $token);
  731.             }
  732.             elsif ($token =~ /^$QName$/o) { # name:name
  733.                 $step = XML::XPath::Step->new($self, $axis, 
  734.                                     (($axis eq 'attribute') ?
  735.                                     XML::XPath::Step::test_attr_qname
  736.                                         :
  737.                                     XML::XPath::Step::test_qname),
  738.                                     $token);
  739.             }
  740.             elsif ($token eq 'comment()') {
  741.                 $step = XML::XPath::Step->new($self, $axis,
  742.                                 XML::XPath::Step::test_nt_comment);
  743.             }
  744.             elsif ($token eq 'text()') {
  745.                 $step = XML::XPath::Step->new($self, $axis,
  746.                         XML::XPath::Step::test_nt_text);
  747.             }
  748.             elsif ($token eq 'node()') {
  749.                 $step = XML::XPath::Step->new($self, $axis,
  750.                         XML::XPath::Step::test_nt_node);
  751.             }
  752.             elsif ($token eq 'processing-instruction()') {
  753.                 $step = XML::XPath::Step->new($self, $axis,
  754.                         XML::XPath::Step::test_nt_pi);
  755.             }
  756.             else {
  757.                 die "Shouldn't get here";
  758.             }
  759.         }
  760.         else {
  761.             die "token $token doesn't match format of a 'Step'\n";
  762.         }
  763.         
  764.         while (match($self, $tokens, '\\[')) {
  765.             push @{$step->{predicates}}, Expr($self, $tokens);
  766.             match($self, $tokens, '\\]', 1);
  767.         }
  768.         
  769.         return $step;
  770.     }
  771. }
  772.  
  773. sub is_step {
  774.     my ($self, $tokens) = @_;
  775.     
  776.     my $token = $tokens->[$self->{_tokpos}];
  777.     
  778.     return unless defined $token;
  779.         
  780.     debug("SUB: Checking if '$token' is a step\n");
  781.     
  782.         local $^W;
  783.         
  784.     if ($token eq 'processing-instruction') {
  785.         return 1;
  786.     }
  787.     elsif ($token =~ /^\@($NCWild|$QName|$QNWild)$/o) {
  788.         return 1;
  789.     }
  790.     elsif ($token =~ /^($NCWild|$QName|$QNWild)$/o && $tokens->[$self->{_tokpos}+1] ne '(') {
  791.         return 1;
  792.     }
  793.     elsif ($token =~ /^$NODE_TYPE$/o) {
  794.         return 1;
  795.     }
  796.     elsif ($token =~ /^$AXIS_NAME($NCWild|$QName|$QNWild|$NODE_TYPE)$/o) {
  797.         return 1;
  798.     }
  799.     
  800.     debug("SUB: '$token' not a step\n");
  801.  
  802.     return;
  803. }
  804.  
  805. sub debug {
  806.     return unless $XML::XPath::Debug;
  807.     
  808.     my ($pkg, $file, $line, $sub) = caller(1);
  809.     
  810.     $sub =~ s/^$pkg\:://;
  811.     
  812.     while (@_) {
  813.         my $x = shift;
  814.         $x =~ s/\bPKG\b/$pkg/g;
  815.         $x =~ s/\bLINE\b/$line/g;
  816.         $x =~ s/\bSUB\b/$sub/g;
  817.         print STDERR $x;
  818.     }
  819. }
  820.  
  821. 1;
  822.