The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
# implements xgettext for Log::Report only, using Log::Report::Extract::PPI
# Options like GNU's xgettext

use warnings;
use strict;

use Log::Report 'log-report', syntax => 'SHORT';
use Getopt::Long qw/:config no_ignore_case bundling/;
use File::Find   qw/find/;

my $lang     = 'perl';
my $version  = 0;
my $help     = 0;
my ($from, $output);
my ($char_in, $char_out, $domain, $mode, $template);

GetOptions
   'files-from|f=s'    => \$from
 , 'output-dir|p=s'    => \$output
 , 'domain|d=s'        => \$domain
 , 'language|L=s'      => \$lang
 , 'from-code=s'       => \$char_in
 , 'to-code=s'         => \$char_out  # missing in xgettext?
 , 'version|V'         => \$version
 , 'help|h'            => \$help
 , 'template|t=s'      => \$template  # pattern in ::Template
 , 'verbose=i'         => \$mode
 , 'v+'                => \$mode
 , 'mode=s'            => \$mode
or exit(1);

if($version)
{   print "Log::Report $Log::Report::VERSION\n";
    exit 0;
}

if($help)
{   print <<__HELP;
Log::Report's version of xgettext, has a subset of options
of GNU's version, and no own manual-page yet.
__HELP
   exit 0;
}

# all output to stderr
dispatcher FILE => stderr => to => \*STDERR, mode => $mode;
dispatcher close => 'default';

$template || $lang eq 'perl'
    or mistake __x"programming language {lang} not supported", lang => $lang;

defined $output
    or mistake __"explicit output directory (-p) required";

-d $output or mkdir $output
    or fault __x"cannot create output directory {dir}", dir => $output;

my @filenames;
if(defined $from)
{   !@ARGV
        or error __x"do not combine command-line filenames with --files-from";

    open FILENAMES, '<:raw', $from
        or fault __x"cannot read filename list from {fn}", fn => $from;

    @filenames = <FILENAMES>;
    close FILENAMES;
    chomp(@filenames);
}
elsif(@ARGV)
{   find sub{push @filenames, $File::Find::name if -f}, @ARGV;
}

my $extr;

if($template)
{   # process from template
    eval "require Log::Report::Extract::Template";
    panic $@ if $@;

    $domain
        or error __x"specify a text-domain (-d) for the templates";

    $extr = Log::Report::Extract::Template->new
      ( lexicon => $output
      , charset => $char_out
      , domain  => $domain
      , pattern => 'TT2-loc'
      );

    $extr->process($_, charset => $char_in)
        for @filenames;
}
else
{   # process the pm files
    eval "require Log::Report::Extract::PerlPPI";
    panic $@ if $@;

    $extr = Log::Report::Extract::PerlPPI->new
      ( lexicon => $output
      , charset => $char_out
      );

    $extr->process($_, charset => $char_in)
        for @filenames;
}

$extr->showStats;
$extr->write;