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 - Experimental 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( error_normal warn_normal );
  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 = TmplTokenizer::quote_po($s) if $s =~ /\S/;
  36     $key = TmplTokenizer::charset_convert($key, $charset_in, $charset_out);
  37     return defined $href->{$key}
  38                 && !$href->{$key}->fuzzy
  39                 && length Locale::PO->dequote($href->{$key}->msgstr)?
  40            Locale::PO->dequote($href->{$key}->msgstr): $s;
  41 }
  42
  43 sub text_replace_tag ($$) {
  44     my($t, $attr) = @_;
  45     my $it;
  46     # value [tag=input], meta
  47     my $tag = lc($1) if $t =~ /^<(\S+)/s;
  48     my $translated_p = 0;
  49     for my $a ('alt', 'content', 'title', 'value') {
  50         if ($attr->{$a}) {
  51             next if $a eq 'content' && $tag ne 'meta';
  52             next if $a eq 'value' && ($tag ne 'input'
  53                 || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
  54             my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
  55             my($pre, $trimmed, $post) = TmplTokenizer::trim $val;
  56             if ($val =~ /\S/s) {
  57                 my $s = $pre . find_translation($trimmed) . $post;
  58                 if ($attr->{$a}->[1] ne $s) { #FIXME
  59                     $attr->{$a}->[1] = $s; # FIXME
  60                     $attr->{$a}->[2] = ($s =~ /"/s)? "'$s'": "\"$s\""; #FIXME
  61                     $translated_p = 1;
  62                 }
  63             }
  64         }
  65     }
  66     if ($translated_p) {
  67         $it = "<$tag"
  68             . join('', map {
  69                     sprintf(' %s=%s', $_, $attr->{$_}->[2]) #FIXME
  70                 } sort {
  71                     $attr->{$a}->[3] <=> $attr->{$b}->[3] #FIXME
  72                 } keys %$attr)
  73             . '>';
  74     } else {
  75         $it = $t;
  76     }
  77     return $it;
  78 }
  79
  80 sub text_replace (**) {
  81     my($h, $output) = @_;
  82     for (;;) {
  83         my $s = TmplTokenizer::next_token $h;
  84     last unless defined $s;
  85         my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
  86         if ($kind eq TmplTokenType::TEXT) {
  87             my($pre, $trimmed, $post) = TmplTokenizer::trim $t;
  88             print $output $pre, find_translation($trimmed), $post;
  89         } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
  90             my $fmt = find_translation($s->form);
  91             print $output TmplTokenizer::parametrize($fmt, map {
  92                 my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
  93                 $kind == TmplTokenType::TAG && %$attr?
  94                     text_replace_tag($t, $attr): $t } $s->parameters);
  95         } elsif ($kind eq TmplTokenType::TAG && %$attr) {
  96             print $output text_replace_tag($t, $attr);
  97         } elsif (defined $t) {
  98             print $output $t;
  99         }
 100     }
 101 }
 102
 103 sub listfiles ($$) {
 104     my($dir, $type) = @_;
 105     my @it = ();
 106     if (opendir(DIR, $dir)) {
 107         my @dirent = readdir DIR;       # because DIR is shared when recursing
 108         closedir DIR;
 109         for my $dirent (@dirent) {
 110             my $path = "$dir/$dirent";
 111             if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'
 112             || (defined $exclude_regex && $dirent =~ /^(?:$exclude_regex)$/)) {
 113                 ;
 114             } elsif (-f $path) {
 115                 push @it, $path if !defined $type || $dirent =~ /\.(?:$type)$/;
 116             } elsif (-d $path && $recursive_p) {
 117                 push @it, listfiles($path, $type);
 118             }
 119         }
 120     } else {
 121         warn_normal "$dir: $!", undef;
 122     }
 123     return @it;
 124 }
 125
 126 ###############################################################################
 127
 128 sub usage_error (;$) {
 129     for my $msg (split(/\n/, $_[0])) {
 130         print STDERR "$msg\n";
 131     }
 132     print STDERR "Try `$0 --help' for more information.\n";
 133     exit(-1);
 134 }
 135
 136 ###############################################################################
 137
 138 GetOptions(
 139     'input|i=s'                         => \@in_files,
 140     'outputdir|o=s'                     => \$out_dir,
 141     'recursive|r'                       => \$recursive_p,
 142     'str-file|s=s'                      => \$str_file,
 143     'exclude|x=s'                       => \@excludes,
 144     'pedantic-warnings|pedantic'        => sub { $pedantic_p = 1 },
 145 ) || usage_error;
 146
 147 VerboseWarnings::set_application_name $0;
 148 VerboseWarnings::set_pedantic_mode $pedantic_p;
 149
 150 # try to make sure .po files are backed up (see BUGS)
 151 $ENV{VERSION_CONTROL} = 't';
 152
 153 # keep the buggy Locale::PO quiet if it says stupid things
 154 $SIG{__WARN__} = sub {
 155         my($s) = @_;
 156         print STDERR $s unless $s =~ /^Strange line in [^:]+: #~/s
 157     };
 158
 159 my $action = shift or usage_error('You must specify an ACTION.');
 160 usage_error('You must at least specify input and string list filenames.')
 161     if !@in_files || !defined $str_file;
 162
 163 # Type match defaults to *.tmpl plus *.inc if not specified
 164 $type = "tmpl|inc" if !defined($type);
 165
 166 # Check the inputs for being files or directories
 167 for my $input (@in_files) {
 168     usage_error("$input: Input must be a file or directory.\n"
 169             . "(Symbolic links are not supported at the moment)")
 170         unless -d $input || -f $input;;
 171 }
 172
 173 # Generates the global exclude regular expression
 174 $exclude_regex =  '(?:'.join('|', @excludes).')' if @excludes;
 175
 176 # Generate the list of input files if a directory is specified
 177 if (-d $in_files[0]) {
 178     die "If you specify a directory as input, you must specify only it.\n"
 179             if @in_files > 1;
 180
 181     # input is a directory, generates list of files to process
 182     $in_dir = $in_files[0];
 183     $in_dir =~ s/\/$//; # strips the trailing / if any
 184     @in_files = listfiles($in_dir, $type);
 185 } else {
 186     for my $input (@in_files) {
 187         die "You cannot specify input files and directories at the same time.\n"
 188                 unless -f $input;
 189     }
 190 }
 191
 192 # restores the string list from file
 193 $href = Locale::PO->load_file_ashash($str_file);
 194
 195 # guess the charsets. HTML::Templates defaults to iso-8859-1
 196 if (defined $href) {
 197     $charset_out = TmplTokenizer::charset_canon $2
 198             if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/;
 199     for my $msgid (keys %$href) {
 200         if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) {
 201             my $candidate = TmplTokenizer::charset_canon $2;
 202             die "Conflicting charsets in msgid: $charset_in vs $candidate\n"
 203                     if defined $charset_in && $charset_in ne $candidate;
 204             $charset_in = $2;
 205         }
 206     }
 207 }
 208 if (!defined $charset_in) {
 209     $charset_in = TmplTokenizer::charset_canon 'iso8859-1';
 210     warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";
 211 }
 212
 213 if ($action eq 'create')  {
 214     # updates the list. As the list is empty, every entry will be added
 215     die "$str_file: Output file already exists" if -f $str_file;
 216     my($tmph, $tmpfile) = tmpnam();
 217     # Generate the temporary file that acts as <MODULE>/POTFILES.in
 218     for my $input (@in_files) {
 219         print $tmph "$input\n";
 220     }
 221     close $tmph;
 222     # Generate the specified po file ($str_file)
 223     system ('xgettext.pl', '-s', '-f', $tmpfile, '-o', $str_file);
 224     unlink $tmpfile || warn_normal "$tmpfile: unlink failed: $!\n", undef;
 225
 226 } elsif ($action eq 'update') {
 227     my($tmph1, $tmpfile1) = tmpnam();
 228     my($tmph2, $tmpfile2) = tmpnam();
 229     close $tmph2; # We just want a name
 230     # Generate the temporary file that acts as <MODULE>/POTFILES.in
 231     for my $input (@in_files) {
 232         print $tmph1 "$input\n";
 233     }
 234     close $tmph1;
 235     # Generate the temporary file that acts as <MODULE>/<LANG>.pot
 236     system('./xgettext.pl', '-s', '-f', $tmpfile1, '-o', $tmpfile2,
 237             (defined $charset_in? ('-I', $charset_in): ()),
 238             (defined $charset_out? ('-O', $charset_out): ()));
 239     # Merge the temporary "pot file" with the specified po file ($str_file)
 240     # FIXME: msgmerge(1) is a Unix dependency
 241     # FIXME: need to check the return value
 242     system('msgmerge', '-U', '-s', $str_file, $tmpfile2);
 243     unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;
 244     unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;
 245
 246 } elsif ($action eq 'install') {
 247     if(!defined($out_dir)) {
 248         usage_error("You must specify an output directory when using the install method.");
 249     }
 250
 251     if ($in_dir eq $out_dir) {
 252         warn "You must specify a different input and output directory.\n";
 253         exit -1;
 254     }
 255
 256     # Make sure the output directory exists
 257     # (It will auto-create it, but for compatibility we should not)
 258     -d $out_dir || die "$out_dir: The directory does not exist\n";
 259
 260     # Try to open the file, because Locale::PO doesn't check :-/
 261     open(INPUT, "<$str_file") || die "$str_file: $!\n";
 262     close INPUT;
 263
 264     # creates the new tmpl file using the new translation
 265     for my $input (@in_files) {
 266         die "Assertion failed"
 267                 unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";
 268
 269         my $h = TmplTokenizer->new( $input );
 270         $h->set_allow_cformat( 1 );
 271         VerboseWarnings::set_input_file_name $input;
 272
 273         my $target = $out_dir . substr($input, length($in_dir));
 274         my $targetdir = $` if $target =~ /[^\/]+$/s;
 275         if (!-d $targetdir) {
 276             print STDERR "Making directory $targetdir...";
 277             # creates with rwxrwxr-x permissions
 278             mkdir($targetdir, 0775) || warn_normal "$targetdir: $!", undef;
 279         }
 280         print STDERR "Creating $target...\n";
 281         open( OUTPUT, ">$target" ) || die "$target: $!\n";
 282         text_replace( $h, *OUTPUT );
 283         close OUTPUT;
 284     }
 285
 286 } else {
 287     usage_error('Unknown action specified.');
 288 }
 289 exit 0;
 290
 291 ###############################################################################
 292
 293 =head1 SYNOPSIS
 294
 295 ./tmpl_process3.pl [ I<tmpl_process.pl options> ]
 296
 297 =head1 DESCRIPTION
 298
 299 This is an experimental version of the tmpl_process.pl script,
 300 using standard gettext-style PO files.
 301
 302 Currently, the create, update, and install actions have all been
 303 reimplemented and seem to work.
 304
 305 The create action calls xgettext.pl to do the actual work;
 306 the update action calls xgettext.pl and msgmerge(1) to do the
 307 actual work.
 308
 309 The script can detect <TMPL_VAR> directives embedded inside what
 310 appears to be a full sentence (this actual work being done by
 311 TmplTokenizer(3)); these larger patterns appear in the translation
 312 file as c-format strings with %s.
 313
 314 =head1 BUGS
 315
 316 The --help option has not been implemented yet.
 317
 318 There are probably some real bugs too, since this has not been
 319 tested very much.
 320
 321 xgettext.pl must be present in the current directory; the
 322 msgmerge(1) command must also be present in the search path.
 323 The script currently does not check carefully whether these
 324 dependent commands are present.
 325
 326 If xgettext.pl is interrupted by the user, a corrupted po file
 327 will result. This is very seriously wrong.
 328
 329 Locale::PO(3) has a lot of bugs. It can neither parse nor
 330 generate GNU PO files properly; a couple of workarounds have
 331 been written in TmplTokenizer and more is likely to be needed
 332 (e.g., to get rid of the "Strange line" warning for #~).
 333
 334 =head1 SEE ALSO
 335
 336 xgettext.pl,
 337 msgmerge(1),
 338 Locale::PO(3),
 339 translator_doc.txt
 340
 341 =cut