Bug 6895 : First attempt at fixing the diacritics bug
[koha.git] / misc / translator / xgettext.pl
index fdce401..21e3fc5 100755 (executable)
@@ -7,6 +7,7 @@ xgettext.pl - xgettext(1)-like interface for .tmpl strings extraction
 =cut
 
 use strict;
+use warnings;
 use Getopt::Long;
 use POSIX;
 use Locale::PO;
@@ -19,6 +20,7 @@ use vars qw( $extract_all_p );
 use vars qw( $pedantic_p );
 use vars qw( %text %translation );
 use vars qw( $charset_in $charset_out );
+use vars qw( $disable_fuzzy_p );
 use vars qw( $verbose_p );
 use vars qw( $po_mode_p );
 
@@ -42,12 +44,12 @@ sub token_negligible_p( $ ) {
     my($x) = @_;
     my $t = $x->type;
     return !$extract_all_p && (
-           $t == TmplTokenType::TEXT? string_negligible_p( $x->string ):
-           $t == TmplTokenType::DIRECTIVE? 1:
-           $t == TmplTokenType::TEXT_PARAMETRIZED
+           $t == C4::TmplTokenType::TEXT? string_negligible_p( $x->string ):
+           $t == C4::TmplTokenType::DIRECTIVE? 1:
+           $t == C4::TmplTokenType::TEXT_PARAMETRIZED
                && join( '', map { my $t = $_->type;
-                       $t == TmplTokenType::DIRECTIVE?
-                               '1': $t == TmplTokenType::TAG?
+                       $t == C4::TmplTokenType::DIRECTIVE?
+                               '1': $t == C4::TmplTokenType::TAG?
                                        '': token_negligible_p( $_ )?
                                        '': '1' } @{$x->children} ) eq '' );
 }
@@ -58,9 +60,9 @@ sub remember ($$) {
     my($token, $string) = @_;
     # If we determine that the string is negligible, don't bother to remember
     unless (string_negligible_p( $string ) || token_negligible_p( $token )) {
-       my $key = TmplTokenizer::string_canon( $string );
-       $text{$key} = [] unless defined $text{$key};
-       push @{$text{$key}}, $token;
+        my $key = TmplTokenizer::string_canon( $string );
+        $text{$key} = [] unless defined $text{$key};
+        push @{$text{$key}}, $token;
     }
 }
 
@@ -81,32 +83,41 @@ sub string_list () {
     return @t;
 }
 
-###############################################################################
+  ###############################################################################
 
 sub text_extract (*) {
     my($h) = @_;
     for (;;) {
-       my $s = TmplTokenizer::next_token $h;
-    last unless defined $s;
-       my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
-       if ($kind eq TmplTokenType::TEXT) {
-           remember( $s, $t ) if $t =~ /\S/s;
-       } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
-           remember( $s, $s->form ) if $s->form =~ /\S/s;
-       } elsif ($kind eq TmplTokenType::TAG && %$attr) {
-           # value [tag=input], meta
-           my $tag = lc($1) if $t =~ /^<(\S+)/s;
-           for my $a ('alt', 'content', 'title', 'value') {
-               if ($attr->{$a}) {
-                   next if $a eq 'content' && $tag ne 'meta';
-                   next if $a eq 'value' && ($tag ne 'input'
-                       || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
-                   my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
-                   $val = TmplTokenizer::trim $val;
-                   remember( $s, $val ) if $val =~ /\S/s;
-               }
+        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) {
+           if ($t =~ /\S/s && $t !~ /<!/){
+               remember( $s, $t );
            }
-       }
+        } elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
+           if ($s->form =~ /\S/s && $s->form !~ /<!/){
+               remember( $s, $s->form );
+           }
+        } elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
+            # value [tag=input], meta
+            my $tag = lc($1) if $t =~ /^<(\S+)/s;
+            for my $a ('alt', 'content', 'title', 'value','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] =~ /^(?:hidden|radio|checkbox)$/)); # FIXME
+                    my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
+                    $val = TmplTokenizer::trim $val;
+                    remember( $s, $val ) if $val =~ /\S/s;
+                }
+            }
+        } elsif ($s->has_js_data) {
+            for my $t (@{$s->js_data}) {
+              remember( $s, $t->[3] ) if $t->[0]; # FIXME
+            }
+        }
     }
 }
 
@@ -115,7 +126,7 @@ sub text_extract (*) {
 sub generate_strings_list () {
     # Emit all extracted strings.
     for my $t (string_list) {
-       printf OUTPUT "%s\n", $t # unless negligible_p($t);
+       printf OUTPUT "%s\n", $t;
     }
 }
 
@@ -135,7 +146,11 @@ sub generate_po_file () {
 # This file is distributed under the same license as the PACKAGE package.
 # FIRST AUTHOR <EMAIL\@ADDRESS>, YEAR.
 #
+EOF
+    print OUTPUT <<EOF unless $disable_fuzzy_p;
 #, fuzzy
+EOF
+    print OUTPUT <<EOF;
 msgid ""
 msgstr ""
 "Project-Id-Version: PACKAGE VERSION\\n"
@@ -150,14 +165,62 @@ msgstr ""
 EOF
     my $directory_re = quotemeta("$directory/");
     for my $t (string_list) {
-       #next if negligible_p($t);
+       if ($text{$t}->[0]->type == C4::TmplTokenType::TEXT_PARAMETRIZED) {
+           my($token, $n) = ($text{$t}->[0], 0);
+           printf OUTPUT "#. For the first occurrence,\n"
+                   if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
+           for my $param ($token->parameters_and_fields) {
+               $n += 1;
+               my $type = $param->type;
+               my $subtype = ($type == C4::TmplTokenType::TAG
+                       && $param->string =~ /^<input\b/is?
+                               $param->attributes->{'type'}->[1]: undef);
+               my $fmt = TmplTokenizer::_formalize( $param );
+               $fmt =~ s/^%/%$n\$/;
+               if ($type == C4::TmplTokenType::DIRECTIVE) {
+#                  $type = "Template::Toolkit Directive";
+                   $type = $param->string =~ /\[%(.*?)%\]/is? $1: 'ERROR';
+                   my $name = $param->string =~ /\bname=(["']?)([^\s"']+)\1/is?
+                           $2: undef;
+                   printf OUTPUT "#. %s: %s\n", $fmt,
+                       "$type" . (defined $name? " name=$name": '');
+               } else {
+                   my $name = $param->attributes->{'name'};
+                   my $value = $param->attributes->{'value'}
+                           unless $subtype =~ /^(?:text)$/;
+                   printf OUTPUT "#. %s: %s\n", $fmt, "type=$subtype"
+                           . (defined $name?  " name=$name->[1]": '')
+                           . (defined $value? " value=$value->[1]": '');
+               }
+           }
+       } elsif ($text{$t}->[0]->type == C4::TmplTokenType::TAG) {
+           my($token) = ($text{$t}->[0]);
+           printf OUTPUT "#. For the first occurrence,\n"
+                   if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
+           if ($token->string =~ /^<meta\b/is) {
+               my $type = $token->attributes->{'http-equiv'}->[1];
+               print OUTPUT "#. META http-equiv=$type\n" if defined $type;
+           } elsif ($token->string =~ /^<([a-z0-9]+)/is) {
+               my $tag = uc($1);
+               my $type = (lc($tag) eq 'input'?
+                       $token->attributes->{'type'}: undef);
+               my $name = $token->attributes->{'name'};
+               printf OUTPUT "#. %s\n", $tag
+                   . (defined $type? " type=$type->[1]": '')
+                   . (defined $name? " name=$name->[1]": '');
+           }
+       } elsif ($text{$t}->[0]->has_js_data) {
+           printf OUTPUT "#. For the first occurrence,\n" if @{$text{$t}} > 1;
+           printf OUTPUT "#. SCRIPT\n";
+       }
        my $cformat_p;
        for my $token (@{$text{$t}}) {
            my $pathname = $token->pathname;
            $pathname =~ s/^$directory_re//os;
+        $pathname =~ s/^.*\/koha-tmpl\/(.*)$/$1/;
            printf OUTPUT "#: %s:%d\n", $pathname, $token->line_number
                    if defined $pathname && defined $token->line_number;
-           $cformat_p = 1 if $token->type == TmplTokenType::TEXT_PARAMETRIZED;
+           $cformat_p = 1 if $token->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
        }
        printf OUTPUT "#, c-format\n" if $cformat_p;
        printf OUTPUT "msgid %s\n", TmplTokenizer::quote_po
@@ -183,7 +246,7 @@ sub convert_translation_file () {
        $msgid =~ s/^SELECTED>//;
 
        # Create dummy token
-       my $token = TmplToken->new( $msgid, TmplTokenType::UNKNOWN, undef, undef );
+       my $token = TmplToken->new( $msgid, C4::TmplTokenType::UNKNOWN, undef, undef );
        remember( $token, $msgid );
        $msgstr =~ s/^(?:LIMIT;|LIMITED;)//g; # unneeded for tmpl_process3
        $translation{$msgid} = $msgstr unless $msgstr eq '*****';
@@ -203,7 +266,7 @@ sub convert_translation_file () {
     }
     # The following assumption is correct; that's what HTML::Template assumes
     if (!defined $charset_in) {
-       $charset_in = $charset_out = TmplTokenizer::charset_canon 'iso8859-1';
+       $charset_in = $charset_out = TmplTokenizer::charset_canon 'utf-8';
        warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";
     }
 }
@@ -227,7 +290,7 @@ Output file location:
 HTML::Template options:
   -a, --extract-all              Extract all strings
       --pedantic-warnings        Issue warnings even for detected problems
-                                which are likely to be harmless
+                                 which are likely to be harmless
 
 Output details:
   -s, --sort-output              generate sorted output
@@ -236,6 +299,8 @@ Output details:
 
 Informative output:
       --help                     Display this help and exit
+
+Try `perldoc $0' for perhaps more information.
 EOF
     exit($exitcode);
 }
@@ -256,6 +321,7 @@ GetOptions(
     'charset=s'        => sub { $charset_in = $charset_out = $_[1] },  # INTERNAL
     'convert-from=s'                   => \$convert_from,
     'D|directory=s'                    => \$directory,
+    'disable-fuzzy'                    => \$disable_fuzzy_p,   # INTERNAL
     'f|files-from=s'                   => \$files_from,
     'I|input-charset=s'                        => \$charset_in,        # INTERNAL
     'pedantic-warnings|pedantic'       => sub { $pedantic_p = 1 },
@@ -280,21 +346,23 @@ usage_error('You cannot specify both --convert-from and --files-from')
 
 if (defined $output && $output ne '-') {
     print STDERR "$0: Opening output file \"$output\"\n" if $verbose_p;
-    open(OUTPUT, ">$output") || die "$output: $!\n";
+        open(OUTPUT, ">$output") || die "$output: $!\n";
 } else {
     print STDERR "$0: Outputting to STDOUT...\n" if $verbose_p;
     open(OUTPUT, ">&STDOUT");
 }
+#binmode( OUTPUT, ":utf8" );
 
 if (defined $files_from) {
     print STDERR "$0: Opening input file list \"$files_from\"\n" if $verbose_p;
     open(INPUT, "<$files_from") || die "$files_from: $!\n";
     while (<INPUT>) {
        chomp;
-       my $h = TmplTokenizer->new( "$directory/$_" );
+       my $input = /^\//? $_: "$directory/$_";
+       my $h = TmplTokenizer->new( $input );
        $h->set_allow_cformat( 1 );
-       VerboseWarnings::set_input_file_name "$directory/$_";
-       print STDERR "$0: Processing file \"$directory/$_\"\n" if $verbose_p;
+       VerboseWarnings::set_input_file_name $input;
+       print STDERR "$0: Processing file \"$input\"\n" if $verbose_p;
        text_extract( $h );
     }
     close INPUT;
@@ -324,7 +392,6 @@ A gettext-like format provides the following advantages:
 
 =item -
 
-(Future goal)
 Translation to non-English-like languages with different word
 order:  gettext's c-format strings can theoretically be
 emulated if we are able to do some analysis on the .tmpl input
@@ -348,8 +415,9 @@ the gettext format.
 
 =back
 
-Note that this script is experimental and should still be
-considered unstable.
+This script has already been in use for over a year and should
+be reasonable stable. Nevertheless, it is still somewhat
+experimental and there are still some issues.
 
 Please refer to the explanation in tmpl_process3 for further
 details.
@@ -357,17 +425,31 @@ details.
 If you want to generate GNOME-style POTFILES.in files, such
 files (passed to -f) can be generated thus:
 
-       (cd ../.. && find koha-tmpl/opac-tmpl/default/en
+       (cd ../.. && find koha-tmpl/opac-tmpl/default/en \
                -name \*.inc -o -name \*.tmpl) > opac/POTFILES.in
-       (cd ../.. && find koha-tmpl/intranet-tmpl/default/en
+       (cd ../.. && find koha-tmpl/intranet-tmpl/default/en \
                -name \*.inc -o -name \*.tmpl) > intranet/POTFILES.in
 
 This is, however, quite pointless, because the "create" and
 "update" actions have already been implemented in tmpl_process3.pl.
 
+=head2 Strings inside JavaScript
+
+In the SCRIPT elements, the script will attempt to scan for
+_("I<string literal>") patterns, and extract the I<string literal>
+as a translatable string.
+
+Note that the C-like _(...) notation is required.
+
+The JavaScript must actually define a _ function
+so that the code remains correct JavaScript.
+A suitable definition of such a function can be
+
+       function _(s) { return s } // dummy function for gettext
+
 =head1 SEE ALSO
 
-tmpl_process.pl,
+tmpl_process3.pl,
 xgettext(1),
 Locale::PO(3),
 translator_doc.txt
@@ -388,4 +470,9 @@ xgettext(1)'s sort option. This will result in translation
 strings inside the generated PO file spuriously moving about
 when tmpl_process3.pl calls msgmerge(1) to update the PO file.
 
+If a Javascript string has leading spaces, it will
+generate strings with spurious leading spaces,
+leading to failure to match the strings when actually generating
+translated files.
+
 =cut