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