view release on metacpan or  search on metacpan

lib/Locale/TextDomain/OO/Extract/Perl.pm  view on Meta::CPAN

        'begin',
        qr{ \b loc_begin_b ( dc ) \s* [(] }xms,
        'and',
        $domain_rule,
        'and',
        $comma_rule,
        'and',
        $category_rule,
        'end',
    ],

    # end
    'or',
    [
        'begin',
        qr{ \b (?: loc_ | __ ) ( end ) [_] ( [dc] ) \b }xms,
        'end',
    ],
    'or',
    [
        'begin',
        qr{ \b (?: loc_ | __ ) ( end ) [_] ( dc ) \b }xms,
        'end',
    ],
    'or',
    [
        'begin',
        qr{ \b loc_end_b ( [dc] ) \b }xms,
        'end',
    ],
    'or',
    [
        'begin',
        qr{ \b loc_end_b ( dc ) \b }xms,
        'end',
    ],
];

# remove pod and all lines after __END__, handle different newlines
sub preprocess {
    my $self = shift;

    my $content_ref = $self->content_ref;

    # remove all lines after __END__
    # replace pod without killing the line number
    my ($is_pod, $is_end);
    ${$content_ref}
        = join "\n",
        map {
            $_ eq '__END__'          ? do { $is_end = 1; q{} }
            : $is_end                ? ()
            : m{ \A [=] ( \w+ ) }xms ? (
                lc $1 eq 'cut'
                ? do { $is_pod = 0; q{} }
                : do { $is_pod = 1; q{} }
            )
            : $is_pod                ? q{}
            : $_;
        }
        split m{ \r? \n }xms, ${$content_ref};

    # replace heredoc's without killing the line number
    # <<'...'
    REPLACE: {
        ${$content_ref} =~ s{
            << \s* ' ( \w+ ) ' ( [^\n]* ) \n
            ( .*? )
            ^ \1 $
        }
        {
            qq{\n'}
            . do { my $text = $3; $text =~ s{'}{\\'}xmsg; $text }
            . q{'}
            . $2
        }xmsge and redo REPLACE;
    }
    # <<...
    # <<"..."
    REPLACE: {
        ${$content_ref} =~ s{
            << \s* ( ["]? ) ( \w+ ) \1 ( [^\n]* ) \n
            ( .*? )
            ^ \2 $
        }
        {
            qq{\n"}
            . do { my $text = $4; $text =~ s{"}{\\"}xmsg; $text }
            . q{"}
            . $3
        }xmsge and redo REPLACE;
    }

    return $self;
}

sub interpolate_escape_sequence {
    my ( undef, $string, $quot ) = @_;

    # nothing to interpolate
    defined $string
        or return $string;
    defined $quot
        or confess 'Quote expected';

    my $is_interpolate = $quot eq q{"} || $quot eq 'qq{';
    if ( ! $is_interpolate ) {
        # '...'
        if ( $quot eq q{'} ) {
            $string =~ s{ \\ ( ['] ) }{$1}xmsg;
            return $string;
        }
        # q{...}
        if ( $quot eq 'q{' ) {
            $string =~ s{ \\ ( [\{\}] ) }{$1}xmsg; ## no critic (EscapedMetacharacters)
            return $string;
        }
        confess "Unknown quot $quot";
    }

    # "..."