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.
12 use List::Util qw(first);
19 $bindir = "$basedir/bin/mozilla";
20 $dbupdir = "$basedir/sql/Pg-upgrade";
21 $dbupdir2 = "$basedir/sql/Pg-upgrade2";
22 $menufile = "menu.ini";
23 $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
25 %referenced_html_files = ();
34 GetOptions('no-custom-files' => \$opt_n,
35 'check-files' => \$opt_c,
46 pod2usage(-exitstatus => 0, -verbose => 2);
53 opendir DIR, "$bindir" or die "$!";
54 @progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
56 @customfiles = grep /_/, readdir DIR;
59 # put customized files into @customfiles
63 @menufiles = ($menufile);
65 opendir DIR, "$basedir" or die "$!";
66 @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
68 unshift @menufiles, $menufile;
71 opendir DIR, $dbupdir or die "$!";
72 @dbplfiles = grep { /\.pl$/ } readdir DIR;
75 opendir DIR, $dbupdir2 or die "$!";
76 @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
79 # slurp the translations in
84 my %old_texts = %{ $self->{texts} };
86 # Read HTML templates.
88 #@htmltemplates = <../../templates/webpages/*/*_master.html>;
89 #foreach $file (@htmltemplates) {
90 # scanhtmlfile($file);
93 map({ handle_file($_, $bindir); } @progfiles);
94 map({ handle_file($_, $dbupdir); } @dbplfiles);
95 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
98 my ($file, $dir) = @_;
99 print "\n$file" if $opt_v;
104 &scanfile("$dir/$file");
106 # scan custom_{module}.pl or {login}_{module}.pl files
107 foreach $customfile (@customfiles) {
108 if ($customfile =~ /_$file/) {
109 if (-f "$dir/$customfile") {
110 &scanfile("$dir/$customfile");
115 # if this is the menu.pl file
116 if ($file eq 'menu.pl') {
117 foreach $item (@menufiles) {
118 &scanmenu("$basedir/$item");
122 if ($file eq 'menunew.pl') {
123 foreach $item (@menufiles) {
124 &scanmenu("$basedir/$item");
131 eval { require 'missing'; };
134 foreach $text (keys %$missing) {
135 if ($locale{$text} || $htmllocale{$text}) {
136 unless ($self->{texts}{$text}) {
137 $self->{texts}{$text} = $missing->{$text};
142 open FH, ">$file" or die "$! : $file";
144 print FH q|#!/usr/bin/perl
149 foreach $key (sort keys %locale) {
150 if ($self->{texts}{$key}) {
151 $text = $self->{texts}{$key};
156 $text =~ s/\\$/\\\\/;
159 $keytext =~ s/'/\\'/g;
160 $keytext =~ s/\\$/\\\\/;
162 print FH qq| '$keytext'|
163 . (' ' x (27 - length($keytext)))
164 . qq| => '$text',\n|;
172 foreach $key (sort keys %subrt) {
175 $text =~ s/\\$/\\\\/;
176 print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
179 foreach $key (sort keys %submit) {
180 $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
182 $text =~ s/\\$/\\\\/;
185 $english_sub =~ s/'/\\'/g;
186 $english_sub =~ s/\\$/\\\\/;
187 $english_sub = lc $key;
189 $translated_sub = lc $text;
190 $english_sub =~ s/( |-|,)/_/g;
191 $translated_sub =~ s/( |-|,)/_/g;
192 print FH qq| '$translated_sub'|
193 . (' ' x (27 - length($translated_sub)))
194 . qq| => '$english_sub',\n|;
206 #foreach $file (@htmltemplates) {
207 # converthtmlfile($file);
212 open FH, ">all" or die "$! : all";
214 print FH q|#!/usr/bin/perl
216 # These are all the texts to build the translations files.
217 # The file has the form of 'english text' => 'foreign text',
218 # you can add the translation in this file or in the 'missing' file
219 # run locales.pl from this directory to rebuild the translation files
224 foreach $key (sort keys %alllocales) {
225 $text = $self->{texts}{$key};
230 $text =~ s/\\$/\\\\/;
239 print FH qq| '$key'| . (' ' x (27 - length($key))) . qq| => '$text',\n|;
251 open FH, ">missing" or die "$! : missing";
253 print FH q|#!/usr/bin/perl
255 # add the missing texts and run locales.pl to rebuild
260 foreach $text (@missing) {
261 print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
280 while (($text, $translation) = each %old_texts) {
281 next if ($alllocales{$text});
283 push @lost, { 'text' => $text, 'translation' => $translation };
287 splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
290 print FH "#!/usr/bin/perl\n\n" .
291 "# The last 50 texts that have been removed.\n" .
292 "# This file will be auto-generated by locales.pl. Do not edit it.\n\n" .
295 foreach $entry (@lost) {
296 $entry->{text} =~ s/\'/\\\'/g;
297 $entry->{translation} =~ s/\'/\\\'/g;
298 print FH " { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
301 print FH ");\n\n1;\n";
305 open(FH, "LANGUAGE");
308 $trlanguage = $language[0];
312 search_unused_htmlfiles();
313 search_translated_htmlfiles_wo_master();
316 $per = sprintf("%.1f", ($count - $notext) / $count * 100);
317 print "\n$trlanguage - ${per}%";
318 print " - $notext/$count missing" if $notext;
325 sub extract_text_between_parenthesis {
326 my ($fh, $line) = @_;
327 my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
330 if (length($line) <= $pos) {
332 return ($text, "") unless ($line);
336 my $cur_char = substr($line, $pos, 1);
338 if (!$inside_string) {
339 if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
340 $inside_string = substr($line, $pos + 2, 1);
343 } elsif ((length($line) >= ($pos + 2)) &&
344 (substr($line, $pos, 1) eq "q")) {
345 $inside_string = substr($line, $pos + 1, 1);
348 } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
349 $inside_string = $cur_char;
351 } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
352 return ($text, substr($line, $pos + 1));
360 } elsif ($cur_char eq '\\') {
364 } elsif ($cur_char eq $inside_string) {
365 undef($inside_string);
378 my $dont_include_subs = shift;
379 my $scanned_files = shift;
384 $scanned_files = {} unless ($scanned_files);
385 return if ($scanned_files->{$file});
386 $scanned_files->{$file} = 1;
388 if (!defined $cached{$file}) {
390 return unless (-f "$file");
392 my $fh = new FileHandle;
393 open $fh, "$file" or die "$! : $file";
395 my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
400 # is this another file
401 if (/require\s+\W.*\.pl/) {
403 $newfile =~ s/require\s+\W//;
404 $newfile =~ s|bin/mozilla||;
405 # &scanfile("$bindir/$newfile", 0, $scanned_files);
406 $cached{$file}{scan}{"$bindir/$newfile"} = 1;
407 } elsif (/use\s+SL::(.*?);/) {
410 # &scanfile("../../SL/${1}.pm", 1, $scanned_files);
411 $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
414 # is this a template call?
415 if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
416 my $newfile = "$basedir/templates/webpages/$1_master.html";
417 if (/parse_html_template2/) {
418 print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
421 # &scanhtmlfile($newfile);
422 # &converthtmlfile($newfile);
423 $cached{$file}{scanh}{$newfile} = 1;
426 print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
432 next if ($dont_include_subs);
433 ($null, $subrt) = split / +/;
434 # $subrt{$subrt} = 1;
435 $cached{$file}{subr}{$subrt} = 1;
444 my ($null, $country) = split /,/;
445 $country =~ s/^ +[\"\']//;
446 $country =~ s/[\"\'].*//;
452 # is it a submit button before $locale->
453 if (/$submitsearch/) {
455 if ($` !~ /locale->text/) {
457 $sub_line_no = $line_no;
461 my ($found) = /locale->text.*?\(/;
462 my $postmatch = "$'";
466 ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
469 # if there is no $ in the string record it
470 unless (($string =~ /\$\D.*/) || ("" eq $string)) {
472 # this guarantees one instance of string
473 # $locale{$string} = 1;
474 $cached{$file}{locale}{$string} = 1;
476 # this one is for all the locales
477 # $alllocales{$string} = 1;
478 $cached{$file}{all}{$string} = 1;
480 # is it a submit button before $locale->
482 # $submit{$string} = 1;
483 $cached{$file}{submit}{$string} = 1;
486 } elsif ($postmatch =~ />/) {
490 # exit loop if there are no more locales on this line
491 ($rc) = ($postmatch =~ /locale->text/);
493 if ( ($postmatch =~ />/)
494 || (!$found && ($sub_line_no != $line_no) && />/)) {
504 map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
505 map { $locale{$_} = 1 } keys %{$cached{$file}{locale}};
506 map { $submit{$_} = 1 } keys %{$cached{$file}{submit}};
507 map { $subrt{$_} = 1 } keys %{$cached{$file}{subr}};
508 map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
509 map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
510 map { &scanhtmlfile($_) } keys %{$cached{$file}{scanh}};
512 @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
518 my $fh = new FileHandle;
519 open $fh, "$file" or die "$! : $file";
521 my @a = grep m/^\[/, <$fh>;
525 grep { s/(\[|\])//g } @a;
527 foreach my $item (@a) {
528 @b = split /--/, $item;
529 foreach $string (@b) {
531 $locale{$string} = 1;
532 $alllocales{$string} = 1;
541 if (!defined $cached{$_[0]}) {
542 my %plugins = ( 'loaded' => { }, 'needed' => { } );
544 open(IN, $_[0]) || die $_[0];
549 while (my $line = <IN>) {
552 while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
553 $plugins{loaded}->{$1} = 1;
556 while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
558 $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
561 while ($line =~ m/\[\% # Template-Start-Tag
562 [\-~#] # Whitespace-Unterdrückung
563 \s* # Optional beliebig viele Whitespace
564 [\'\"] # Anfang des zu übersetzenden Strings
565 (.*?) # Der zu übersetzende String
566 [\'\"] # Ende des zu übersetzenden Strings
567 \s*\|\s* # Pipe-Zeichen mit optionalen Whitespace davor und danach
569 .*? # Optionale Argumente für den Filter und Whitespaces
570 [\-~#] # Whitespace-Unterdrückung
571 \%\] # Template-Ende-Tag
573 print "Found filter >>>$1<<<\n";
574 $cached{$_[0]}{all}{$1} = 1;
575 $cached{$_[0]}{html}{$1} = 1;
576 $plugins{needed}->{T8} = 1;
577 substr $line, $-[1], $+[0] - $-[0], '';
580 while ("" ne $line) {
582 if ($line =~ m|<translate>|i) {
584 if ($` =~ /$submitsearch/) {
587 substr($line, 0, $eom) = "";
594 if ($line =~ m|</translate>|i) {
596 substr($line, 0, $+[0]) = "";
601 # $submit{$text} = 1;
602 $cached{$_[0]}{submit}{$text} = 1;
605 # $alllocales{$text} = 1;
606 $cached{$_[0]}{all}{$text} = 1;
607 # $htmllocale{$text} = 1;
608 $cached{$_[0]}{html}{$text} = 1;
621 foreach my $plugin (keys %{ $plugins{needed} }) {
622 next if ($plugins{loaded}->{$plugin});
623 print "E: " . strip_base($_[0]) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
626 &converthtmlfile($_[0]);
629 # copy back into global arrays
630 map { $alllocales{$_} = 1 } keys %{$cached{$_[0]}{all}};
631 map { $htmllocale{$_} = 1 } keys %{$cached{$_[0]}{html}};
632 map { $submit{$_} = 1 } keys %{$cached{$_[0]}{submit}};
635 sub converthtmlfile {
641 open(IN, $file) || die;
643 my $langcode = (split("/", getcwd()))[-1];
644 $file =~ s/_master.html$/_${langcode}.html/;
646 open(OUT, ">$file") || die;
650 while (my $line = <IN>) {
657 while ("" ne $line) {
659 if ($line =~ m|<translate>|i) {
661 substr($line, 0, $+[0]) = "";
663 print(OUT "\n") if ("" eq $line);
666 print(OUT "${line}\n");
671 if ($line =~ m|</translate>|i) {
673 substr($line, 0, $+[0]) = "";
676 $alllocales{$text} = 1;
677 $htmllocale{$text} = 1;
678 print(OUT $self->{"texts"}{$text} || $text);
679 print(OUT "\n") if ("" eq $line);
694 sub search_unused_htmlfiles {
695 my @unscanned_dirs = ('../../templates/webpages');
697 while (scalar @unscanned_dirs) {
698 my $dir = shift @unscanned_dirs;
700 foreach my $entry (<$dir/*>) {
702 push @unscanned_dirs, $entry;
704 } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
705 print "W: unused HTML template: " . strip_base($entry) . "\n";
712 sub search_translated_htmlfiles_wo_master {
713 my @unscanned_dirs = ('../../templates/webpages');
715 while (scalar @unscanned_dirs) {
716 my $dir = shift @unscanned_dirs;
718 foreach my $entry (<$dir/*>) {
720 push @unscanned_dirs, $entry;
722 } elsif (($entry =~ /_[a-z]+\.html$/) && ($entry !~ /_master.html$/) && -f $entry) {
724 $master =~ s/[a-z]+\.html$/master.html/;
726 print "W: translated HTML template without master: " . strip_base($entry) . "\n";
734 my $s = "$_[0]"; # Create a copy of the string.
737 $s =~ s|templates/webpages/||;
746 locales.pl - Collect strings for translation in Lx-Office
753 -n, --no-custom-files Do not process files whose name contains "_"
754 -c, --check-files Run extended checks on HTML files
755 -v, --verbose Be more verbose
756 -h, --help Show this help
762 =item B<-n>, B<--no-custom-files>
764 Do not process files whose name contains "_", e.g. "custom_io.pl".
766 =item B<-c>, B<--check-files>
768 Run extended checks on the usage of templates. This can be used to
769 discover HTML templates that are never used as well as the usage of
770 non-existing HTML templates.
772 =item B<-v>, B<--verbose>
780 This script collects strings from Perl files, the menu.ini file and
781 HTML templates and puts them into the file "all" for translation. It
782 also distributes those translations back to the individual files.