File Coverage

blib/lib/Locale/TextDomain/OO/Util/ExtractHeader.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	8	10	80.0
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	47	49	95.9

package Locale::TextDomain::OO::Util::ExtractHeader; ## no critic (TidyCode)

use strict;
use warnings;
use 5.010;

use Carp qw(confess);
use English qw(-no_match_vars $EVAL_ERROR);
use namespace::autoclean;

our $VERSION = '4.001';

sub instance {
    return __PACKAGE__;
}

my $really_compile_formula = sub {
    my ($formula) = @_;

    ## no critic (ComplexRegexes EnumeratedClasses EscapedMetacharacters)
    $formula =~ m{
        \A \s*+ (?&expr) \z
        (?(DEFINE)
            (?
                (?>
                    (?> ~ | ! (?! = ) | - (?! [\-=] ) | \+ (?! [+=] ) ) \s*+
                )*+

                (?>
                    [1-9] [0-9]*+ \b
                |
                    0 0*+ \b
                |
                    n \b
                |
                    \( \s*+ (?&expr) \)
                )
                \s*+
            )
            (?
                (?&term)
                (?>
                    (?>
                        \? \s*+ (?&expr) :
                    |
                        \|\| | &&
                    |
                        == | !=
                    |
                        << (?! = ) | >> (?! = )
                    |
                        <= | >=
                    |
                        < (?! [<=] ) | > (?! [>=] )
                    |
                        - (?! [-=] )
                    |
                        \+ (?! [+=] )
                    |
                        \| (?! [|=] )
                    |
                        & (?! [&=] )
                    |
                        / (?! [/*=] )
                    |
                        [\^*%] (?! = )
                    )
                    \s*+
                    (?&term)
                )*+
            )
        )
    }xms
        or confess "Invalid formula: $formula";
    ## use critic (ComplexRegexes EnumeratedClasses EscapedMetacharacters)

    $formula =~ s{ \b n \b }{\$n}xmsg;
    my $sub = eval "sub { my \$n = shift; use integer; 0 + ($formula) }" ## no critic (StringyEval)
        or confess "Internal error: $formula: $EVAL_ERROR";

    return $sub;
};

my %compiled_formula_cache;
my $compile_formula = sub {
    my $formula = shift;

    return $compiled_formula_cache{$formula} ||= $really_compile_formula->($formula);
};

sub extract_header_msgstr {
    my ( undef, $header_msgstr ) = @_;

    defined $header_msgstr
        or confess 'Header is not defined';
    ## no critic (ComplexRegexes EnumeratedClasses)
    my ( $plural_forms, $nplurals, $plural ) = $header_msgstr =~ m{
        ^
        Plural-Forms:
        [ ]*
        (
            nplurals [ ]* [=] [ ]* ([0-9]+)   [ ]* [;]
            [ ]*
            plural   [ ]* [=] [ ]* ([^;\n]+) [ ]* [;]?
            [ ]*
        )
        $
    }xms
        or confess 'Plural-Forms not found in header';
    ## use critic (ComplexRegexes EnumeratedClasses)
    my ( $charset ) = $header_msgstr =~ m{
        ^
        Content-Type:
        [^;]+ [;] [ ]*
        charset [ ]* = [ ]*
        ( [^ ]+ )
        [ ]*
        $
    }xms
        or confess 'Content-Type with charset not found in header';
    my ( $lexicon_class ) = $header_msgstr =~ m{
        ^ X-Lexicon-Class: \s* ( \S* ) \s* $
    }xms;
    # ToDo: remove because multiplural was a too complicated idea
    ## no critic (EnumeratedClasses)
    my ( $multiplural_nplurals ) = $header_msgstr =~ m{
        ^ X-Multiplural-Nplurals: [ ]* ( [0-9]+ ) [ ]* $
    }xms;
    ## use critic (EnumeratedClasses)

    return {(
        nplurals                 => 0 + $nplurals,
        plural                   => $plural,
        plural_code              => $compile_formula->($plural),
        charset                  => $charset,
        ! $lexicon_class ? () : (
            lexicon_class        => $lexicon_class,
        ),
        # ToDo: remove because multiplural was a too complicated idea
        ! $multiplural_nplurals ? () : (
            multiplural_nplurals => $multiplural_nplurals,
        ),
    )};
}

1;

__END__