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