File Coverage

lib/HTML/Element/AbsoluteXPath.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	9	10	90.0
condition			n/a
subroutine	4	4	100.0
pod	0	1	0.0
total	55	57	96.4

use strict;
use warnings;
package HTML::Element::AbsoluteXPath;

# ABSTRACT: Add absolute XPath support to HTML::Element

our $VERSION = '1.0'; # VERSION

use HTML::Element 5.03;

sub HTML::Element::abs_xpath{
    my $self = shift;
    my @hint = @_;

    push(@hint,'_tag') unless grep{$_ eq '_tag'}@hint;

    my $raddr = $self->root()->address;
    my @lin;
    my $ee = $self;
    while( $ee->address ne $raddr ){
        my $p = $ee->parent();
        my %filters;
        foreach (sort @hint){
            my $v = $ee->attr($_);
            next unless $v;
            $filters{$_} = $v;
        }
        my @sib = $p->look_down(%filters);

        @sib = grep{$_->depth() == $ee->depth()}@sib;
        my $idx = 1;
        foreach (@sib){
            last if $_->address eq $ee->address;
            $idx++;
        }

        my @attrs;
        foreach (sort keys %filters){
            next if $_ eq '_tag';
            my $v = $filters{$_};
            my $pat = "\@$_='$v'";
            push(@attrs,$pat);
        }

        my $attr = '';
        $attr = "[".join(' and ',@attrs)."]" if @attrs;

        push(@lin, $ee->tag() . $attr . "[$idx]" );
        $ee = $p;
    }
    push(@lin, $ee->tag().'[1]' );
    return '/'.join('/',reverse @lin);
}




1;

__END__