File Coverage

blib/lib/Locale/TextDomain/OO/Extract/HTML.pm

Criterion	Covered	Total	%
statement	53	54	98.1
branch	2	4	50.0
condition	2	5	40.0
subroutine	10	10	100.0
pod	3	3	100.0
total	70	76	92.1

package Locale::TextDomain::OO::Extract::HTML; ## no critic (TidyCode MainComplexity)

use strict;
use warnings;
use Moo;
use MooX::Types::MooseLike::Base qw(ArrayRef Str);
use namespace::autoclean;

our $VERSION = '2.017';

extends qw(
    Locale::TextDomain::OO::Extract::Base::RegexBasedExtractor
);
with qw(
    Locale::TextDomain::OO::Extract::Role::File
);

has filter => (
    is      => 'rw',
    isa     => ArrayRef[Str],
    lazy    => 1,
    default => sub {[ 'all' ]},
);

sub _filtered_start_rule {
    my $self = shift;

    my %filter_of = map { $_ => 1 } @{ $self->filter };
    my $list_if = sub {
        my ( $key, @list ) = @_;
        my $condition
            = $filter_of{all} && ! $filter_of{"!$key"}
            || $filter_of{$key};
        return $condition ? @list : ();
    };
    my $with_bracket = join "\n| ", (
        $list_if->('Gettext',      qr{ ["] [^"]*? \b __   \b [^"]*? ["] }xms,
                                   qr{ ['] [^']*? \b __   \b [^']*? ['] }xms),
        $list_if->('Gettext::Loc', qr{ ["] [^"]*? \b loc_ \b [^"]*? ["] }xms,
                                   qr{ ['] [^']*? \b loc_ \b [^']*? ['] }xms),
        $list_if->('Maketext',     qr{ ["] [^"]*? \b loc  \b [^"]*? ["] }xms,
                                   qr{ ['] [^']*? \b loc  \b [^']*? ['] }xms),
    );
    $with_bracket ||= '(?!)';

    return qr{
        [<] [^>]*?
        \b class \s* [=] \s*
        (?: $with_bracket )
    }xms;
}

## no critic (ComplexRegexes)
my $text_rule = qr{ \s* ( [^<]+ ) }xms;

my $rules = [
    #
    #
    #
    [
        'begin',
        sub {
            my $content_ref = shift;

            my $regex = qr{
                [<] input \b
                ( [^>]* )
                />
            }xms;
            $content_ref
                or return $regex;
            my ( $full_match, $inner )
                = ${$content_ref} =~ m{ \G ( $regex ) }xms
                    or return;

            my @match = (
                $inner =~ m{ \b placeholder \s* [=] \s* ["] ( [^"]+ ) ["] }xms,
                $inner =~ m{ \b placeholder \s* [=] \s* ['] ( [^']+ ) ['] }xms,
                $inner =~ m{ \b title \s* [=] \s* ["] ( [^"]+ ) ["] }xms,
                $inner =~ m{ \b title \s* [=] \s* ['] ( [^']+ ) ['] }xms,
                (
                    $inner =~ m{ \b type \s* [=] \s* ["] (?: submit | reset | button ) ["] }xms
                    || $inner =~ m{ \b type \s* [=] \s* ['] (?: submit | reset | button ) ['] }xms
                )
                ? (
                    $inner =~ m{ \b value \s* [=] \s* ["] ( [^"]+ ) ["] }xms
                    ? $1
                    : $inner =~ m{ \b value \s* [=] \s* ['] ( [^']+ ) ['] }xms
                    ? $1
                    : ()
                )
                : (),
            );
            @match
                and return +( $full_match, @match );

            return;
        },
        'end',
    ],
    'or',
    # </tr>

<tr>
<td  class="h" >
<a name="103">103</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">     #   class="... loc_|__|loc ..."
 </td>
</tr>

<tr>
<td  class="h" >
<a name="104">104</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">     #   placeholder="text to extract"
 </td>
</tr>

<tr>
<td  class="h" >
<a name="105">105</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">     #   ...
 </td>
</tr>

<tr>
<td  class="h" >
<a name="106">106</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">     # >
    [
        'begin',
        sub {
            my $content_ref = shift;

            my $regex = qr{
                [<] textarea \b
                ( [^>]* )
                [>]
            }xms;
            $content_ref
                or return $regex;
            my ( $full_match, $inner )
                = ${$content_ref} =~ m{ \G ( $regex ) }xms
                    or return;
                $inner =~ m{ \b placeholder \s* [=] \s* ["] ( [^"]+ ) ["] }xms
                    and return +( $full_match, $1 );
                $inner =~ m{ \b placeholder \s* [=] \s* ['] ( [^']+ ) ['] }xms
                    and return +( $full_match, $1 );

            return;
        },
        'end',
    ],
    'or',
    #
    [
        'begin',
        sub {
            my $content_ref = shift;

            my $regex = qr{
                [<] img \b
                ( [^>]* )
                />
            }xms;
            $content_ref
                or return $regex;
            my ( $full_match, $inner )
                = ${$content_ref} =~ m{ \G ( $regex ) }xms
                    or return;

            my @match = (
                $inner =~ m{ \b alt \s* [=] \s* ["] ( [^"]+ ) ["] }xms,
                $inner =~ m{ \b alt \s* [=] \s* ['] ( [^']+ ) ['] }xms,
            );
            @match
                and return +( $full_match, @match );

            return;
        },
        'end',
    ],
    'or',
    # text_to_extract
    [
        'begin',
        sub {
            my $content_ref = shift;

            my $regex = qr{
                [<] [a] \b
                ( [^>]* )
                [>]
                ( [^<]* )
            }xms;
            $content_ref
                or return $regex;
            my ( $full_match, $inner, $text )
                = ${$content_ref} =~ m{ \G ( $regex ) }xms
                    or return;

            my @match = (
                $inner =~ m{ \b title \s* [=] \s* ["] ( [^"]+ ) ["] }xms,
                $inner =~ m{ \b title \s* [=] \s* ['] ( [^']+ ) ['] }xms,
            );
            @match
                and return +( $full_match, $text, @match );

            return;
        },
        'end',
    ],
    'or',
    # text_to_extract
    [
        'begin',
        sub {
            my $content_ref = shift;

            my $regex = qr{
                [<] button \b
                ( [^>]* )
                [>]
                ( [^<]* )
            }xms;
            $content_ref
                or return $regex;
            my ( $full_match, $inner, $text )
                = ${$content_ref} =~ m{ \G ( $regex ) }xms
                    or return;

            my @match = (
                $inner =~ m{ \b title \s* [=] \s* ["] ( [^"]+ ) ["] }xms,
                $inner =~ m{ \b title \s* [=] \s* ['] ( [^']+ ) ['] }xms,
            );
            @match
                and return +( $full_match, $text, @match );

            return;
        },
        'end',
    ],
    'or',
    # < class="... loc_|__|loc ..." ... title="text to extract" ... >text_to_extract<
    [
        'begin',
        sub {
            my $content_ref = shift;

            my $regex = qr{
                [<] \w+ \b
                ( [^>]* )
                [>]
                ( [^<]* )
            }xms;
            $content_ref
                or return $regex;
            my ( $full_match, $inner, $text )
                = ${$content_ref} =~ m{ \G ( $regex ) }xms
                    or return;


            my @match = (
                $inner =~ m{ \b title \s* [=] \s* ["] ( [^"]+ ) ["] }xms,
                $inner =~ m{ \b title \s* [=] \s* ['] ( [^']+ ) ['] }xms,
                $text,
            );
            @match
                and return +( $full_match, @match );

            return;
        },
        'end',
    ],
    'or',
    # <... class="... loc_|__|loc ..." ... >text to extract<
    [
        'begin',
        qr{
            [<] [^>]*?
            \b class \s* [=] \s* ["] [^"]*?
            \b (?: loc_ | __ | loc ) \b
            [^"]*? ["]
            [^>]* [>]
        }xms,
        'and',
        $text_rule,
        'end',
    ],
    'or',
    # <... class='... loc_|__|loc ...' ... >text to extract<
    [
        'begin',
        qr{
            [<] [^>]*?
            \b class \s* [=] \s* ['] [^']*?
            \b (?: loc_ | __ | loc ) \b
            [^']*? [']
            [^>]* [>]
        }xms,
        'and',
        $text_rule,
        'end',
    ],
];
## use critic (ComplexRegexes)

# remove code between
sub preprocess {
    my $self = shift;

    my $content_ref = $self->content_ref;

    ${$content_ref} =~ s{ \r? \n }{\n}xmsg;
    ${$content_ref} =~ s{  }{
        join q{}, $1 =~ m{ ( \n ) }xmsg
    }xmsge;

    return $self;
}

sub stack_item_mapping {
    my $self = shift;

    my $match = $_->{match};
    @{$match}
        or return;

    while ( my $string = shift @{$match} ) {
        $string =~ s{ \s+ \z }{}xms;
        $string =~ s{ \A \s+ }{}xms;
        my ( $msgctxt, $msgid )
            = $string =~ m{ \A (?: ( .*? ) \s* \Q{CONTEXT_SEPARATOR}\E )? \s* ( .* ) \z }xms;
        $self->add_message({
            reference => ( sprintf '%s:%s', $self->filename, $_->{line_number} ),
            msgctxt   => $msgctxt,
            msgid     => $msgid,
        });
    }

    return;
}

sub extract {
    my $self = shift;

    $self->start_rule( $self->_filtered_start_rule );
    $self->rules($rules);
    $self->preprocess;
    $self->SUPER::extract;
    for ( @{ $self->stack } ) {
        $self->stack_item_mapping;
    }

    return $self;
}

__PACKAGE__->meta->make_immutable;

1;

__END__