File Coverage

blib/lib/Locale/Maketext/Extract/Run.pm

Criterion	Covered	Total	%
statement	82	95	86.3
branch	23	42	54.7
condition	3	19	15.7
subroutine	13	16	81.2
pod	0	3	0.0
total	121	175	69.1

package Locale::Maketext::Extract::Run;
$Locale::Maketext::Extract::Run::VERSION = '1.00';
use strict;
use vars qw( @ISA @EXPORT_OK );
use File::Spec::Functions qw(catfile);

# ABSTRACT: Module interface to xgettext.pl


use Cwd;
use Config ();
use File::Find;
use Getopt::Long;
use Locale::Maketext::Extract;
use Exporter;

use constant HAS_SYMLINK => ( $Config::Config{d_symlink} ? 1 : 0 );

@ISA       = 'Exporter';
@EXPORT_OK = 'xgettext';

sub xgettext { __PACKAGE__->run(@_) }

sub run {
    my $self = shift;
    local @ARGV = @_;

    my %opts;
    Getopt::Long::Configure("no_ignore_case");
    Getopt::Long::GetOptions(
        \%opts,               'f|files-from:s@',
        'D|directory:s@',     'u|use-gettext-style|unescaped',
        'g|gnu-gettext',      'o|output:s@',
        'd|default-domain:s', 'p|output-dir:s@',
        'P|plugin:s@',        'W|wrap!',
        'w|warnings!',        'v|verbose+',
        'h|help',
    ) or help();

    help() if $opts{h};

    my %extract_options = %{ $self->_parse_extract_options( \%opts ) };

    my @po = @{ $opts{o} || [ ( $opts{d} || 'messages' ) . '.po' ] };

    foreach my $file ( @{ $opts{f} || [] } ) {
        open FILE, $file or die "Cannot open $file: $!";
        while () {
            chomp;
            push @ARGV, $_ if -r and !-d;
        }
    }

    foreach my $dir ( @{ $opts{D} || [] } ) {
        File::Find::find(
            {   wanted => sub {
                    if (-d) {
                        $File::Find::prune
                            = /^(\.svn|blib|autogen|var|m4|local|CVS|\.git)$/;
                        return;
                    }

                    # Only extract from non-binary, normal files
                    return unless ( -f or -s ) and -T;
                    return
                        if (/\.pot?$|\.bak$|~|,D|,B$/i)
                        || (/^[\.#]/);
                    push @ARGV, $File::Find::name;
                },
                follow => HAS_SYMLINK,
            },
            $dir
        );
    }

    @ARGV = ('-') unless @ARGV;
    s!^\.[/\\]!! for @ARGV;

    my $cwd = getcwd();

    my $Ext = Locale::Maketext::Extract->new(%extract_options);
    foreach my $dir ( @{ $opts{p} || ['.'] } ) {
        $Ext->extract_file($_) for grep !/\.po$/i, @ARGV;
        foreach my $po (@po) {
            $Ext->read_po($po) if -r $po and -s _;
            $Ext->compile( $opts{u} ) or next;
            $Ext->write_po( catfile( $dir, $po ), $opts{g} );
        }
    }
}

sub _parse_extract_options {
    my $self = shift;
    my $opts = shift;

    # If a list of plugins is specified, then we use those modules
    # plus their default list of file extensions
    # and warnings enabled by default

    my %extract_options
        = ( verbose => $opts->{v}, wrap => $opts->{W} || 0 );

    if ( my $plugin_args = $opts->{P} ) {

        # file extension with potentially multiple dots eg .tt.html
        my %plugins;

        foreach my $param (@$plugin_args) {
            my ( $plugin, $args )
                = ( $param =~ /^([a-z_]\w+(?:::\w+)*)(?:=(.+))?$/i );
            die "Couldn't understand plugin option '$param'"
                unless $plugin;
            my @extensions;
            if ($args) {
                foreach my $arg ( split /,/, $args ) {
                    if ( $arg eq '*' ) {
                        @extensions = ('*');
                        last;
                    }
                    my ($extension) = ( $arg =~ /^\.?(\w+(?:\.\w+)*)$/ );
                    die "Couldn't understand '$arg' in plugin '$param'"
                        unless defined $extension;
                    push @extensions, $extension;
                }
            }

            $plugins{$plugin} = \@extensions;
        }
        $extract_options{plugins} = \%plugins;
        $extract_options{warnings} = exists $opts->{w} ? $opts->{w} : 1;
    }

    # otherwise we default to the original xgettext.pl modules
    # with warnings disabled by default
    else {
        $extract_options{warnings} = $opts->{w};
    }
    return \%extract_options;

}

sub help {
    local $SIG{__WARN__} = sub { };
    { exec "perldoc $0"; }
    { exec "pod2text $0"; }
}

1;

__END__