3 # -n do not include custom_ scripts
4 # -v verbose mode, shows progress stuff
6 # this version of locles processes not only all required .pl files
7 # but also all parse_html_templated files.
15 use List::Util qw(first);
19 use File::Slurp qw(slurp);
21 $OUTPUT_AUTOFLUSH = 1;
30 my $basedir = "../..";
31 my $locales_dir = ".";
32 my $bindir = "$basedir/bin/mozilla";
33 my $dbupdir = "$basedir/sql/Pg-upgrade";
34 my $dbupdir2 = "$basedir/sql/Pg-upgrade2";
35 my $menufile = "menu.ini";
36 my $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
38 my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit);
39 my ($ALL_HEADER, $MISSING_HEADER, $LOST_HEADER);
43 opendir DIR, "$bindir" or die "$!";
44 my @progfiles = grep { /\.pl$/ && !/(_custom|^\.)/ } readdir DIR;
46 my @customfiles = grep /_custom/, readdir DIR;
49 # put customized files into @customfiles
54 @menufiles = ($menufile);
56 opendir DIR, "$basedir" or die "$!";
57 @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
59 unshift @menufiles, $menufile;
62 opendir DIR, $dbupdir or die "$!";
63 my @dbplfiles = grep { /\.pl$/ } readdir DIR;
66 opendir DIR, $dbupdir2 or die "$!";
67 my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
70 # slurp the translations in
76 if (-f "$locales_dir/all") {
77 require "$locales_dir/all";
79 if (-f "$locales_dir/missing") {
80 require "$locales_dir/missing" ;
81 unlink "$locales_dir/missing";
83 if (-f "$locales_dir/lost") {
84 require "$locales_dir/lost";
85 unlink "$locales_dir/lost";
88 my %old_texts = %{ $self->{texts} || {} };
90 map({ handle_file($_, $bindir); } @progfiles);
91 map({ handle_file($_, $dbupdir); } @dbplfiles);
92 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
96 file => "$locales_dir/all",
97 header => $ALL_HEADER,
98 data_name => '$self->{texts}',
99 data_sub => sub { _print_line($_, $self->{texts}{$_}, @_) for sort keys %alllocales },
102 # calc and generate missing
103 push @missing, grep { !$self->{texts}{$_} } sort keys %alllocales;
107 file => "$locales_dir/missing",
108 header => $MISSING_HEADER,
109 data_name => '$missing',
110 data_sub => sub { _print_line($_, '', @_) for @missing },
114 # calc and generate lost
115 while (my ($text, $translation) = each %old_texts) {
116 next if ($alllocales{$text});
117 push @lost, { 'text' => $text, 'translation' => $translation };
121 splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
123 file => "$locales_dir/lost",
124 header => $LOST_HEADER,
126 data_name => '@lost',
128 _print_line($_->{text}, $_->{translation}, @_, template => " { 'text' => %s, 'translation' => %s },\n") for @lost;
133 my $trlanguage = slurp("$locales_dir/LANGUAGE");
136 search_unused_htmlfiles() if $opt_c;
138 my $count = scalar keys %alllocales;
139 my $notext = scalar @missing;
140 my $per = sprintf("%.1f", ($count - $notext) / $count * 100);
141 print "\n$trlanguage - ${per}%";
142 print " - $notext/$count missing" if $notext;
151 # These are all the texts to build the translations files.
152 # The file has the form of 'english text' => 'foreign text',
153 # you can add the translation in this file or in the 'missing' file
154 # run locales.pl from this directory to rebuild the translation files
156 $MISSING_HEADER = <<EOL;
157 # add the missing texts and run locales.pl to rebuild
159 $LOST_HEADER = <<EOL;
160 # The last 50 texts that have been removed.
161 # This file will be auto-generated by locales.pl. Do not edit it.
169 'no-custom-files' => \$opt_n,
170 'check-files' => \$opt_c,
171 'verbose' => \$opt_v,
183 pod2usage(-exitstatus => 0, -verbose => 2);
188 my $arg = shift @ARGV;
190 foreach my $dir ("../locale/$arg", "locale/$arg", "../$arg", $arg) {
191 next unless -d $dir && -f "$dir/all" && -f "$dir/LANGUAGE";
197 print "The locale directory '$arg' could not be found.\n";
201 } elsif (!-f 'all' || !-f 'LANGUAGE') {
202 print "locales.pl was not called from a locale/* subdirectory,\n"
203 . "and no locale directory name was given.\n";
209 my ($file, $dir) = @_;
210 print "\n$file" if $opt_v;
214 &scanfile("$dir/$file");
216 # scan custom_{module}.pl or {login}_{module}.pl files
217 foreach my $customfile (@customfiles) {
218 if ($customfile =~ /_$file/) {
219 if (-f "$dir/$customfile") {
220 &scanfile("$dir/$customfile");
225 # if this is the menu.pl file
226 if ($file eq 'menu.pl') {
227 foreach my $item (@menufiles) {
228 &scanmenu("$basedir/$item");
232 if ($file eq 'menunew.pl') {
233 foreach my $item (@menufiles) {
234 &scanmenu("$basedir/$item");
241 foreach my $text (keys %$missing) {
242 if ($locale{$text} || $htmllocale{$text}) {
243 unless ($self->{texts}{$text}) {
244 $self->{texts}{$text} = $missing->{$text};
250 sub extract_text_between_parenthesis {
251 my ($fh, $line) = @_;
252 my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
255 if (length($line) <= $pos) {
257 return ($text, "") unless ($line);
261 my $cur_char = substr($line, $pos, 1);
263 if (!$inside_string) {
264 if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
265 $inside_string = substr($line, $pos + 2, 1);
268 } elsif ((length($line) >= ($pos + 2)) &&
269 (substr($line, $pos, 1) eq "q")) {
270 $inside_string = substr($line, $pos + 1, 1);
273 } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
274 $inside_string = $cur_char;
276 } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
277 return ($text, substr($line, $pos + 1));
285 } elsif ($cur_char eq '\\') {
289 } elsif ($cur_char eq $inside_string) {
290 undef($inside_string);
303 my $dont_include_subs = shift;
304 my $scanned_files = shift;
309 $scanned_files = {} unless ($scanned_files);
310 return if ($scanned_files->{$file});
311 $scanned_files->{$file} = 1;
313 if (!defined $cached{$file}) {
315 return unless (-f "$file");
317 my $fh = new FileHandle;
318 open $fh, "$file" or die "$! : $file";
320 my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
325 # is this another file
326 if (/require\s+\W.*\.pl/) {
328 $newfile =~ s/require\s+\W//;
329 $newfile =~ s|bin/mozilla||;
330 $cached{$file}{scan}{"$bindir/$newfile"} = 1;
331 } elsif (/use\s+SL::([\w:]*)/) {
334 $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
337 # is this a template call?
338 if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
339 my $newfile = "$basedir/templates/webpages/$1.html";
340 if (/parse_html_template2/) {
341 print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
344 $cached{$file}{scanh}{$newfile} = 1;
347 print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
356 my ($null, $country) = split /,/;
357 $country =~ s/^ +[\"\']//;
358 $country =~ s/[\"\'].*//;
364 # is it a submit button before $locale->
365 if (/$submitsearch/) {
367 if ($` !~ /locale->text/) {
369 $sub_line_no = $line_no;
373 my ($found) = /locale->text.*?\(/;
378 ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
381 # if there is no $ in the string record it
382 unless (($string =~ /\$\D.*/) || ("" eq $string)) {
384 # this guarantees one instance of string
385 $cached{$file}{locale}{$string} = 1;
387 # this one is for all the locales
388 $cached{$file}{all}{$string} = 1;
390 # is it a submit button before $locale->
392 $cached{$file}{submit}{$string} = 1;
395 } elsif ($postmatch =~ />/) {
399 # exit loop if there are no more locales on this line
400 ($rc) = ($postmatch =~ /locale->text/);
402 if ( ($postmatch =~ />/)
403 || (!$found && ($sub_line_no != $line_no) && />/)) {
413 map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
414 map { $locale{$_} = 1 } keys %{$cached{$file}{locale}};
415 map { $submit{$_} = 1 } keys %{$cached{$file}{submit}};
416 map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
417 map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
418 map { &scanhtmlfile($_) } keys %{$cached{$file}{scanh}};
420 @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
426 my $fh = new FileHandle;
427 open $fh, "$file" or die "$! : $file";
429 my @a = grep m/^\[/, <$fh>;
433 grep { s/(\[|\])//g } @a;
435 foreach my $item (@a) {
436 my @b = split /--/, $item;
437 foreach my $string (@b) {
439 $locale{$string} = 1;
440 $alllocales{$string} = 1;
446 sub unescape_template_string {
457 if (!defined $cached{$file}) {
458 my %plugins = ( 'loaded' => { }, 'needed' => { } );
460 open(IN, $file) || die $file;
465 while (my $line = <IN>) {
468 while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
469 $plugins{loaded}->{$1} = 1;
472 while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
474 $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
477 while ($line =~ m/(?: # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
478 (LxERP\.t8)\( # LxERP.t8( ::Parameter $1::
479 ([\'\"]) # Anfang des zu übersetzenden Strings ::Parameter $2::
480 (.*?) # Der zu übersetzende String ::Parameter $3::
481 (?<!\\)\2 # Ende des zu übersetzenden Strings
482 | # Start von Variante 2: [% '...' | $T8 %]
483 \[\% # Template-Start-Tag
484 [\-~#]? # Whitespace-Unterdrückung
485 \s* # Optional beliebig viele Whitespace
486 ([\'\"]) # Anfang des zu übersetzenden Strings ::Parameter $4::
487 (.*?) # Der zu übersetzende String ::Parameter $5::
488 (?<!\\)\4 # Ende des zu übersetzenden Strings
489 \s*\|\s* # Pipe-Zeichen mit optionalen Whitespace davor und danach
490 (\$T8) # Filteraufruf ::Parameter $6::
491 .*? # Optionale Argumente für den Filter
493 [\-~#]? # Whitespace-Unterdrückung
494 \%\] # Template-Ende-Tag
497 my $module = $1 || $6;
498 my $string = $3 || $5;
499 print "Found filter >>>$string<<<\n" if $debug;
500 substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
502 $string = unescape_template_string($string);
503 $cached{$file}{all}{$string} = 1;
504 $cached{$file}{html}{$string} = 1;
505 $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
506 $plugins{needed}->{T8} = 1 if $module eq '$T8';
507 $plugins{needed}->{LxERP} = 1 if $module eq 'LxERP.t8';
510 while ($line =~ m/\[\% # Template-Start-Tag
511 [\-~#]? # Whitespace-Unterdrückung
512 \s* # Optional beliebig viele Whitespace
513 (?: # Die erkannten Template-Direktiven
518 \s+ # Mindestens ein Whitespace
519 [\'\"]? # Anfang des Dateinamens
520 ([^\s]+) # Beliebig viele Nicht-Whitespaces -- Dateiname
521 \.html # Endung ".html", ansonsten kann es der Name eines Blocks sein
523 my $new_file_name = "$basedir/templates/webpages/$1.html";
524 $cached{$file}{scanh}{$new_file_name} = 1;
525 substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
531 foreach my $plugin (keys %{ $plugins{needed} }) {
532 next if ($plugins{loaded}->{$plugin});
533 print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
537 # copy back into global arrays
538 map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
539 map { $locale{$_} = 1 } keys %{$cached{$file}{html}};
540 map { $submit{$_} = 1 } keys %{$cached{$file}{submit}};
542 map { scanhtmlfile($_) } keys %{$cached{$file}{scanh}};
544 @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
547 sub search_unused_htmlfiles {
548 my @unscanned_dirs = ('../../templates/webpages');
550 while (scalar @unscanned_dirs) {
551 my $dir = shift @unscanned_dirs;
553 foreach my $entry (<$dir/*>) {
555 push @unscanned_dirs, $entry;
557 } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
558 print "W: unused HTML template: " . strip_base($entry) . "\n";
566 my $s = "$_[0]"; # Create a copy of the string.
569 $s =~ s|templates/webpages/||;
576 $val =~ s/('|\\$)/\\$1/g;
577 return "'" . $val . "'";
581 my $key = _single_quote(shift);
582 my $text = _single_quote(shift);
584 my $template = $params{template} || qq| %-29s => %s,\n|;
585 my $fh = $params{fh} || croak 'need filehandle in _print_line';
587 print $fh sprintf $template, $key, $text;
593 my $file = $params{file} || croak 'need filename in generate_file';
594 my $header = $params{header};
595 my $lines = $params{data_sub};
596 my $data_name = $params{data_name};
597 my @delim = split //, ($params{delim} || '{}');
599 open my $fh, '>', $file or die "$! : $file";
601 print $fh "#!/usr/bin/perl\n\n";
602 print $fh $header, "\n" if $header;
603 print $fh "$data_name = $delim[0]\n" if $data_name;
607 print $fh qq|$delim[1];\n\n1;\n|;
615 locales.pl - Collect strings for translation in Lx-Office
622 -n, --no-custom-files Do not process files whose name contains "_"
623 -c, --check-files Run extended checks on HTML files
624 -v, --verbose Be more verbose
625 -h, --help Show this help
631 =item B<-n>, B<--no-custom-files>
633 Do not process files whose name contains "_", e.g. "custom_io.pl".
635 =item B<-c>, B<--check-files>
637 Run extended checks on the usage of templates. This can be used to
638 discover HTML templates that are never used as well as the usage of
639 non-existing HTML templates.
641 =item B<-v>, B<--verbose>
649 This script collects strings from Perl files, the menu.ini file and
650 HTML templates and puts them into the file "all" for translation. It
651 also distributes those translations back to the individual files.