#! /usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;

# po4a -- Update both the po files and translated documents in one shoot
# $Id: po4a,v 1.29 2005/05/30 07:13:38 mquinson Exp $
#
# Copyright 2002, 2003, 2004 by Martin Quinson (mquinson#debian.fr)
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of GPL (see COPYING).

=head1 NAME

po4a - update both the po files and translated documents in one shot

=head1 SYNOPSIS

po4a [-dhvV] E<lt>config_fileE<gt>

=head1 DESCRIPTION

The po4a (po for anything) project goal is to ease translations (and more
interestingly, the maintenance of translations) using gettext tools on
areas where they were not expected like documentation.

The C<po4a> program is in charge of updating both the po files (to sync
them to the original documents) and the translated documents (to sync 
them to the po files). The main point is to make the use of po4a easier
without having to remember of the command line options.

It also allows you to mix documents having different formats into the same
pot file so that you can have only one such file per project.

This behaviour can be mimicked by the other tools of the po4a suite (for
example with makefiles), but it is rather difficult to do, and exhausting to 
redo the same complicated makefiles for each project using po4a.

The dataflow can be summarized as follow. Any changes to the master document
will be reflected in the po files, and all changes to the po files (either
manual or caused by previous step) will be reflected in translation
documents.

 master document --> po files --> translations

The dataflow cannot be inversed in this tool, and changes in translations
are overwritten by the content of the po files. As a matter of fact, this
tool cannot be used to convert existing translations to the po4a system. For
that task, please refer to L<po4a-gettextize(1)>.
 
=head1 CONFIGURATION FILE SYNTAX

The (mandatory) argument is the path to the configuration file to use. 
Its syntax aims at being simple and close to the configuration files used 
by the intl-tools projects.

Comments in this files are noted by the char '#'. It comments everything 
until the end of the line. Lines can be continued by escaping the end of line.
All non blank lines must begin with a [] command, followed by its arguments. 
(sound difficult said that way, but it is rather easy, I hope ;)

=head2 Specifying the template languages

This is an optional command that can simplify the whole config file, and will
make it more scalable. You have to specify a list of the languages in which
you want to translate the documents. This is as simple as:

 [po4a_langs] fr de

This will enable you to expand $lang to all the specified languages in the rest
of the config file.

=head2 Specifying the paths to translator inputs

First, you have to specify where the translator input files (ie, the files 
used by translators to do their job) are located. It can be done by such a line:

 [po4a_paths] doc/l10n/project.doc.pot fr:doc/l10n/fr.po de:doc/l10n/de.po

The command is thus 'po4a_paths'. The first argument is the path to the pot 
file to use. All subsequent arguments are of the self-explanationary form: 

    <lang>:<path to the po file for this lang>

If you've defined the template languages, you can rewrite the line above this
way:

 [po4a_paths] doc/l10n/project.doc.pot $lang:doc/l10n/$lang.po

=head2 Specifying the documents to translate

You now naturally have to specify which documents are translated, their 
format, and where to put the translations. It can be made by such lines:

 [type: sgml] doc/my_stuff.sgml fr:doc/fr/mon_truc.sgml de:doc/de/mein_cram.sgml
 [type: pod] script fr:doc/fr/script.1 de:doc/de/script.1 \
             add_fr:doc/l10n/script.fr.add

This should be rather self-explanatory also. Note that in the second case, 
doc/l10n/script.fr.add is an addendum to add to the French version of this document.
Please refer to po4a(7) for more information about the addenda.

More formally, the format is: 

 [type: <format>] <master_doc> <lang>:<localized_doc>* add_<lang>:<addendum>*

If you've defined the template languages, you can rewrite the line above this
way:

 [type: pod] script $lang:doc/$lang/script.1 add_fr:doc/l10n/script.fr.add

If all the languages had addenda with similar paths, you could also write
something like:

 [type: pod] script $lang:doc/$lang/script.1 add_$lang:doc/l10n/script.$lang.add

=head1 OPTIONS

=over 4

=item -k, --keep

Minimal threshold for translation percentage to keep (ie, write) the
resulting file (default: 80). Ie, by default, files have to be translated
at at least 80% to get written.

=item -h, --help

Show a short help message.

=item -M, --master-charset

Charset of the files containing the documents to translate. Note that all
master documents must use the same charset for now. This is a known
limitation, and we are working on solving this.

=item -L, --localized-charset

Charset of the files containing the localized documents. Note that all
translated documents will use the same charset for now. This is a known
limitation, and we are working on solving this.

=item -A, --addendum-charset

Charset of the addenda. Note that all the addenda should be in the same
charset.

=item -V, --version

Display the version of the script and exit.

=item -v, --verbose

Increase the verbosity of the program.

=item -q, --quiet

Decrease the verbosity of the program.

=item -d, --debug

Output some debugging information.

=back

=head1 SHORTCOMINGS

=over 4

=item

Does not allow to pass any options to the modules.

=item

Duplicates some code with the po4a-* programs.

=back

Patch welcome ;)

=head1 SEE ALSO

L<po4a(7)>, L<po4a-gettextize(1)>, L<po4a-updatepo(1)>, L<po4a-translate(1)>, L<po4a-normalize(1)>.

=head1 AUTHORS

 Denis Barbier <barbier@linuxfr.org>
 Martin Quinson (mquinson#debian.org)

=head1 COPYRIGHT AND LICENSE

Copyright 2002, 2003, 2004 by SPI, inc.

This program is free software; you may redistribute it and/or modify it
under the terms of GPL (see the COPYING file).

=cut

use 5.006;
use strict;
use warnings;

use Getopt::Long qw(GetOptions);

use Locale::Po4a::Chooser;
use Locale::Po4a::TransTractor;
use Locale::Po4a::Common;

use Pod::Usage qw(pod2usage);

use File::Temp;

textdomain('po4a');


sub show_version {
    Locale::Po4a::Common::show_version("po4a");
    exit 0;
}

# keep the command line arguments
my @ORIGINAL_ARGV = @ARGV;
# remove the config file
pop @ORIGINAL_ARGV;

# Parse the options provided on the command line, or in argument
sub get_options {
    if (defined $_[0]) {
        @ARGV = @_;
    } else {
        @ARGV = @ORIGINAL_ARGV;
    }

    # temporary array for GetOptions
    my @verbose = ();
    my @options = ();

    my %opts = (
        "help"      => 0,
        "type"      => "",
        "debug"     => 0,
        "verbose"   => 0,
        "quiet"     => 0,
        "split"     => 0,
        "threshold" => 80,
        "mastchar"  => "",
        "locchar"   => "",
        "addchar"   => "",
        "options"   => {"verbose" => 0, "debug" => 0}
    );
    Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
    GetOptions(
        'help|h'        => \$opts{"help"},

        'master-charset|M=s'    => \$opts{"mastchar"},
        'localized-charset|L=s' => \$opts{"locchar"},
        'addendum-charset|A=s'  => \$opts{"addchar"},

        'verbose|v'     => \@verbose,
        'debug|d'       => \$opts{"debug"},
        'quiet|q'       => \$opts{"quiet"},
        'split|s'       => \$opts{"split"},
        'keep|k=s'      => \$opts{"threshold"},
        'version|V'     => \&show_version,
        'option|o=s'    => \@options
    ) or pod2usage();

    $opts{"verbose"} = scalar @verbose;
    $opts{"verbose"} =  1 if $opts{"debug"};
    $opts{"verbose"} = -1 if $opts{"quiet"};

    # options to transmit to the modules
    %{$opts{"options"}} = (
        "verbose" => $opts{"verbose"},
        "debug"   => $opts{"debug"}
    );
    foreach (@options) {
        if (m/^([^=]*)=(.*)$/) {
            $opts{"options"}{$1}="$2";
        } else {
            $opts{"options"}{$_}=1;
        }
    }
    return %opts;
}

# Parse a config line and extract the parameters that correspond to options.
# These options are appended to the options provided in argument (as a
# reference to an hash). The options are sorted by category in this hash.
# The categories are: global and the various languages.
sub parse_config_options {
    my $ref = shift;       # a line reference for the die messages
    my $line = shift;      # the line to parse
    my $orig_line = $line; # keep the original line for die messages
    my $options = shift;   # reference to an hash of options

    while (defined $line and $line !~ m/^\s*$/) {
        if ($line =~ m/^\s*opt(?:_(.+?))?:\s*(.+?)\s*$/) {
            my $lang = $1;
            $line = $2;
            my $opt = "";
            if ($line =~ m/^\s*"(.+?(?<!\\)(?:\\\\)*)"(?:\s+(.+))?$/) {
                # take up to the next " not preceeded by an odd number of \
                $opt = $1;
                $line = $2;
            } else {
                # Use the first space separated arg
                if ($line =~ m/^\s*([^\s]+?)(?:\s+(.+))?$/) {
                    $opt = $1;
                    $line = $2;
                } else {
                    die wrap_ref_mod("$ref", "",
                                     gettext("Unparsable argument '%s' (%s)."),
                                     $line, $orig_line);
                }
            }
            if (! defined $lang) {
                $lang = "global";
            }
            if (! defined ${%$options}{$lang}) {
                ${%$options}{$lang} = $opt;
            } else {
                ${%$options}{$lang} .= " $opt";
            }
        } else {
            last;
        }
    }

    $line = "" unless defined $line;
    return $line;
}

my %po4a_opts = get_options(@ARGV);
# Argument check
$po4a_opts{"help"} && pod2usage (-verbose => 1, -exitval => 0);

my $config_file= shift(@ARGV) || pod2usage();
# Check file existence
-e $config_file || die wrap_msg(gettext("File %s does not exist."), $config_file);

# Parse the config file
my (@langs);
my (%aliases); # module aliases ([po4a_alias:...]
my ($pot_filename) = "";
my (%po_filename); # po_files: '$lang'=>'$path'
my (%document); # '$master'=> {'format'=>'$format'; '$lang'=>'$path'; 'add_$lang'=>('$path','$path') }
open CONFIG,"$config_file" || die wrap_msg(gettext("Can't open %s: %s"), $config_file, $!);
my ($line,$nb) = ("",0);
while (<CONFIG>) {
    $nb++;
    s/#.*//; 
    $line.=$_;
    $line =~ s/\t/ /g;
    $line =~ s/ +/ /g;
    $line =~ s/^ //;
    $line =~ s/ $//;
    chomp($line);
    next if ($line =~ s/\\$//);
    next unless ($line =~ /\S/);

    die wrap_ref_mod("$config_file:$nb", "", gettext("Syntax error: %s"), $line)
      unless ($line =~ m/^\[([^\]]*)\] (\S+) (.*)$/ || $line =~ m/^\[([^\]]*)\] (\S+)$/);
    my ($cmd,$main,$args)=($1,$2,$3||"");

    if (@langs) {
	# Expand the $lang templates
	my($args2) = "";
	foreach my $arg (split(/ /,$args)) {
	    if ( $arg =~ /\$lang/ ) {
		# Expand for all the langs
		foreach my $lang (@langs) {
		    my($arg2) = $arg;
		    $arg2 =~ s/\$lang/$lang/g;
		    $args2 .= $arg2." ";
		}
	    } else {
		# Leave the argument as is
		$args2 .= $arg." ";
	    }
	}
	$args = $args2;
    }

    print "cmd=[$cmd]; main=$main; args=\"$args\"\n" if $po4a_opts{"debug"};

    if ($cmd eq "po4a_paths") {
	die wrap_ref_mod("$config_file:$nb", "",
	    gettext("'%s' redeclared"), "po4a_path")
	  if (length $pot_filename);
	$pot_filename = $main;
	foreach my $arg (split(/ /,$args)) {
	    die wrap_ref_mod("$config_file:$nb", "",
		gettext("Unparsable argument '%s'."), $arg)
	      unless ($arg =~ /^([^:]*):(.*)/);
	    $po_filename{$1}=$2;
	}

    } elsif ($cmd eq "po4a_langs") {
	die wrap_ref_mod("$config_file:$nb", "",
	    gettext("'%s' redeclared"), "po4a_langs")
	  if (@langs);
	@langs = split(/ /,$main." ".$args);

    } elsif ($cmd =~ m/type: *(.*)/) {
	$document{$main}{'format'} = $1;
	my %options;
	if (defined $aliases{$1}) {
	    $document{$main}{'format'} = $aliases{$1}{"module"};
	    if (defined %{$aliases{$1}{"options"}}) {
		%options = %{$aliases{$1}{"options"}};
	    }
	}
	# separate the end of the line, which contains options.
	# Something more clever could be done to allow options in the
	# middle of a line.
	if ($args =~ m/^(.*?) +(opt(_.+)?:(.*))$/) {
	    $args = $1;
	    $args = "" unless defined $args;
	    $args .= " ".parse_config_options("$config_file:$nb",
	                                      $2, \%options);
	}
	%{$document{$main}{'options'}} = %options;
	foreach my $arg (split(/ /,$args)) {
	    die wrap_ref_mod("$config_file:$nb", "",
		gettext("Unparsable argument '%s' (%s)."), $arg, $line)
	      unless ($arg =~ /^([^:]*):(.*)/);
	    my ($lang,$trans)=($1,$2);
	    die wrap_ref_mod("$config_file:$nb", "",
		gettext("The translated and master file are the same."))
	      if ($main eq $trans);

	    if ($lang =~ /add_/) {
		push @{$document{$main}{$lang}},$trans;
	    } else {
		die wrap_ref_mod("$config_file:$nb", "",
		    gettext("Translation of %s in %s redefined"), $main, $lang)
		  if (defined $document{$main}{$lang});
		$document{$main}{$lang} = $trans;
	    }
	}
    } elsif ($cmd =~ m/po4a_alias: *(.*)/) {
	my $name = $1;
	my %alias = ();
	$alias{"module"} = $main;
	my %options;
	$args = parse_config_options("$config_file:$nb", $args, \%options);
	%{$alias{"options"}} = %options;
	%{$aliases{$name}} = %alias;
    } else {
	die wrap_ref_mod("$config_file:$nb", "",
	    gettext("Unparsable command '%s'."), $cmd);
    }

    $line = "";
}
close CONFIG; # don't care about error here
die wrap_msg(gettext("po4a_paths not declared. Dunno where to find the pot and po files"))
  unless (length $pot_filename);

# make a big pot
if (-e $pot_filename) {
    print wrap_msg(gettext("Updating %s:"), $pot_filename)
	if $po4a_opts{"verbose"};
} else {
    print wrap_msg(gettext("Creating %s:"), $pot_filename)
	if $po4a_opts{"verbose"};
}

my $potfile=Locale::Po4a::Po->new();
foreach my $master (keys %document) {
    my %file_opts = %po4a_opts;
    my $options = $document{$master}{"options"}{"global"};
    if (defined $options) {
        %file_opts = get_options(@ORIGINAL_ARGV,
                                 split(/ /, $options));
    }
    my $doc=Locale::Po4a::Chooser::new($document{$master}{'format'},
                                       %{$file_opts{"options"}});


    # We ensure that the generated po will be in utf-8 if the input document
    # isn't entirely in ascii
    $doc->{TT}{utf_mode} = 1;

    $doc->setpoout($potfile);
    my @file_in_name;
    push @file_in_name, $master;
    $doc->process('file_in_name'     => \@file_in_name,
                  'file_in_charset'  => $file_opts{"mastchar"});
    $potfile = $doc->getpoout();
}
$potfile->write($pot_filename);

print wrap_msg(gettext(" (%d entries)"), $potfile->count_entries());

# update all po files
my $lang;
foreach $lang (sort keys %po_filename) {
    if (-e $po_filename{$lang}) {
	print STDERR wrap_msg(gettext("Updating %s:")." ", $po_filename{$lang})
	    if ($po4a_opts{"verbose"});
	if ($po4a_opts{"split"}) {
	    my ($pot_filename,$po_filename,$bigpo_filename);
	    (undef,$pot_filename)=File::Temp->tempfile("po4aXXXX",
						       DIR    => "/tmp",
						       SUFFIX => ".pot",
						       OPEN   => 0,
						       UNLINK => 0)
		or die wrap_msg(gettext("Can't create a temporary pot file: %s"), $!);
	    (undef,$po_filename)=File::Temp->tempfile("po4aXXXX",
						      DIR    => "/tmp",
						      SUFFIX => ".po",
						      OPEN   => 0,
						      UNLINK => 0)
		or die wrap_msg(gettext("Can't create a temporary po file: %s"), $!);
	    my ($poorig,$pores)=(Locale::Po4a::Po->new(),Locale::Po4a::Po->new());
	    $poorig->read($po_filename{$lang});

	    foreach my $master (sort keys %document) {
		my $pot=Locale::Po4a::Po->new();
		my $po=Locale::Po4a::Po->new();
		print "  $master:";
		print "(pot)";
		$pot=$potfile->select_file($master);
		print "(po) ";
		$po=$poorig->select_file($master);
		unlink($pot_filename) if -e $pot_filename;
		unlink($po_filename) if -e $po_filename;

		$pot->write($pot_filename);
		$po->write($po_filename);
		system ("msgmerge -U $po_filename $pot_filename")
		    && die wrap_msg(gettext("Error while running msgmerge: %s"), $!);
		$pores->read($po_filename);
	    }
	    $pores->write($po_filename{$lang}.".new");
	    unlink($pot_filename) if -e $pot_filename;
	    unlink($po_filename) if -e $po_filename;

	} else {
	    system ("msgmerge -U ".$po_filename{$lang}." $pot_filename ".($po4a_opts{"verbose"}?"":">/dev/null 2>/dev/null"))
		&& die wrap_msg(gettext("Error while running msgmerge: %s"), $!);
	    system "msgfmt --statistics -v -o /dev/null ".$po_filename{$lang} 
	    if $po4a_opts{"verbose"};
	}
    } else {
	print STDERR wrap_msg(gettext("Creating %s:"), $po_filename{$lang}) 
	    if $po4a_opts{"verbose"};
	system ("cp",$pot_filename,$po_filename{$lang}) == 0 ||
	    die wrap_msg(gettext("Error while copying the po file: %s"), $!);
    }
}
# update all translations

foreach $lang (sort keys %po_filename) {
    DOC: foreach my $master (sort keys %document) {
	next unless defined $document{$master}{$lang};
    
	my %file_opts = %po4a_opts;
	my $options = "";
	if (defined $document{$master}{"options"}{"global"}) {
	    $options .= $document{$master}{"options"}{"global"};
	}
	# append the language options
	if (defined $document{$master}{"options"}{$lang}) {
	    $options .= " ".$document{$master}{"options"}{$lang};
	}
	if (defined $options) {
	    # also use the options provided on the command line
	    %file_opts = get_options(@ORIGINAL_ARGV,
	                             split(/ /, $options));
	}
	my $doc=Locale::Po4a::Chooser::new($document{$master}{'format'},
	                                   %{$file_opts{"options"}});

	my (@file_in_name,@po_in_name);
	push @file_in_name, $master;
	push @po_in_name, $po_filename{$lang};

	$doc->process('file_in_name'  => \@file_in_name,
	              'file_out_name' => $document{$master}{$lang},
	              'po_in_name'    => \@po_in_name,
	              'file_in_charset'  => $file_opts{"mastchar"},
	              'file_out_charset' => $file_opts{"locchar"},
	              'addendum_charset' => $file_opts{"addchar"});

	my ($percent,$hit,$queries) = $doc->stats();

	if ($percent<$file_opts{"threshold"})  {
	    print STDERR wrap_msg(gettext("Discard %s (only %s%% translated; need %s%%)."),
		$document{$master}{$lang}, $percent, $file_opts{"threshold"});
	    unlink($document{$master}{$lang}) if (-e $document{$master}{$lang});
	    next DOC;
	}

	if (defined ($document{$master}{"add_$lang"})) {
	    foreach my $add (@{$document{$master}{"add_$lang"}}) {
		if ( !$doc->addendum($add) ) {
		    die wrap_msg(gettext("Addendum %s does NOT apply to %s (translation discarded)."),
			$add, $document{$master}{$lang});
		    unlink($document{$master}{$lang}) if (-e $document{$master}{$lang});
		    next DOC;
		}
	    }
	}
	if ($file_opts{"verbose"}) {
	    if ($percent == 100) {
		print STDERR wrap_msg(gettext("%s is %s%% translated (%s strings)."),
		    $document{$master}{$lang}, $percent, $queries);
	    } else {
		print STDERR wrap_msg(gettext("%s is %s%% translated (%s of %s strings)."),
		    $document{$master}{$lang}, $percent, $hit, $queries);
	    }
	}

	$doc->write($document{$master}{$lang});
    }
}
  
__END__
