File Coverage

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

Criterion	Covered	Total	%
statement	49	50	98.0
branch	2	8	25.0
condition	2	5	40.0
subroutine	10	10	100.0
pod	3	3	100.0
total	66	76	86.8

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

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

our $VERSION = '2.011';

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 $hash_key_suffix = join "\n| ", (
        $list_if->('Gettext',        qr{ __     \b }xms),
        $list_if->('Maketext::Loc',  qr{ _loc   \b }xms),
        $list_if->('Gettext::Loc',   qr{ _loc_  \b }xms),
        $list_if->('BabelFish::Loc', qr{ _loc_b \b }xms),
    );
    $hash_key_suffix ||= '(?!)';

    return qr{
        ^ [ -]*
        (?: content | label | message | value )
        (?:
             $hash_key_suffix
        )
        [ ]* [:]
    }xms;
}

## no critic (ComplexRegexes)
my $text_rule
    = [
        [
            # '...'
            qr{
                [ ]*
                [']
                (
                    [^\\']*             # normal text
                    (?: \\ . [^\\']* )* # maybe followed by escaped char and normal text
                )
                [']
            }xms,
        ],
        'or',
        [
            # "..."
            qr{
                [ ]*
                ["]
                (
                    [^\\"]*             # normal text
                    (?: \\ . [^\\"]* )* # maybe followed by escaped char and normal text
                )
                ["]
            }xms,
        ],
        'or',
        [
            # ...
            qr{
                [ ]*
                (
                    .*? # normal text
                )
                [ ]* $
            }xms,
        ],
    ];

my $rules = [
    # content_loc: |
    #   text
    # ...
    [
        'begin',
        sub {
            my $content_ref = shift;

            my $regex = qr{
                ^ ( [ -]* )
                (?: content | label | message | value ) _ (?: _ | loc_b? | loc )
                [ ]* [:] [ ]* [|] [ ]* \n
            }xms;
            $content_ref
                or return $regex;
            # full match begins here
            my $pos = pos ${$content_ref};
            # begin of heredoc with |
            my ( $full_match, $indent ) = ${$content_ref} =~ m{ \G ( $regex ) }xms
                or return;
            # get heredoc lines
            pos ${$content_ref} = $pos + length $full_match;
            $indent =~ tr{-}{ };
            $indent .= q{ } x 2; # next indent level
            $regex = qr{
                ( [ ]* \n )                 # empty line
                | \Q$indent\E ( [^\n]* \n ) # text line
            }xms;
            my $heredoc = q{};
            while ( ( $full_match, my ( $empty_line, $text_line ) ) = ${$content_ref} =~ m{ \G ( $regex ) }xms ) {
                $heredoc .= $empty_line || $text_line;
                pos ${$content_ref} += length $full_match;
            }
            chomp $heredoc;
            # full match over all
            $full_match = substr
                ${$content_ref},
                $pos,
                ( pos ${$content_ref} ) - $pos;
            # reset pos for alternatives
            pos ${$content_ref} = $pos;

            return $full_match, $heredoc;
        },
        'end',
    ],
    'or',
    # content_loc: 'text ...'
    # label_loc_ : "text ..."
    # message__  : text ...
    # value__    : text ...
    # all combinations left after _ and right to : are possible
    [
        'begin',
        qr{
            ^ [ -]*
            (?: content | label | message | value ) _ (?: _ | loc_b? | loc )
            [ ]* [:]
        }xms,
        'and',
        $text_rule,
        'end',
    ],
];

# remove code after # on pos 1
sub preprocess {
    my $self = shift;

    my $content_ref = $self->content_ref;

    ${$content_ref} =~ s{ \r? \n }{\n}xmsg;
    ${$content_ref} =~ s{
        # "text with #" # comment
        (
            ["]
            [^\\"]*             # normal text
            (?: \\ . [^\\"]* )* # maybe followed by escaped char and normal text
            ["]
        ) [ ]* [#] [^\n]* ( \n | \z )
        |
        # 'text with #' # comment
        (
            [']
            [^\\']*             # normal text
            (?: \\ . [^\\']* )* # maybe followed by escaped char and normal text
            [']
        ) [ ]* [#] [^\n]* ( \n | \z )
        |
        # simple comment line
        [ ]* [#] [^\n]* ( \n | \z )
    }{
        $1   ? "$1$2"
        : $3 ? "$3$4"
        :      $5
    }xmsge;

    return;
}
## use critic (ComplexRegexes)

sub stack_item_mapping {
    my $self = shift;

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

    $self->add_message({
        reference => ( sprintf '%s:%s', $self->filename, $_->{line_number} ),
        domain    => $self->domain,
        msgid     => shift @{$match},
        category  => $self->category,
    });

    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__