1#! @PERL@ -w
2#+##############################################################################
3#
4# manage_i18n.pl: manage translation files
5#
6#    Copyright (C) 2003-2005  Patrice Dumas <pertusus@free.fr>,
7#
8#    This program is free software; you can redistribute it and/or modify
9#    it under the terms of the GNU General Public License as published by
10#    the Free Software Foundation; either version 2 of the License, or
11#    (at your option) any later version.
12#
13#    This program is distributed in the hope that it will be useful,
14#    but WITHOUT ANY WARRANTY; without even the implied warranty of
15#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16#    GNU General Public License for more details.
17#
18#    You should have received a copy of the GNU General Public License
19#    along with this program; if not, write to the Free Software
20#    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
21#    02110-1301  USA
22#
23#-##############################################################################
24
25# for file in ../i18n/*; do echo $file | grep -qs 'old\|CVS' && continue; bfile=`basename $file .thl`; post='.us-ascii.po'; msgen texi2html_document.pot > $bfile$post-1; sed -i -e 's/CHARSET/us-ascii/' $bfile$post-1 ; msgfilter --keep-header -i $bfile$post-1 -o $bfile$post ../manage_i18n.pl filter -I ../ --lang $bfile;  done
26#  for file in ../i18n/hu.thl ../i18n/it.thl ; do echo $file | grep -qs 'old\|CVS' && continue; bfile=`basename $file .thl`; post='.po'; msgen texi2html_document.pot > $bfile$post-1; sed -i -e 's/CHARSET/utf-8/' $bfile$post-1 ; msgfilter --keep-header -i $bfile$post-1 -o $bfile$post ../manage_i18n.pl filter -I ../ --lang $bfile;  done
27
28# remove every translations while keeping the header
29#  msgfilter --keep-header -i es.us-ascii.po 'true' > es.us-ascii.po-head
30# duplicate english messages to msgstr
31#  msgen es.us-ascii.po-head > es.us-ascii.po-en
32# use the new translations
33#  msgfilter --keep-header -i es.us-ascii.po-en ../manage_i18n.pl filter -I ../ --lang es > es.us-ascii.po-new
34#
35# mv es.us-ascii.po-new es.us-ascii.po
36
37# This requires perl version 5 or higher
38require 5.0;
39
40use strict;
41
42use File::Copy;
43#use Data::Dumper;
44@REQUIRE_DATA_DUMPER@;
45use Getopt::Long qw(GetOptions);
46
47my $USE_DATA_DUMPER = '@USE_DATA_DUMPER@';
48select(STDERR);
49$| = 1;
50select(STDOUT);
51$| = 1;
52
53my $help = 0;
54my $language;
55my $dir = 'i18n'; # name of the directory containing the per language files
56my $output; # file containing all the translations or output directory
57# = 'translations.pl'; # file containing all the translations
58my @known_languages = ('en', 'de', 'nl', 'es', 'no', 'pt', 'pt_BR', 'ja',
59  'fr', 'it', 'hu'); # The supported languages
60my @searched_dirs = (); # dir searched for sources and language files
61
62#my $template = 'template';
63my $template_lang = 'en';
64my @sources = ('texi2html.pl', 'texi2html.init', 'T2h_i18n.pm',
65 'examples/roff.init', 'examples/noheaders.init');
66my $lang;
67my $charset;
68
69GetOptions('Include=s' => \@searched_dirs, 'output=s' => \$output,
70  'directory=s' => \$dir, 'help+' => \$help, 'lang=s' => \$lang,
71  'charset=s' => \$charset);
72
73
74if ($help)
75{
76    my $command_basename = $0;
77    $command_basename =~ s%.*/%%;
78    my $usage_text = <<EOT;
79Usage: 
80  $command_basename -h
81  $command_basename [-I <dir>][-d <i18n_dir>][-o <out_dir>] template source_files...
82  $command_basename [-I <dir>][-d <i18n_dir>][-o <out_dir>] update [ language... ]
83  $command_basename [-I <dir>][-d <i18n_dir>][-o <result_file>] merge
84
85Default languages are files in the i18n_dir with .thl extension.
86EOT
87    print $usage_text;
88    exit 0;
89}
90
91if (!@searched_dirs)
92{
93    @searched_dirs = ('.');
94}
95
96if (@ARGV < 1)
97{
98    die "Need a command\n";
99}
100
101my $command = shift @ARGV;
102
103my $output_dir = $dir;
104$output_dir = $output if (defined($output));
105
106my $translations_file = 'translations.pl';
107$translations_file = $output if (defined($output));
108
109sub locate_file($$)
110{
111    my $file = shift;
112    my $directories = shift;
113
114    $directories = \@searched_dirs if !defined($directories);
115
116    if ($file =~ /^\//)
117    {
118         return $file if (-e $file and -r $file);
119    }
120    else
121    {
122         foreach my $dir (@$directories)
123         {
124              next unless (-d "$dir");
125              return "$dir/$file" if (-e "$dir/$file" and -r "$dir/$file");
126         }
127    }
128    return undef;
129}
130
131my $defaults_file = "$dir/$template_lang";
132
133use vars qw(
134$LANGUAGES
135$T2H_OBSOLETE_STRINGS
136);
137
138# Strings not in code
139my $template_strings =
140{
141 'January' => '',
142 'February' => '',
143 'March' => '',
144 'April' => '',
145 'May' => '',
146 'June' => '',
147 'July' => '',
148 'August' => '',
149 'September' => '',
150 'October' => '',
151 'November' => '',
152 'December' => '',
153 'T2H_today' => '%s, %d %d',
154};
155
156# Handle per language files
157if ($USE_DATA_DUMPER)
158{
159   $Data::Dumper::Sortkeys = 1;
160}
161
162sub update_language_file($$$$$);
163
164#die "No suitable $dir directory\n" unless (-d $dir and -r $dir);
165
166sub get_languages($$)
167{
168    my $directories = shift;
169    my $i18n_dir = shift;
170    my @languages = ();
171    foreach my $searched_dir (@$directories)
172    {
173         my $dir = "$searched_dir/$i18n_dir";
174         if (opendir DIR, $dir)
175         {
176             my @new_languages = grep {
177                 ! /^\./ &&
178                 ! /\.(bak|orig|old|dpkg-old|rpmnew|rpmsave)$/ &&
179                 ! /~$/ &&
180                 ! /^#.*#$/ &&
181                 /\.thl$/ &&
182                -f $dir . '/' . $_
183             } readdir DIR;
184             closedir DIR;
185             foreach my $language (@new_languages)
186             {
187                 $language =~ s/\.thl$//;
188                 push @languages, $language unless grep {$_ eq $language}
189                       @languages;
190             }
191         }
192    }
193    my @known = @known_languages;
194    foreach my $lang (@languages)
195    {
196         if (grep {$_ eq $lang} @known)
197         {
198              @known = grep {$_ ne $lang} @known;
199         }
200         else
201         {
202             warn "Remark: you could update the known languages array for `$lang'\n";
203         }
204    }
205    warn "Remark: the following known languages have no corresponding file: @known\n" if (@known);
206    return @languages;
207}
208
209sub merge_i18n_files($$$)
210{
211    my $directories = shift;
212    my $i18n_dir = shift;
213    my $translation_file = shift;
214    my @languages = get_languages($directories, $i18n_dir);
215    die "No languages found\n" unless (@languages);
216    if (-f $translation_file)
217    {
218        unless (File::Copy::copy ($translation_file, "$translation_file.old"))
219        {
220            die "Error copying $translation_file to $translation_file.old\n";
221        }
222    }
223    #foreach my $lang ($template, @known_languages)
224    die "open $translation_file failed" unless (open (TRANSLATIONS, ">$translation_file"));
225    foreach my $lang (@languages)
226    {
227         my $file = locate_file("$i18n_dir/$lang.thl", $directories);
228         next unless defined($file);
229         unless (open (FILE, $file))
230         {
231              warn "open $file failed: $!\n";
232              return;
233         }
234         while (<FILE>)
235         {
236              print TRANSLATIONS;
237         }
238         close FILE;
239    }
240}
241
242sub get_language_hashes($$)
243{
244    my $from_file = shift;
245    my $lang = shift;
246    if (defined($from_file) and -f $from_file)
247    {
248        eval { require($from_file) ;};
249        if ($@)
250        {
251            warn "require $from_file failed: $@\n";
252            return (undef,undef);
253        }
254        if (!defined($LANGUAGES->{$lang}))
255        {
256            warn "LANGUAGES->{$lang} not defined in $from_file\n";
257            return (undef,undef);
258        }
259    }
260    return ($LANGUAGES->{$lang}, $T2H_OBSOLETE_STRINGS->{$lang})
261}
262
263sub get_translation_string($$$$)
264{
265    my $directories = shift;
266    my $i18n_dir = shift;
267    my $lang = shift;
268    my $string_to_find = shift;
269    my $from_file = locate_file("$i18n_dir/$lang.thl", $directories);
270
271    my ($strings, $obsolete_strings) = get_language_hashes($from_file, $lang);
272
273    return $strings->{$string_to_find} if (defined($strings) and defined($strings->{$string_to_find}));
274    return $obsolete_strings->{$string_to_find} if (defined($obsolete_strings) and defined($obsolete_strings->{$string_to_find}));
275    return undef;
276}
277
278sub update_language_hash($$$)
279{
280    my $from_file = shift;
281	my $lang = shift;
282	my $reference = shift;
283
284    if (defined($from_file) and -f $from_file)
285    {
286        eval { require($from_file) ;};
287        if ($@)
288        {
289            warn "require $from_file failed: $@\n";
290            return;
291        }
292        if (!defined($LANGUAGES->{$lang}))
293        {
294            warn "LANGUAGES->{$lang} not defined in $from_file\n";
295            return;
296        }
297    }
298    if (!defined($T2H_OBSOLETE_STRINGS->{$lang}))
299    {
300        $T2H_OBSOLETE_STRINGS->{$lang} = {};
301    }
302    if (!defined($LANGUAGES->{$lang}))
303    {
304        $LANGUAGES->{$lang} = {};
305    }
306
307	foreach my $string (keys %{$LANGUAGES->{$lang}})
308	{
309        $T2H_OBSOLETE_STRINGS->{$lang}->{$string} = $LANGUAGES->{$lang}->{$string}
310            if (defined($LANGUAGES->{$lang}->{$string}) and ($LANGUAGES->{$lang}->{$string} ne ''));
311    }
312
313    $LANGUAGES->{$lang} = {};
314
315    foreach my $string (keys (%{$reference}))
316    {
317        if (exists($T2H_OBSOLETE_STRINGS->{$lang}->{$string}) and
318            defined($T2H_OBSOLETE_STRINGS->{$lang}->{$string}) and
319            ($T2H_OBSOLETE_STRINGS->{$lang}->{$string} ne ''))
320        {
321             $LANGUAGES->{$lang}->{$string} = $T2H_OBSOLETE_STRINGS->{$lang}->{$string};
322             delete $T2H_OBSOLETE_STRINGS->{$lang}->{$string};
323        }
324        else
325        {
326             $LANGUAGES->{$lang}->{$string} = '';
327        }
328    }
329	return 1;
330}
331
332# Based on the template file, update the different language files
333sub update_i18n_files($$$$@)
334{
335    my $directories = shift;
336    my $i18n_dir = shift;
337    my $out_i18n_dir = shift;
338    my $template_language = shift;
339
340    my @languages = grep {$template_language ne $_}
341         get_languages($directories, $i18n_dir);
342    if (@_)
343    {
344        @languages = ();
345        foreach my $lang (@_)
346        {
347            unless (grep {$lang eq $_} @known_languages)
348            {
349                warn "Remark: you could update the known languages array for `$lang'\n";
350            }
351            push (@languages, $lang) unless (grep {$lang eq $_} @languages);
352        }
353    }
354    unless (@languages)
355    {
356        warn "No languages to update\n" ;
357        return;
358    }
359
360    my $template_file = locate_file("$i18n_dir/$template_language.thl",
361         $directories);
362    die "No $i18n_dir/$template_language.thl found\n" unless
363         (defined($template_file));
364    eval { require($template_file) ;};
365    if ($@)
366    {
367        die "require $template_file failed: $@\n";
368    }
369    die "LANGUAGE->{'$template_language'} undef after require $template_file\n" unless
370         (defined($LANGUAGES) and defined($LANGUAGES->{$template_language}));
371    foreach my $string (keys(%$template_strings))
372    {
373        die "template string $string undef"
374           unless (defined($LANGUAGES->{$template_language}->{$string}));
375    }
376    unless (-d $out_i18n_dir)
377    {
378        if (!mkdir($out_i18n_dir, oct(755)))
379        {
380            die "cannot mkdir $out_i18n_dir: $!\n";
381        }
382    }
383    foreach my $lang (@languages)
384    {
385        update_language_file($directories, $i18n_dir, $out_i18n_dir,
386            $template_language, $lang);
387    }
388    return 1;
389}
390
391sub copy_or_touch($$)
392{
393    my $from_file = shift;
394    my $to_file = shift;
395    my $atime = time;
396    my $mtime = $atime;
397    if ($to_file eq $from_file)
398    {
399        utime $atime, $mtime, $from_file;
400        return;
401    }
402    elsif (-f $to_file)
403    {
404        my $identical_files = 1;
405        if (open(FROMFILE, $from_file))
406        {
407             if (open(TOFILE, $to_file))
408             {
409                  my $to_file_lines = '';
410                  my $from_file_lines = '';
411                  while (<FROMFILE>)
412                  {
413                       $from_file_lines .= $_;
414                  }
415                  while (<TOFILE>)
416                  {
417                       $to_file_lines .= $_;
418                  }
419                  if ($from_file_lines eq $to_file_lines)
420                  {
421                       utime $atime, $mtime, $from_file;
422                       return;
423                  }
424             }
425        }
426        else
427        {
428             warn "Error opening $from_file\n";
429             utime $atime, $mtime, $to_file;
430        }
431    }
432    unless (File::Copy::copy($from_file, $to_file))
433    {
434        warn "Error copying $from_file to $to_file\n";
435    }
436}
437
438sub update_language_file($$$$$)
439{
440    my $directories = shift;
441    my $i18n_dir = shift;
442    my $out_i18n_dir = shift;
443    my $template_language = shift;
444    my $lang = shift;
445    my $from_file = locate_file("$i18n_dir/$lang.thl", $directories);
446    my $to_file = "$out_i18n_dir/$lang.thl";
447
448    return unless (defined($from_file));
449
450    return unless (update_language_hash($from_file, $lang,
451        $LANGUAGES->{$template_language}));
452
453    if (-f $to_file)
454    {
455        unless (File::Copy::copy($to_file, "$to_file.old"))
456        {
457            warn "Error copying $to_file to $to_file.old\n";
458            return;
459        }
460    }
461    if (!$USE_DATA_DUMPER)
462    {
463        copy_or_touch($from_file, $to_file);
464        return;
465    }
466    unless (open(FILE, ">$to_file"))
467    {
468         warn "open $to_file failed: $!\n";
469         return;
470    }
471
472    print FILE "" . Data::Dumper->Dump([$LANGUAGES->{$lang}], [ "LANGUAGES->{'$lang'}" ]);
473    print FILE "\n";
474    print FILE Data::Dumper->Dump([$T2H_OBSOLETE_STRINGS->{$lang}], [ "T2H_OBSOLETE_STRINGS->{'$lang'}"]);
475    print FILE "\n";
476    print FILE "\n";
477    close FILE;
478}
479
480sub update_template($$$$@)
481{
482    my $directories = shift;
483    my $i18n_dir = shift;
484    my $template_language = shift;
485    my $out_dir = shift;
486    my $source_strings = {};
487    unless (@_)
488    {
489        die "No source files\n";
490    }
491    foreach my $source (@_)
492    {
493        my $source_file = locate_file($source, $directories);
494        unless (defined($source_file))
495        {
496            warn "$source_file not found\n";
497            next;
498        }
499        unless (open (FILE, "$source_file"))
500        {
501            warn "open $source_file failed: $!\n";
502            next;
503        }
504        my $line_nr = 0;
505        while (<FILE>)
506        {
507             $line_nr++;
508             my $string;
509             next if /^\s*#/;
510             while ($_)
511             {
512                  if (defined($string))
513                  {
514                       if (s/^([^\\']*)(\\|')//)
515                       {
516                            $string .= $1 if (defined($1));
517                            if ($2 eq "'")
518                            {
519                                 $source_strings->{$string} = '' ;
520                                 $string = undef;
521                            }
522                            else
523                            {
524                                 if (s/^(.)//)
525                                 {
526                                      #$string .= '\\' . $1;
527                                      $string .= $1;
528                                 }
529                                 else
530                                 {
531                                      warn "\\ at end of line, file $source_file, line nr $line_nr\n";
532                                      $source_strings->{$string} = '' ;
533                                      $string = undef;
534                                 }
535                            }
536                       }
537                       else
538                       {
539                            warn "string not closed file $source_file, line nr $line_nr\n";
540                            $source_strings->{$string} = '' ;
541                            $string = undef;
542                       }
543                  }
544                  elsif (s/^.*?&\$I\s*\('// or s/^.*? gdt\('//)
545                  #elsif (s/^.*?&\$I\s*\('//)
546                  {
547                       $string = '';
548                  }
549                  else
550                  {
551                       last;
552                  }
553             }
554        }
555        close FILE;
556    }
557    foreach my $string (keys(%$template_strings))
558    {
559        $source_strings->{$string} = $template_strings->{$string};
560    }
561    my $template_file =
562        locate_file("$i18n_dir/$template_language.thl",$directories);
563    die unless (update_language_hash($template_file,
564            $template_language, $source_strings));
565	foreach my $string (keys(%$template_strings))
566	{ # use values in template_srings if it exists
567        my $existing_string = $LANGUAGES->{$template_language}->{$string};
568        $LANGUAGES->{$template_language}->{$string} = $template_strings->{$string}
569          if ((!defined($existing_string)) or ($existing_string eq ''));
570    }
571    unless (-d $out_dir)
572    {
573        if (!mkdir($out_dir, oct(755)))
574        {
575            die "cannot mkdir $out_dir: $!\n";
576        }
577    }
578    my $out_template_file = "$out_dir/$template_language";
579
580    if (!$USE_DATA_DUMPER)
581    {
582        return if (!defined($template_file));
583        copy_or_touch($template_file, $out_template_file);
584        return;
585    }
586    unless (open(TEMPLATE, ">$out_template_file"))
587    {
588        die "open $out_template_file failed: $!\n";
589    }
590    print TEMPLATE "" . Data::Dumper->Dump([$LANGUAGES->{$template_language}], [ "LANGUAGES->{'$template_language'}" ]);
591    print TEMPLATE "\n";
592    print TEMPLATE Data::Dumper->Dump([$T2H_OBSOLETE_STRINGS->{$template_language}], [ "T2H_OBSOLETE_STRINGS->{'$template_language'}"]);
593    print TEMPLATE "\n";
594    print TEMPLATE "\n";
595    close TEMPLATE;
596}
597
598if ($command eq 'update')
599{
600    update_i18n_files(\@searched_dirs, $dir, $output_dir,
601         $template_lang, @ARGV);
602}
603elsif ($command eq 'merge')
604{
605    merge_i18n_files(\@searched_dirs, $dir, $translations_file);
606}
607elsif ($command eq 'template')
608{
609    my @source_files = @ARGV;
610    unless (@source_files)
611    {
612         @source_files = @sources;
613    }
614    update_template(\@searched_dirs, $dir, $template_lang, $output_dir,
615          @source_files);
616}
617
618#elsif ($command eq 'all')
619#{
620#    my @source_files = @ARGV;
621#    unless (@source_files)
622#    {
623#         @source_files = @sources;
624#    }
625#    update_template(\@searched_dirs, $dir, $output_dir, $template_lang,
626#         @source_files);
627#    update_i18n_files(\@searched_dirs, $dir, $dir,
628#          $template_lang, "$output_dir/$template_lang");
629#    merge_i18n_files(\@searched_dirs, $dir, $translations_file);
630#}
631elsif ($command eq 'filter')
632{
633    die "filter requires --lang\n" if (!defined($lang));
634    $/ = undef;
635    my $string_to_find = <STDIN>;
636    my $translated_string = get_translation_string(\@searched_dirs, $dir, $lang, $string_to_find);
637    $translated_string = '' if (!defined($translated_string));
638#print STDERR "LLL $string_to_find|$translated_string\n";
639    if (defined($charset))
640    { # this doesn't work, and is not needed
641       binmode(STDOUT, ":encoding($charset)");
642    }
643    print STDOUT "$translated_string";
644}
645else
646{
647    warn "Unknown i18n command: $command\n";
648}
649exit 0;
650
6511;
652