Koha/misc/translator/tmpl_process3.pl
Julian Maurice 3cfc2ec7bd Bug 25067: Move PO file manipulation code into gulp tasks
misc/translator/translate was doing three different things:
- extract translatable strings
- create or update PO files
- install translated templates

This patch separates responsibilities by moving the string extraction
code into several 'xgettext-like' scripts and adds gulp tasks to
automate string extraction and PO files update

This has several benefits:

- gulp runs tasks in parallel, so it's a lot faster (updating all PO
  files is at least 10 times faster with my 4-cores CPU)

- there is no need for $KOHA_CONF to be defined
  LangInstaller.pm relied on $KOHA_CONF to get the different paths
  needed. I'm not sure why, since string extraction and PO update should
  work on source files, not installed files

- string extraction code can be more easily tested

This patch also brings a couple of fixes and improvements:

- TT string extraction (strings wrapped in [% t(...) %]) was done with
  Template::Parser and PPI, which was extremely slow, and had some
  problems (see bug 24797).
  This is now done with Locale::XGettext::TT2 (new dependency) which is
  a lot faster, and fixes bug 24797

- Fix header in 4 PO files

For backward compatibility, 'create' and 'update' commands of
misc/translator/translate can still be used and will execute the
corresponding gulp task

Test plan:
1. Run `yarn install` and install Locale::XGettext::TT2
2. Run `gulp po:update`
3. Verify the contents of updated PO files
4. Run `cd misc/translator && ./translate install <lang>`
5. Verify that all (templates, sysprefs, xslt, installer files) is
   correctly translated
6. Run `gulp po:create --lang <lang>` and verify that it created all PO
   files for that language
7. Run `prove t/misc/translator`

Signed-off-by: Bernardo Gonzalez Kriegel <bgkriegel@gmail.com>
Need to install yarn & gulp, no errors

Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
2020-11-06 09:46:11 +01:00

487 lines
16 KiB
Perl
Executable file

#!/usr/bin/perl
# This file is part of Koha
# Parts copyright 2003-2004 Paul Poulain
# Parts copyright 2003-2004 Jerome Vizcaino
# Parts copyright 2004 Ambrose Li
use FindBin;
use lib $FindBin::Bin;
=head1 NAME
tmpl_process3.pl - Alternative version of tmpl_process.pl
using gettext-compatible translation files
=cut
use strict;
#use warnings; FIXME - Bug 2505
use File::Basename;
use Getopt::Long;
use Locale::PO;
use File::Temp qw( :POSIX );
use TmplTokenizer;
use VerboseWarnings qw( :warn :die );
###############################################################################
use vars qw( @in_dirs @filenames @match @nomatch $str_file $out_dir $quiet );
use vars qw( @excludes $exclude_regex );
use vars qw( $recursive_p );
use vars qw( $pedantic_p );
use vars qw( $href );
use vars qw( $type ); # file extension (DOS form without the dot) to match
use vars qw( $charset_in $charset_out );
###############################################################################
sub find_translation {
my($s) = @_;
my $key = $s;
if ($s =~ /\S/s) {
$key = TmplTokenizer::string_canon($key);
$key = TmplTokenizer::charset_convert($key, $charset_in, $charset_out);
$key = TmplTokenizer::quote_po($key);
}
if (defined $href->{$key} && !$href->{$key}->fuzzy && length Locale::PO->dequote($href->{$key}->msgstr)){
if ($s =~ /^(\s+)/){
return $1 . Locale::PO->dequote($href->{$key}->msgstr);
}
else {
return Locale::PO->dequote($href->{$key}->msgstr);
}
}
else {
return $s;
}
}
sub text_replace_tag {
my($t, $attr) = @_;
my $it;
my @ttvar;
# value [tag=input], meta
my $tag = ($t =~ /^<(\S+)/s) ? lc($1) : undef;
my $translated_p = 0;
for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder', 'aria-label') {
if ($attr->{$a}) {
next if $a eq 'label' && $tag ne 'optgroup';
next if $a eq 'content' && $tag ne 'meta';
next if $a eq 'value' && ($tag ne 'input' || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:checkbox|hidden|radio)$/)); # FIXME
my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
if ($val =~ /\S/s) {
# for selected attributes replace '[%..%]' with '%s' and remember matches
if ( $a =~ /title|value|alt|content|placeholder|aria-label/ ) {
while ( $val =~ s/(\[\%.*?\%\])/\%s/ ) {
my $var = $1;
push @ttvar, $1;
}
}
# find translation for transformed attributes
my $s = find_translation($val);
# replace '%s' with original content (in order) on translated string, this is fragile!
if ( $a =~ /title|value|alt|content|placeholder|aria-label/ and @ttvar ) {
while ( @ttvar ) {
my $var = shift @ttvar;
$s =~ s/\%s/$var/;
}
}
if ($attr->{$a}->[1] ne $s) { #FIXME
$attr->{$a}->[1] = $s; # FIXME
$attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
$translated_p = 1;
}
}
}
}
if ($translated_p) {
$it = "<$tag"
. join('', map { if ($_ ne '/'){
sprintf(' %s="%s"', $_, $attr->{$_}->[1]);
}
else {
sprintf(' %s',$_);
}
} sort {
$attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
|| $a cmp $b # Sort attributes BZ 22236
} keys %$attr);
$it .= '>';
}
else {
$it = $t;
}
return $it;
}
sub text_replace {
my($h, $output) = @_;
for (;;) {
my $s = TmplTokenizer::next_token($h);
last unless defined $s;
my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
if ($kind eq C4::TmplTokenType::TEXT) {
print $output find_translation($t);
} elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
my $fmt = find_translation($s->form);
print $output TmplTokenizer::parametrize($fmt, 1, $s, sub {
$_ = $_[0];
my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
$kind == C4::TmplTokenType::TAG && %$attr?
text_replace_tag($t, $attr): $t });
} elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
print $output text_replace_tag($t, $attr);
} elsif ($s->has_js_data) {
for my $t (@{$s->js_data}) {
# FIXME for this whole block
if ($t->[0]) {
printf $output "%s%s%s", $t->[2], find_translation($t->[3]),
$t->[2];
} else {
print $output $t->[1];
}
}
} elsif (defined $t) {
# Quick fix to bug 4472
$t = "<!DOCTYPE stylesheet [" if $t =~ /DOCTYPE stylesheet/ ;
print $output $t;
}
}
}
sub listfiles {
my($dir, $type, $action) = @_;
my $filenames = join ('|', @filenames); # used to update strings from this file
my $match = join ('|', @match); # use only this files
my $nomatch = join ('|', @nomatch); # do no use this files
my @it = ();
if (opendir(DIR, $dir)) {
my @dirent = readdir DIR; # because DIR is shared when recursing
closedir DIR;
for my $dirent (@dirent) {
my $path = "$dir/$dirent";
if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
|| (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
;
} elsif (-f $path) {
my $basename = fileparse( $path );
push @it, $path
if ( not @filenames or $basename =~ /($filenames)/i )
and ( not @match or $basename =~ /($match)/i ) # files to include
and ( not @nomatch or $basename !~ /($nomatch)/i ) # files not to include
and (!defined $type || $dirent =~ /\.(?:$type)$/) || $action eq 'install';
} elsif (-d $path && $recursive_p) {
push @it, listfiles($path, $type, $action);
}
}
} else {
warn_normal("$dir: $!", undef);
}
return @it;
}
###############################################################################
sub mkdir_recursive {
my($dir) = @_;
local($`, $&, $', $1);
$dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/;
my ($prefix, $basename) = ($dir =~ /\/([^\/]+)$/s)? ($`, $1): ('.', $dir);
mkdir_recursive($prefix) if $prefix ne '.' && !-d $prefix;
if (!-d $dir) {
print STDERR "Making directory $dir...\n" unless $quiet;
# creates with rwxrwxr-x permissions
mkdir($dir, 0775) || warn_normal("$dir: $!", undef);
}
}
###############################################################################
sub usage {
my($exitcode) = @_;
my $h = $exitcode? *STDERR: *STDOUT;
print $h <<EOF;
Usage: $0 install [OPTION]
or: $0 --help
Install translated templates.
-i, --input=SOURCE Get or update strings from SOURCE directory(s).
On create or update can have multiple values.
On install only one value.
-o, --outputdir=DIRECTORY Install translation(s) to specified DIRECTORY
--pedantic-warnings Issue warnings even for detected problems
which are likely to be harmless
-r, --recursive SOURCE in the -i option is a directory
-f, --filename=FILE FILE is a specific filename or part of it.
If given, only these files will be processed.
On update only relevant strings will be updated.
-m, --match=FILE FILE is a specific filename or part of it.
If given, only these files will be processed.
-n, --nomatch=FILE FILE is a specific filename or part of it.
If given, these files will not be processed.
-s, --str-file=FILE Specify FILE as the translation (po) file
for input (install) or output (create, update)
-x, --exclude=REGEXP Exclude dirs matching the given REGEXP
--help Display this help and exit
-q, --quiet no output to screen (except for errors)
Try `perldoc $0` for perhaps more information.
EOF
exit($exitcode);
}
###############################################################################
sub usage_error {
for my $msg (split(/\n/, $_[0])) {
print STDERR "$msg\n";
}
print STDERR "Try `$0 --help for more information.\n";
exit(-1);
}
###############################################################################
GetOptions(
'input|i=s' => \@in_dirs,
'filename|f=s' => \@filenames,
'match|m=s' => \@match,
'nomatch|n=s' => \@nomatch,
'outputdir|o=s' => \$out_dir,
'recursive|r' => \$recursive_p,
'str-file|s=s' => \$str_file,
'exclude|x=s' => \@excludes,
'quiet|q' => \$quiet,
'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 },
'help' => \&usage,
) || usage_error();
VerboseWarnings::set_application_name($0);
VerboseWarnings::set_pedantic_mode($pedantic_p);
my $action = shift or usage_error('You must specify an ACTION.');
usage_error('You must at least specify input and string list filenames.')
if !@in_dirs || !defined $str_file;
# Type match defaults to *.tt plus *.inc if not specified
$type = "tt|inc|xsl|xml|def" if !defined($type);
# Check the inputs for being directories
for my $in_dir ( @in_dirs ) {
usage_error("$in_dir: Input must be a directory.\n"
. "(Symbolic links are not supported at the moment)")
unless -d $in_dir;
}
# Generates the global exclude regular expression
$exclude_regex = '(?:'.join('|', @excludes).')' if @excludes;
my @in_files;
# Generate the list of input files if a directory is specified
# input is a directory, generates list of files to process
for my $fn ( @filenames ) {
die "You cannot specify input files and directories at the same time.\n"
if -d $fn;
}
for my $in_dir ( @in_dirs ) {
$in_dir =~ s/\/$//; # strips the trailing / if any
@in_files = ( @in_files, listfiles($in_dir, $type, $action));
}
# restores the string list from file
$href = Locale::PO->load_file_ashash($str_file, 'utf-8');
# guess the charsets. HTML::Templates defaults to iso-8859-1
if (defined $href) {
die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'};
$charset_out = TmplTokenizer::charset_canon($2) if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/;
$charset_in = $charset_out;
# for my $msgid (keys %$href) {
# if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
# my $candidate = TmplTokenizer::charset_canon $2;
# die "Conflicting charsets in msgid: $charset_in vs $candidate => $msgid\n"
# if defined $charset_in && $charset_in ne $candidate;
# $charset_in = $candidate;
# }
# }
# BUG6464: check consistency of PO messages
# - count number of '%s' in msgid and msgstr
for my $msg ( values %$href ) {
my $id_count = split(/%s/, $msg->{msgid}) - 1;
my $str_count = split(/%s/, $msg->{msgstr}) - 1;
next if $id_count == $str_count ||
$msg->{msgstr} eq '""' ||
grep { /fuzzy/ } @{$msg->{_flags}};
warn_normal(
"unconsistent %s count: ($id_count/$str_count):\n" .
" line: " . $msg->{loaded_line_number} . "\n" .
" msgid: " . $msg->{msgid} . "\n" .
" msgstr: " . $msg->{msgstr} . "\n", undef);
}
}
# set our charset in to UTF-8
if (!defined $charset_in) {
$charset_in = TmplTokenizer::charset_canon('UTF-8');
warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n" unless ( $quiet );
}
# set our charset out to UTF-8
if (!defined $charset_out) {
$charset_out = TmplTokenizer::charset_canon('UTF-8');
warn "Warning: Charset Out defaulting to $charset_out\n" unless ( $quiet );
}
my $st;
if ($action eq 'install') {
if(!defined($out_dir)) {
usage_error("You must specify an output directory when using the install method.");
}
if ( scalar @in_dirs > 1 ) {
usage_error("You must specify only one input directory when using the install method.");
}
my $in_dir = shift @in_dirs;
if ($in_dir eq $out_dir) {
warn "You must specify a different input and output directory.\n";
exit -1;
}
# Make sure the output directory exists
# (It will auto-create it, but for compatibility we should not)
-d $out_dir || die "$out_dir: The directory does not exist\n";
# Try to open the file, because Locale::PO doesn't check :-/
open(my $fh, '<', $str_file) || die "$str_file: $!\n";
close $fh;
# creates the new tmpl file using the new translation
for my $input (@in_files) {
die "Assertion failed"
unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
my $target = $out_dir . substr($input, length($in_dir));
my $targetdir = ($target =~ /[^\/]+$/s) ? $` : undef;
if (!defined $type || $input =~ /\.(?:$type)$/) {
my $h = TmplTokenizer->new( $input );
$h->set_allow_cformat( 1 );
VerboseWarnings::set_input_file_name($input);
mkdir_recursive($targetdir) unless -d $targetdir;
print STDERR "Creating $target...\n" unless $quiet;
open( my $fh, ">:encoding(UTF-8)", "$target" ) || die "$target: $!\n";
text_replace( $h, $fh );
close $fh;
} else {
# just copying the file
mkdir_recursive($targetdir) unless -d $targetdir;
system("cp -f $input $target");
print STDERR "Copying $input...\n" unless $quiet;
}
}
} else {
usage_error('Unknown action specified.');
}
if ($st == 0) {
printf "The %s seems to be successful.\n", $action unless $quiet;
} else {
printf "%s FAILED.\n", "\u$action" unless $quiet;
}
exit 0;
###############################################################################
=head1 SYNOPSIS
./tmpl_process3.pl [ I<tmpl_process.pl options> ]
=head1 DESCRIPTION
This is an alternative version of the tmpl_process.pl script,
using standard gettext-style PO files. While there still might
be changes made to the way it extracts strings, at this moment
it should be stable enough for general use; it is already being
used for the Chinese and Polish translations.
Currently, the create, update, and install actions have all been
reimplemented and seem to work.
=head2 Features
=over
=item -
Translation files in standard Uniforum PO format.
All standard tools including all gettext tools,
plus PO file editors like kbabel(1) etc.
can be used.
=item -
Minor changes in whitespace in source templates
do not generally require strings to be re-translated.
=item -
Able to handle <TMPL_VAR> variables in the templates;
<TMPL_VAR> variables are usually extracted in proper context,
represented by a short %s placeholder.
=item -
Able to handle text input and radio button INPUT elements
in the templates; these INPUT elements are also usually
extracted in proper context,
represented by a short %S or %p placeholder.
=item -
Automatic comments in the generated PO files to provide
even more context (line numbers, and the names and types
of the variables).
=item -
The %I<n>$s (or %I<n>$p, etc.) notation can be used
for change the ordering of the variables,
if such a reordering is required for correct translation.
=item -
If a particular <TMPL_VAR> should not appear in the
translation, it can be suppressed with the %0.0s notation.
=item -
Using the PO format also means translators can add their
own comments in the translation files, if necessary.
=back
=head1 NOTES
Anchors are represented by an <AI<n>> notation.
The meaning of this non-standard notation might not be obvious.
=head1 BUGS
This script may not work in Windows.
There are probably some other bugs too, since this has not been
tested very much.
=head1 SEE ALSO
TmplTokenizer.pm,
Locale::PO(3),
=cut