view release on metacpan or  search on metacpan

STX/STXPath.pm  view on Meta::CPAN

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

    my $res_nodes = [];

    # child axis
    if ($self->{axis} == 1) {
	foreach (@$nodes) {

	    # frame exists
	    if (@{$self->{STX}->{Stack}} > $_->{Index}+1) {
		my $node = $self->{STX}->{Stack}->[$_->{Index}+1];
		my $res = $self->_node_match($node);
		push @$res_nodes, $res if $res != -1;
	    }
	}

    # descendant axis	
    } elsif ($self->{axis} == 2) {
	foreach (@$nodes) {
	    # scan all descendants
	    for (my $i = $_->{Index}+1; $i < @{$self->{STX}->{Stack}}; $i++) {
		my $node = $self->{STX}->{Stack}->[$i];
		my $res = $self->_node_match($node);
		push @$res_nodes, $res if $res != -1;
	    }
	}
    }
    shift @{$self->{tokens}};
    return $res_nodes;
}

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

    my $res_nodes = [];

    foreach (@{$nodes}) {
	my $res = $self->_attribute_match($_->{Index});
	push @$res_nodes, @$res;
    }
    shift @{$self->{tokens}};
    #print "EXP: attributeNameTest ",join(':',map($_->{Name},@$res_nodes)),"\n";

    # nodes are turned to a sequence
    my @seq = map([$_,STX_NODE], @$res_nodes);
    return \@seq;
}

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

    my $ns_nodes = [];
    my $pref = $self->{tokens}->[0];

    if ($node->{Type} == 1) {
	my @prefs = $pref eq '*' ? $self->{STX}->{ns}->get_prefixes 
	  : ($self->{tokens}->[0]);

	foreach (@prefs) {
	    my $p = $_ eq '' ? '#default' : $_;
	    my $uri = $self->{STX}->{ns}->get_uri($p);
	    my $node = {Type => 8, 
			Index => scalar @{$self->{STX}->{Stack}} + 1,
			Name => $p,
			Value => $uri,
		       };
	    #print "EXP: NS node $p|$uri\n";
	    push @$ns_nodes, $node;
	}
    } else {
       	$self->doError(17, 3, $node->{Type});
    }

    return $ns_nodes;
}

# ==================================================
# Match Pattern

# pathPattern
sub matchPath {
    my ($self, $node, $path) = @_;
    my $i = $#$path;
    #print "EXP: matchPath $i\n";

    my $result = 1;

    while ($i >= 0 and $result) {
	my $step = $path->[$i];
	#print "EXP: matchPath->$i $step->{left}:$#{$step->{step}}\n";
	#print "EXP: matchPath->$i node $node->{Index}\n";

	# to handle '/' pattern
	if ($#{$step->{step}} == -1 && $step->{left} eq 'R') {
	    #print "EXP: '/' pattern, node: $node->{Type}\n";
	    if ($node->{Type} == STX_ROOT_NODE) {
		return 1;
	    } else {
		return 0;
	    }
	}

	$result = $self->matchStep($node, $step->{step});
	#print "EXP: matchPath->$i <$result>\n";
	return 0 unless $result;

	if ($step->{left} eq 'P') {
	    #print "EXP: matchPath->$i process parent\n";
	    $node = $self->{STX}->{Stack}->[$node->{Index}-1];

	} elsif ($step->{left} eq 'R') {
	    #print "EXP: matchPath->$i verify root\n";
	    return $node->{Index} == 1 ? $result : 0;

	} elsif ($step->{left} eq 'A') {
	    #print "EXP: matchPath->$i process ancestors\n";
	    my $a_result = 0;

	    foreach (my $j = $node->{Index} - 1; $j >= 0; $j--) {