File Coverage

blib/lib/Locale/Maketext/Extract/Plugin/PPI.pm

Criterion	Covered	Total	%
statement	46	47	97.8
branch	21	24	87.5
condition	17	24	70.8
subroutine	5	6	83.3
pod	2	2	100.0
total	91	103	88.3

package Locale::Maketext::Extract::Plugin::PPI;
$Locale::Maketext::Extract::Plugin::PPI::VERSION = '1.00';
use strict;
use base qw(Locale::Maketext::Extract::Plugin::Base);
use PPI();

# ABSTRACT: Perl format parser


sub file_types {
    return qw( pm pl cgi );
}

my %subnames = map { $_ => 1 } qw (translate maketext gettext l loc x __);

#===================================
sub extract {
#===================================
    my $self = shift;
    my $text = shift;

    my $doc = PPI::Document->new( \$text, index_locations => 1 );

    foreach my $statement ( @{ $doc->find('PPI::Statement') } ) {
        my @children = $statement->schildren;

        while ( my $child = shift @children ) {
            next
                unless @children
                && ( $child->isa('PPI::Token::Word')
                && $subnames{ $child->content }
                || $child->isa('PPI::Token::Magic')
                && $child->content eq '_' );

            my $list = shift @children;
            next
                unless $list->isa('PPI::Structure::List')
                && $list->schildren;

            $self->_check_arg_list($list);
        }
    }
}

#===================================
sub _check_arg_list {
#===================================
    my $self = shift;
    my $list = shift;
    my @args = ( $list->schildren )[0]->schildren;

    my $final_string = '';
    my ( $line, $mode );

    while ( my $string_el = shift @args ) {
        return
            unless $string_el->isa('PPI::Token::Quote')
            || $string_el->isa('PPI::Token::HereDoc');
        $line ||= $string_el->location->[0];
        my $string;
        if ( $string_el->isa('PPI::Token::HereDoc') ) {
            $string = join( '', $string_el->heredoc );
            $mode
                = $string_el->{_mode} eq 'interpolate'
                ? 'double'
                : 'literal';
        }
        else {
            $string = $string_el->string;
            $mode
                = $string_el->isa('PPI::Token::Quote::Literal') ? 'literal'
                : (    $string_el->isa('PPI::Token::Quote::Double')
                    || $string_el->isa('PPI::Token::Quote::Interpolate') )
                ? 'double'
                : 'single';
        }

        if ( $mode eq 'double' ) {
            return
                if !!( $string =~ /(?
            $string = eval qq("$string");
        }
        elsif ( $mode eq 'single' ) {
            $string =~ s/\\'/'/g;
        }

        #    $string =~ s/(?
        $string =~ s/\\\\/\\/g;

        #        unless $mode eq 'literal';

        $final_string .= $string;

        my $next_op = shift @args;
        last
            unless $next_op
            && $next_op->isa('PPI::Token::Operator')
            && $next_op->content eq '.';
    }
    return unless $final_string;

    my $vars = join( '', map { $_->content } @args );
    $self->add_entry( $final_string, $line, $vars );
}


1;

__END__