misc/translator/tmpl_process3.pl

   1 #!/usr/bin/perl
   2 # This file is part of Koha
   3 # Parts copyright 2003-2004 Paul Poulain
   4 # Parts copyright 2003-2004 Jerome Vizcaino
   5 # Parts copyright 2004 Ambrose Li
   6
   7 use FindBin;
   8 use lib $FindBin::Bin;
   9
  10 =head1 NAME
  11
  12 tmpl_process3.pl - Alternative version of tmpl_process.pl
  13 using gettext-compatible translation files
  14
  15 =cut
  16
  17 use strict;
  18 #use warnings; FIXME - Bug 2505
  19 use File::Basename;
  20 use Getopt::Long;
  21 use Locale::PO;
  22 use File::Temp qw( :POSIX );
  23 use TmplTokenizer;
  24 use VerboseWarnings qw( :warn :die );
  25
  26 ###############################################################################
  27
  28 use vars qw( @in_dirs @filenames @match @nomatch $str_file $out_dir $quiet );
  29 use vars qw( @excludes $exclude_regex );
  30 use vars qw( $recursive_p );
  31 use vars qw( $pedantic_p );
  32 use vars qw( $href );
  33 use vars qw( $type );   # file extension (DOS form without the dot) to match
  34 use vars qw( $charset_in $charset_out );
  35
  36 ###############################################################################
  37
  38 sub find_translation ($) {
  39     my($s) = @_;
  40     my $key = $s;
  41     if ($s =~ /\S/s) {
  42       $key = TmplTokenizer::string_canon($key);
  43       $key = TmplTokenizer::charset_convert($key, $charset_in, $charset_out);
  44       $key = TmplTokenizer::quote_po($key);
  45     }
  46     if (defined $href->{$key} && !$href->{$key}->fuzzy && length Locale::PO->dequote($href->{$key}->msgstr)){
  47         if ($s =~ /^(\s+)/){
  48             return $1 . Locale::PO->dequote($href->{$key}->msgstr);
  49         }
  50         else {
  51             return Locale::PO->dequote($href->{$key}->msgstr);
  52         }
  53     }
  54     else {
  55         return $s;
  56     }
  57 }
  58
  59 sub text_replace_tag ($$) {
  60     my($t, $attr) = @_;
  61     my $it;
  62
  63     # value [tag=input], meta
  64     my $tag = lc($1) if $t =~ /^<(\S+)/s;
  65     my $translated_p = 0;
  66     for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') {
  67     if ($attr->{$a}) {
  68         next if $a eq 'label' && $tag ne 'optgroup';
  69         next if $a eq 'content' && $tag ne 'meta';
  70         next if $a eq 'value' && ($tag ne 'input' || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:checkbox|hidden|radio)$/)); # FIXME
  71
  72         my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
  73         if ($val =~ /\S/s) {
  74         my $s = find_translation($val);
  75         if ($attr->{$a}->[1] ne $s) { #FIXME
  76             $attr->{$a}->[1] = $s; # FIXME
  77             $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
  78             $translated_p = 1;
  79         }
  80         }
  81     }
  82     }
  83     if ($translated_p) {
  84      $it = "<$tag"
  85           . join('', map { if ($_ ne '/'){
  86                              sprintf(' %s="%s"', $_, $attr->{$_}->[1]);
  87           }
  88               else {
  89                   sprintf(' %s',$_);
  90                   }
  91
  92               } sort {
  93                   $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
  94               } keys %$attr);
  95         $it .= '>';
  96     }
  97     else {
  98         $it = $t;
  99     }
 100     return $it;
 101 }
 102
 103 sub text_replace (**) {
 104     my($h, $output) = @_;
 105     for (;;) {
 106     my $s = TmplTokenizer::next_token $h;
 107     last unless defined $s;
 108     my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
 109     if ($kind eq C4::TmplTokenType::TEXT) {
 110         print $output find_translation($t);
 111     } elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
 112         my $fmt = find_translation($s->form);
 113         print $output TmplTokenizer::parametrize($fmt, 1, $s, sub {
 114         $_ = $_[0];
 115         my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
 116         $kind == C4::TmplTokenType::TAG && %$attr?
 117             text_replace_tag($t, $attr): $t });
 118     } elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
 119         print $output text_replace_tag($t, $attr);
 120     } elsif ($s->has_js_data) {
 121         for my $t (@{$s->js_data}) {
 122         # FIXME for this whole block
 123         if ($t->[0]) {
 124             printf $output "%s%s%s", $t->[2], find_translation $t->[3],
 125                 $t->[2];
 126         } else {
 127             print $output $t->[1];
 128         }
 129         }
 130     } elsif (defined $t) {
 131         # Quick fix to bug 4472
 132         $t = "<!DOCTYPE stylesheet ["  if $t =~ /DOCTYPE stylesheet/ ;
 133         print $output $t;
 134     }
 135     }
 136 }
 137
 138 sub listfiles {
 139     my($dir, $type, $action) = @_;
 140     my $filenames = join ('|', @filenames); # used to update strings from this file
 141     my $match     = join ('|', @match);     # use only this files
 142     my $nomatch   = join ('|', @nomatch);   # do no use this files
 143     my @it = ();
 144     if (opendir(DIR, $dir)) {
 145         my @dirent = readdir DIR;   # because DIR is shared when recursing
 146         closedir DIR;
 147         for my $dirent (@dirent) {
 148             my $path = "$dir/$dirent";
 149             if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
 150             || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
 151             ;
 152             } elsif (-f $path) {
 153                 my $basename = fileparse( $path );
 154                 push @it, $path
 155                     if  ( not @filenames or $basename =~ /($filenames)/i )
 156                     and ( not @match     or $basename =~ /($match)/i     ) # files to include
 157                     and ( not @nomatch   or $basename !~ /($nomatch)/i   ) # files not to include
 158                     and (!defined $type || $dirent =~ /\.(?:$type)$/) || $action eq 'install';
 159             } elsif (-d $path && $recursive_p) {
 160                 push @it, listfiles($path, $type, $action);
 161             }
 162         }
 163     } else {
 164         warn_normal "$dir: $!", undef;
 165     }
 166     return @it;
 167 }
 168
 169 ###############################################################################
 170
 171 sub mkdir_recursive ($) {
 172     my($dir) = @_;
 173     local($`, $&, $', $1);
 174     $dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/;
 175     my ($prefix, $basename) = ($dir =~ /\/([^\/]+)$/s)? ($`, $1): ('.', $dir);
 176     mkdir_recursive($prefix) if $prefix ne '.' && !-d $prefix;
 177     if (!-d $dir) {
 178     print STDERR "Making directory $dir...\n" unless $quiet;
 179     # creates with rwxrwxr-x permissions
 180     mkdir($dir, 0775) || warn_normal "$dir: $!", undef;
 181     }
 182 }
 183
 184 ###############################################################################
 185
 186 sub usage ($) {
 187     my($exitcode) = @_;
 188     my $h = $exitcode? *STDERR: *STDOUT;
 189     print $h <<EOF;
 190 Usage: $0 create [OPTION]
 191   or:  $0 update [OPTION]
 192   or:  $0 install [OPTION]
 193   or:  $0 --help
 194 Create or update PO files from templates, or install translated templates.
 195
 196   -i, --input=SOURCE          Get or update strings from SOURCE directory(s).
 197                               On create or update can have multiple values.
 198                               On install only one value.
 199   -o, --outputdir=DIRECTORY   Install translation(s) to specified DIRECTORY
 200       --pedantic-warnings     Issue warnings even for detected problems
 201                               which are likely to be harmless
 202   -r, --recursive             SOURCE in the -i option is a directory
 203   -f, --filename=FILE         FILE is a specific filename or part of it.
 204                               If given, only these files will be processed.
 205                               On update only relevant strings will be updated.
 206   -m, --match=FILE            FILE is a specific filename or part of it.
 207                               If given, only these files will be processed.
 208   -n, --nomatch=FILE          FILE is a specific filename or part of it.
 209                               If given, these files will not be processed.
 210   -s, --str-file=FILE         Specify FILE as the translation (po) file
 211                               for input (install) or output (create, update)
 212   -x, --exclude=REGEXP        Exclude dirs matching the given REGEXP
 213       --help                  Display this help and exit
 214   -q, --quiet                 no output to screen (except for errors)
 215
 216 The -o option is ignored for the "create" and "update" actions.
 217 Try `perldoc $0` for perhaps more information.
 218 EOF
 219     exit($exitcode);
 220 }
 221
 222 ###############################################################################
 223
 224 sub usage_error (;$) {
 225     for my $msg (split(/\n/, $_[0])) {
 226     print STDERR "$msg\n";
 227     }
 228     print STDERR "Try `$0 --help for more information.\n";
 229     exit(-1);
 230 }
 231
 232 ###############################################################################
 233
 234 GetOptions(
 235     'input|i=s'             => \@in_dirs,
 236     'filename|f=s'          => \@filenames,
 237     'match|m=s'             => \@match,
 238     'nomatch|n=s'           => \@nomatch,
 239     'outputdir|o=s'         => \$out_dir,
 240     'recursive|r'           => \$recursive_p,
 241     'str-file|s=s'          => \$str_file,
 242     'exclude|x=s'           => \@excludes,
 243     'quiet|q'               => \$quiet,
 244     'pedantic-warnings|pedantic'    => sub { $pedantic_p = 1 },
 245     'help'              => \&usage,
 246 ) || usage_error;
 247
 248 VerboseWarnings::set_application_name $0;
 249 VerboseWarnings::set_pedantic_mode $pedantic_p;
 250
 251 # keep the buggy Locale::PO quiet if it says stupid things
 252 $SIG{__WARN__} = sub {
 253     my($s) = @_;
 254     print STDERR $s unless $s =~ /^Strange line in [^:]+: #~/s
 255     };
 256
 257 my $action = shift or usage_error('You must specify an ACTION.');
 258 usage_error('You must at least specify input and string list filenames.')
 259     if !@in_dirs || !defined $str_file;
 260
 261 # Type match defaults to *.tt plus *.inc if not specified
 262 $type = "tt|inc|xsl|xml|def" if !defined($type);
 263
 264 # Check the inputs for being directories
 265 for my $in_dir ( @in_dirs ) {
 266     usage_error("$in_dir: Input must be a directory.\n"
 267         . "(Symbolic links are not supported at the moment)")
 268         unless -d $in_dir;
 269 }
 270
 271 # Generates the global exclude regular expression
 272 $exclude_regex =  '(?:'.join('|', @excludes).')' if @excludes;
 273
 274 my @in_files;
 275 # Generate the list of input files if a directory is specified
 276 # input is a directory, generates list of files to process
 277
 278 for my $fn ( @filenames ) {
 279     die "You cannot specify input files and directories at the same time.\n"
 280         if -d $fn;
 281 }
 282 for my $in_dir ( @in_dirs ) {
 283     $in_dir =~ s/\/$//; # strips the trailing / if any
 284     @in_files = ( @in_files, listfiles($in_dir, $type, $action));
 285 }
 286
 287 # restores the string list from file
 288 $href = Locale::PO->load_file_ashash($str_file);
 289
 290 # guess the charsets. HTML::Templates defaults to iso-8859-1
 291 if (defined $href) {
 292     die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'};
 293     $charset_out = TmplTokenizer::charset_canon $2 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/;
 294     $charset_in = $charset_out;
 295 #     for my $msgid (keys %$href) {
 296 #   if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
 297 #       my $candidate = TmplTokenizer::charset_canon $2;
 298 #       die "Conflicting charsets in msgid: $charset_in vs $candidate => $msgid\n"
 299 #           if defined $charset_in && $charset_in ne $candidate;
 300 #       $charset_in = $candidate;
 301 #   }
 302 #     }
 303
 304     # BUG6464: check consistency of PO messages
 305     #  - count number of '%s' in msgid and msgstr
 306     for my $msg ( values %$href ) {
 307         my $id_count  = split(/%s/, $msg->{msgid}) - 1;
 308         my $str_count = split(/%s/, $msg->{msgstr}) - 1;
 309         next if $id_count == $str_count ||
 310                 $msg->{msgstr} eq '""' ||
 311                 grep { /fuzzy/ } @{$msg->{_flags}};
 312         warn_normal
 313             "unconsistent %s count: ($id_count/$str_count):\n" .
 314             "  line:   " . $msg->{loaded_line_number} . "\n" .
 315             "  msgid:  " . $msg->{msgid} . "\n" .
 316             "  msgstr: " . $msg->{msgstr} . "\n", undef;
 317     }
 318 }
 319
 320 # set our charset in to UTF-8
 321 if (!defined $charset_in) {
 322     $charset_in = TmplTokenizer::charset_canon 'UTF-8';
 323     warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";
 324 }
 325 # set our charset out to UTF-8
 326 if (!defined $charset_out) {
 327     $charset_out = TmplTokenizer::charset_canon 'UTF-8';
 328     warn "Warning: Charset Out defaulting to $charset_out\n";
 329 }
 330 my $xgettext = './xgettext.pl'; # actual text extractor script
 331 my $st;
 332
 333 if ($action eq 'create')  {
 334     # updates the list. As the list is empty, every entry will be added
 335     if (!-s $str_file) {
 336     warn "Removing empty file $str_file\n";
 337     unlink $str_file || die "$str_file: $!\n";
 338     }
 339     die "$str_file: Output file already exists\n" if -f $str_file;
 340     my($tmph1, $tmpfile1) = tmpnam();
 341     my($tmph2, $tmpfile2) = tmpnam();
 342     close $tmph2; # We just want a name
 343     # Generate the temporary file that acts as <MODULE>/POTFILES.in
 344     for my $input (@in_files) {
 345     print $tmph1 "$input\n";
 346     }
 347     close $tmph1;
 348     warn "I $charset_in O $charset_out";
 349     # Generate the specified po file ($str_file)
 350     $st = system ($xgettext, '-s', '-f', $tmpfile1, '-o', $tmpfile2,
 351             (defined $charset_in? ('-I', $charset_in): ()),
 352             (defined $charset_out? ('-O', $charset_out): ())
 353     );
 354     # Run msgmerge so that the pot file looks like a real pot file
 355     # We need to help msgmerge a bit by pre-creating a dummy po file that has
 356     # the headers and the "" msgid & msgstr. It will fill in the rest.
 357     if ($st == 0) {
 358     # Merge the temporary "pot file" with the specified po file ($str_file)
 359     # FIXME: msgmerge(1) is a Unix dependency
 360     # FIXME: need to check the return value
 361     unless (-f $str_file) {
 362         local(*INPUT, *OUTPUT);
 363         open(INPUT, "<$tmpfile2");
 364         open(OUTPUT, ">$str_file");
 365         while (<INPUT>) {
 366         print OUTPUT;
 367         last if /^\n/s;
 368         }
 369         close INPUT;
 370         close OUTPUT;
 371     }
 372     $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file");
 373     } else {
 374     error_normal "Text extraction failed: $xgettext: $!\n", undef;
 375     error_additional "Will not run msgmerge\n", undef;
 376     }
 377     unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
 378     unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
 379
 380 } elsif ($action eq 'update') {
 381     my($tmph1, $tmpfile1) = tmpnam();
 382     my($tmph2, $tmpfile2) = tmpnam();
 383     close $tmph2; # We just want a name
 384     # Generate the temporary file that acts as <MODULE>/POTFILES.in
 385     for my $input (@in_files) {
 386     print $tmph1 "$input\n";
 387     }
 388     close $tmph1;
 389     # Generate the temporary file that acts as <MODULE>/<LANG>.pot
 390     $st = system($xgettext, '-s', '-f', $tmpfile1, '-o', $tmpfile2,
 391         '--po-mode',
 392         (defined $charset_in? ('-I', $charset_in): ()),
 393         (defined $charset_out? ('-O', $charset_out): ()));
 394     if ($st == 0) {
 395         # Merge the temporary "pot file" with the specified po file ($str_file)
 396         # FIXME: msgmerge(1) is a Unix dependency
 397         # FIXME: need to check the return value
 398         if ( @filenames ) {
 399             my ($tmph3, $tmpfile3) = tmpnam();
 400             $st = system("msgcat $str_file $tmpfile2 > $tmpfile3");
 401             $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile3 -o - | msgattrib --no-obsolete -o $str_file")
 402                 unless $st;
 403         } else {
 404             $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file");
 405         }
 406     } else {
 407         error_normal "Text extraction failed: $xgettext: $!\n", undef;
 408         error_additional "Will not run msgmerge\n", undef;
 409     }
 410     unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
 411     unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
 412
 413 } elsif ($action eq 'install') {
 414     if(!defined($out_dir)) {
 415     usage_error("You must specify an output directory when using the install method.");
 416     }
 417
 418     if ( scalar @in_dirs > 1 ) {
 419     usage_error("You must specify only one input directory when using the install method.");
 420     }
 421
 422     my $in_dir = shift @in_dirs;
 423
 424     if ($in_dir eq $out_dir) {
 425     warn "You must specify a different input and output directory.\n";
 426     exit -1;
 427     }
 428
 429     # Make sure the output directory exists
 430     # (It will auto-create it, but for compatibility we should not)
 431     -d $out_dir || die "$out_dir: The directory does not exist\n";
 432
 433     # Try to open the file, because Locale::PO doesn't check :-/
 434     open(INPUT, "<$str_file") || die "$str_file: $!\n";
 435     close INPUT;
 436
 437     # creates the new tmpl file using the new translation
 438     for my $input (@in_files) {
 439         die "Assertion failed"
 440             unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
 441
 442         my $target = $out_dir . substr($input, length($in_dir));
 443         my $targetdir = $` if $target =~ /[^\/]+$/s;
 444
 445         if (!defined $type || $input =~ /\.(?:$type)$/) {
 446             my $h = TmplTokenizer->new( $input );
 447             $h->set_allow_cformat( 1 );
 448             VerboseWarnings::set_input_file_name $input;
 449             mkdir_recursive($targetdir) unless -d $targetdir;
 450             print STDERR "Creating $target...\n" unless $quiet;
 451             open( OUTPUT, ">$target" ) || die "$target: $!\n";
 452             text_replace( $h, *OUTPUT );
 453             close OUTPUT;
 454         } else {
 455         # just copying the file
 456             mkdir_recursive($targetdir) unless -d $targetdir;
 457             system("cp -f $input $target");
 458             print STDERR "Copying $input...\n" unless $quiet;
 459         }
 460     }
 461
 462 } else {
 463     usage_error('Unknown action specified.');
 464 }
 465
 466 if ($st == 0) {
 467     printf "The %s seems to be successful.\n", $action unless $quiet;
 468 } else {
 469     printf "%s FAILED.\n", "\u$action" unless $quiet;
 470 }
 471 exit 0;
 472
 473 ###############################################################################
 474
 475 =head1 SYNOPSIS
 476
 477 ./tmpl_process3.pl [ I<tmpl_process.pl options> ]
 478
 479 =head1 DESCRIPTION
 480
 481 This is an alternative version of the tmpl_process.pl script,
 482 using standard gettext-style PO files.  While there still might
 483 be changes made to the way it extracts strings, at this moment
 484 it should be stable enough for general use; it is already being
 485 used for the Chinese and Polish translations.
 486
 487 Currently, the create, update, and install actions have all been
 488 reimplemented and seem to work.
 489
 490 =head2 Features
 491
 492 =over
 493
 494 =item -
 495
 496 Translation files in standard Uniforum PO format.
 497 All standard tools including all gettext tools,
 498 plus PO file editors like kbabel(1) etc.
 499 can be used.
 500
 501 =item -
 502
 503 Minor changes in whitespace in source templates
 504 do not generally require strings to be re-translated.
 505
 506 =item -
 507
 508 Able to handle <TMPL_VAR> variables in the templates;
 509 <TMPL_VAR> variables are usually extracted in proper context,
 510 represented by a short %s placeholder.
 511
 512 =item -
 513
 514 Able to handle text input and radio button INPUT elements
 515 in the templates; these INPUT elements are also usually
 516 extracted in proper context,
 517 represented by a short %S or %p placeholder.
 518
 519 =item -
 520
 521 Automatic comments in the generated PO files to provide
 522 even more context (line numbers, and the names and types
 523 of the variables).
 524
 525 =item -
 526
 527 The %I<n>$s (or %I<n>$p, etc.) notation can be used
 528 for change the ordering of the variables,
 529 if such a reordering is required for correct translation.
 530
 531 =item -
 532
 533 If a particular <TMPL_VAR> should not appear in the
 534 translation, it can be suppressed with the %0.0s notation.
 535
 536 =item -
 537
 538 Using the PO format also means translators can add their
 539 own comments in the translation files, if necessary.
 540
 541 =item -
 542
 543 Create, update, and install actions are all based on the
 544 same scanner module. This ensures that update and install
 545 have the same idea of what is a translatable string;
 546 attribute names in tags, for example, will not be
 547 accidentally translated.
 548
 549 =back
 550
 551 =head1 NOTES
 552
 553 Anchors are represented by an <AI<n>> notation.
 554 The meaning of this non-standard notation might not be obvious.
 555
 556 The create action calls xgettext.pl to do the actual work;
 557 the update action calls xgettext.pl, msgmerge(1) and msgattrib(1)
 558 to do the actual work.
 559
 560 =head1 BUGS
 561
 562 xgettext.pl must be present in the current directory; both
 563 msgmerge(1) and msgattrib(1) must also be present in the search path.
 564 The script currently does not check carefully whether these
 565 dependent commands are present.
 566
 567 Locale::PO(3) has a lot of bugs. It can neither parse nor
 568 generate GNU PO files properly; a couple of workarounds have
 569 been written in TmplTokenizer and more is likely to be needed
 570 (e.g., to get rid of the "Strange line" warning for #~).
 571
 572 This script may not work in Windows.
 573
 574 There are probably some other bugs too, since this has not been
 575 tested very much.
 576
 577 =head1 SEE ALSO
 578
 579 xgettext.pl,
 580 TmplTokenizer.pm,
 581 msgmerge(1),
 582 Locale::PO(3),
 583 translator_doc.txt
 584
 585 http://www.saas.nsw.edu.au/koha_wiki/index.php?page=DifficultTerms
 586
 587 =cut