view release on metacpan or  search on metacpan

STX/STXPath.pm  view on Meta::CPAN

    my @step = @$step;
    $self->{tokens} = \@step;

    my $result = $self->nodeTest($node);
    return 0 if $result == -1;

    my $tok = shift @{$self->{tokens}};

    if ($self->{tokens}->[0]) {

	if ($self->{tokens}->[0] eq '[') {

	    $tok = $self->_counter_key($tok);
	    $self->{STX}->{position} 
	      = $self->{STX}->{Counter}->[$#{$self->{STX}->{Stack}}]->{$tok};

	    my $predicate = $self->predExpr($node);
	    #print "EXP: predicate <$predicate->[0]>\n";
	    $self->{STX}->{position} = undef;
	    return $predicate->[0];

	} else {
	    $self->doError(7, 3, $self->{tokens}->[0]);
	}

    } else {return 1}
}

sub nodeTest {
    my ($self, $node) = @_;
    #print "EXP: nodeTest ", $self->{tokens}->[0], "\n";

    if (index($self->{tokens}->[0], '(') > 0 
	or $self->{tokens}->[0] eq 'processing-instruction') {
	return $self->kindTest($node);	

    } else {
	return $self->nameTest($node);
    }
}

sub nameTest {
    my ($self, $node) = @_;
    #print "EXP: nameTest ", $self->{tokens}->[0], "\n";

    return $self->_node_match($node);
}

sub kindTest {
    my ($self, $node) = @_;
    #print "EXP: kindTest ", $self->{tokens}->[0], ", $node->{Type}\n";
    my $test = $self->{tokens}->[0];

    if ($test eq 'node()') {
	return 1;

    } elsif ($test eq 'text()') {
	return 1 if $node->{Type} == 2 or $node->{Type} == 3;

    } elsif ($test eq 'cdata()') {
	return 1 if $node->{Type} == 3;

    } elsif ($test eq 'processing-instruction()') {
	return 1 if $node->{Type} == 4;

    } elsif ($test eq 'processing-instruction') {
	unless ($self->{tokens}->[1] eq '('
		and $self->{tokens}->[2] =~ /^(?:$LITERAL)$/o
		and $self->{tokens}->[3] eq ')') {

	    my $expr = $self->{tokens}->[0] . $self->{tokens}->[1] 
	      . $self->{tokens}->[2] . $self->{tokens}->[3];
	    $self->doError(5, 3, $expr);
	}
	
	my $target = substr($self->{tokens}->[2], 1, 
			    length($self->{tokens}->[2]) - 2);
	shift @{$self->{tokens}};
	shift @{$self->{tokens}};
	shift @{$self->{tokens}};
	$self->{tokens}->[0] = "processing-instruction:$target";

	return 1 if ($node->{Type} == 4 and $node->{Target} eq $target);

    } elsif ($test eq 'comment()') {
	return 1 if $node->{Type} == 5;

    } else {
	$self->doError(8, 3);
    }
    return -1;
}

sub predExpr {
    my ($self, $node) = @_;
    #print "EXP: predExpr ", $self->{tokens}->[0], "\n";

    shift @{$self->{tokens}};
    my $result = $self->orExpr([$node]);
    unless ($self->{tokens}->[0] eq ']') {
	$self->doError(9, 3, $self->{tokens}->[0]);
    }
    shift @{$self->{tokens}};
    #print "EXP: ", _dbg_print('predExpr', $result);

     if ($#$result == 0 and $result->[0]->[1] == STX_NUMBER) {
	 if ($self->{STX}->{position} == $result->[0]->[0]) {
	     return [1, STX_BOOLEAN];
	 } else {
	     return [0, STX_BOOLEAN];
	 }

     } else {
	 return $self->F_boolean($result);	 
     }
}

# utils ----------------------------------------

# if a stack frame matches a QName, the node is returned