lib/CPAN/lib/Locale/Maketext/Extract/Run.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
colas@0
     1
package Locale::Maketext::Extract::Run;
colas@0
     2
colas@0
     3
use strict;
colas@0
     4
use vars qw( @ISA @EXPORT_OK );
colas@0
     5
colas@0
     6
use Cwd;
colas@0
     7
use File::Find;
colas@0
     8
use Getopt::Long;
colas@0
     9
use Locale::Maketext::Extract;
colas@0
    10
use Exporter;
colas@0
    11
colas@0
    12
@ISA = 'Exporter';
colas@0
    13
@EXPORT_OK = 'xgettext';
colas@0
    14
colas@0
    15
sub xgettext { __PACKAGE__->run(@_) }
colas@0
    16
colas@0
    17
sub run {
colas@0
    18
    my $self = shift;
colas@0
    19
    local @ARGV = @_;
colas@0
    20
colas@0
    21
    my %opts;
colas@0
    22
    Getopt::Long::Configure("no_ignore_case");
colas@0
    23
    Getopt::Long::GetOptions( \%opts,
colas@0
    24
        'f|files-from:s@',
colas@0
    25
        'D|directory:s@',
colas@0
    26
        'u|unescaped',
colas@0
    27
        'g|gnu-gettext',
colas@0
    28
        'o|output:s@',
colas@0
    29
        'd|default-domain:s',
colas@0
    30
        'p|output-dir:s@',
colas@0
    31
        'h|help',
colas@0
    32
    ) or help();
colas@0
    33
    help() if $opts{h};
colas@0
    34
colas@0
    35
    my @po = @{$opts{o} || [($opts{d}||'messages').'.po']};
colas@0
    36
colas@0
    37
    foreach my $file (@{$opts{f}||[]}) {
colas@0
    38
        open FILE, $file or die "Cannot open $file: $!";
colas@0
    39
        while (<FILE>) {
colas@0
    40
            push @ARGV, $_ if -r and !-d;
colas@0
    41
        }
colas@0
    42
    }
colas@0
    43
colas@0
    44
    foreach my $dir (@{$opts{D}||[]}) {
colas@0
    45
        File::Find::find( {
colas@0
    46
            wanted      => sub {
colas@0
    47
                return if
colas@0
    48
                    ( -d ) ||
colas@0
    49
                    ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local' ) ||
colas@0
    50
                    ( /\.po$|\.bak$|~|,D|,B$/i ) ||
colas@0
    51
                    ( /^[\.#]/ );
colas@0
    52
                push @ARGV, $File::Find::name;
colas@0
    53
            },
colas@0
    54
            follow      => 1,
colas@0
    55
        }, $dir );
colas@0
    56
    }
colas@0
    57
colas@0
    58
    @ARGV = ('-') unless @ARGV;
colas@0
    59
    s!^.[/\\]!! for @ARGV;
colas@0
    60
colas@0
    61
    my $cwd = getcwd();
colas@0
    62
colas@0
    63
    foreach my $dir (@{$opts{p}||['.']}) {
colas@0
    64
        foreach my $po (@po) {
colas@0
    65
            my $Ext = Locale::Maketext::Extract->new;
colas@0
    66
            $Ext->read_po($po, $opts{u}) if -r $po;
colas@0
    67
            $Ext->extract_file($_) for grep !/\.po$/i, @ARGV;
colas@0
    68
            $Ext->compile($opts{u}) or next;
colas@0
    69
colas@0
    70
            chdir $dir;
colas@0
    71
            $Ext->write_po($po, $opts{g});
colas@0
    72
            chdir $cwd;
colas@0
    73
        }
colas@0
    74
    }
colas@0
    75
}
colas@0
    76
colas@0
    77
sub help {
colas@0
    78
    local $SIG{__WARN__} = sub {};
colas@0
    79
    { exec "perldoc $0"; }
colas@0
    80
    { exec "pod2text $0"; }
colas@0
    81
}
colas@0
    82
colas@0
    83
1;