view release on metacpan or  search on metacpan

lib/HTML/Selector/XPath.pm  view on Meta::CPAN

    } elsif ($op eq '$=') {
        my $n = length($^N) - 1;
        "substring(\@$left,string-length(\@$left)-$n)='$^N'";
    } else { # exact match
        "\@$left='$^N'";
    }
}

sub _generate_child {
    my ($direction,$name,$a,$b) = @_;
    if ($a == 0) { # 0n+b
        $b--;
        "[count($direction-sibling::$name) = $b and parent::*]"
    } elsif ($a > 0) { # an + b
        return "[not((count($direction-sibling::$name)+1)<$b) and ((count($direction-sibling::$name) + 1) - $b) mod $a = 0 and parent::*]"
    } else { # -an + $b
        $a = -$a;
        return "[not((count($direction-sibling::$name)+1)>$b) and (($b - (count($direction-sibling::$name) + 1)) mod $a) = 0 and parent::*]"
    }
}

sub nth_child {
    my ($a,$b) = @_;
    if (@_ == 1) {
        ($a,$b) = (0,$a);
    }
    _generate_child('preceding', '*', $a, $b);
}

sub nth_last_child {
    my ($a,$b) = @_;
    if (@_ == 1) {
        ($a,$b) = (0,$a);
    }
    _generate_child('following', '*', $a, $b);
}

# A hacky recursive descent
# Only descends for :not(...)
sub consume_An_plus_B {
    my( $rrule ) = @_;

    my( $A, $B );

    if( $$rrule =~ s/^odd\s*\)// ) {
        ($A,$B) = (2, 1)
    } elsif( $$rrule =~ s/^even\s*\)// ) {
        ($A,$B) = (2, 0)
    } elsif( $$rrule =~ s/^\s*(-?\d+)\s*\)// ) {
        ($A,$B) = (0, $1)
    } elsif( $$rrule =~ s/^\s*(-?\d*)\s*n\s*(?:\+\s*(\d+))?\s*\)// ) {
        ($A,$B) = ($1, $2 || 0);
        if( ! defined $A ) {
            $A = '0';
        } elsif( $A eq '-') {
            $A = '-1';
        } elsif( $A eq '' ) {
            $A = '1';
        }
    } else {
        croak "Can't parse formula from '$$rrule'";
    }

    return ($A, $B);
}

sub consume {
    my ($self, $rule, %parms) = @_;
    my $root = $parms{root} || '/';

    return [$rule,''] if $rule =~ m!^/!; # If we start with a slash, we're already an XPath?!

    my @parts = ("$root/");
    my $last_rule = '';
    my @next_parts;

    my $wrote_tag;
    my $root_index = 0; # points to the current root
    # Loop through each "unit" of the rule
    while (length $rule && $rule ne $last_rule) {
        $last_rule = $rule;

        $rule =~ s/^\s*|\s*$//g;
        last unless length $rule;

        # Prepend explicit first selector if we have an implicit selector
        # (that is, if we start with a combinator)
        if ($rule =~ /$reg->{combinator}/) {
            $rule = "* $rule";
        }

        # Match elements
        if ($rule =~ s/$reg->{element}//) {
            my ($id_class,$name,$lang) = ($1,$2,$3);

            # to add *[1]/self:: for follow-sibling
            if (@next_parts) {
                push @parts, @next_parts; #, (pop @parts);
                @next_parts = ();
            }

            my $tag = $id_class eq '' ? $name || '*' : '*';

            if (defined $parms{prefix} and not $tag =~ /[*:|]/) {
                $tag = join ':', $parms{prefix}, $tag;
            }

            if (! $wrote_tag++) {
                push @parts, $tag;
            }

            # XXX Shouldn't the RE allow both, ID and class?
            if ($id_class eq '#') { # ID
                push @parts, "[\@id='$name']";
            } elsif ($id_class eq '.') { # class
                push @parts, "[contains(concat(' ', normalize-space(\@class), ' '), ' $name ')]";
            };
        };

        # Match attribute selectors
        if ($rule =~ s/$reg->{attr2}//) {