File Coverage

blib/lib/HTML/Linear/Path.pm

Criterion	Covered	Total	%
statement	59	59	100.0
branch	10	10	100.0
condition	10	10	100.0
subroutine	14	14	100.0
pod	3	3	100.0
total	96	96	100.0

package HTML::Linear::Path;
# ABSTRACT: represent paths inside HTML::Tree
use strict;
use utf8;
use warnings qw(all);

use JSON;
use Moo;
use MooX::Types::MooseLike::Base qw(:all);

use HTML::Linear::Path::Colors;

## no critic (ProhibitPackageVars)

our $VERSION = '0.019'; # VERSION


has json        => (
    is          => 'ro',
    isa         => InstanceOf['JSON'],
    default     => sub { JSON->new->ascii->canonical },
    lazy        => 1,
);


has address     => (is => 'rw', isa => Str, required => 1);
has attributes  => (is => 'ro', isa => HashRef[Str], required => 1);
has is_groupable=> (is => 'rw', isa => Bool, default => sub { 0 });
has key         => (is => 'rw', isa => Str, default => sub { '' });
has strict      => (is => 'ro', isa => Bool, default => sub { 0 });
has tag         => (is => 'ro', isa => Str, required => 1);

use overload '""' => \&as_string, fallback => 1;


our %groupby = (
    class       => [qw(*)],
    id          => [qw(*)],
    name        => [qw(input meta)],
    'http-equiv'=> [qw(meta)],
    property    => [qw(meta)],
    rel         => [qw(link)],
);


our %tag_weight = (
    title       => 15,
    h1          => 10,
    h2          => 9,
    h3          => 8,
    h4          => 7,
    h5          => 6,
    h6          => 5,
    center      => 3,
    strong      => 2,
    b           => 2,
    u           => 1,
    em          => 1,
    a           => 1,
    sup         => -1,
    sub         => -1,
    samp        => -1,
    pre         => -1,
    kbd         => -1,
    code        => -1,
    blockquote  => -1,
);


our (%xpath_wrap) = (%{$HTML::Linear::Path::Colors::scheme{default}});


sub as_string {
    my ($self) = @_;
    return $self->key if $self->key;

    my $ref = {
        _tag    => $self->tag,
        addr    => $self->address,
    };
    $ref->{attr} = $self->attributes if keys %{$self->attributes};

    return $self->key($self->json->encode($ref));
}


sub as_xpath {
    my ($self, $strict) = @_;

    my $xpath = _wrap(separator => '/') . _wrap(tag => $self->tag);

    my $expr = '';
    for my $attr (keys %groupby) {
        if (_isgroup($self->tag, $attr) and $self->attributes->{$attr}) {
            $expr .= _wrap(array        => '[');
            $expr .= _wrap(sigil        => '@');
            $expr .= _wrap(attribute    => $attr);
            $expr .= _wrap(equal        => '=');
            $expr .= _wrap(value        => _quote($self->attributes->{$attr}));
            $expr .= _wrap(array        => ']');

            $self->is_groupable(1);

            last;
        }
    }

    return $xpath . (
        (not $self->strict and not $strict)
            ? $expr
            : ''
    );
}


sub weight {
    my ($self) = @_;
    return $tag_weight{$self->tag} // 0;
}


sub _quote {
    local ($_) = @_;

    s/\\/\\\\/gsx;
    s/'/\\'/gsx;
    s/\s+/ /gsx;
    s/^\s//sx;
    s/\s$//sx;

    return "'$_'";
}


sub _wrap {
    my ($p, $q) = @_;
    return
        $xpath_wrap{$p}->[0]
        . $q
        . $xpath_wrap{$p}->[1];
}


sub _isgroup {
    my ($tag, $attr) = @_;
    return (
        1 and grep {
            $_ eq '*'
                or
            $_ eq $tag
        } @{$groupby{$attr} // []}
    );
}

1;

__END__