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 $OUTPUT_AUTOFLUSH = 1;
21 my $basedir = "../..";
22 my $bindir = "$basedir/bin/mozilla";
23 my $dbupdir = "$basedir/sql/Pg-upgrade";
24 my $dbupdir2 = "$basedir/sql/Pg-upgrade2";
25 my $menufile = "menu.ini";
26 my $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
28 my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit, %subrt);
42 GetOptions('no-custom-files' => \$opt_n,
43 'check-files' => \$opt_c,
54 pod2usage(-exitstatus => 0, -verbose => 2);
61 opendir DIR, "$bindir" or die "$!";
62 my @progfiles = grep { /\.pl$/ && !/(_custom|^\.)/ } readdir DIR;
64 my @customfiles = grep /_custom/, readdir DIR;
67 # put customized files into @customfiles
72 @menufiles = ($menufile);
74 opendir DIR, "$basedir" or die "$!";
75 @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
77 unshift @menufiles, $menufile;
80 opendir DIR, $dbupdir or die "$!";
81 my @dbplfiles = grep { /\.pl$/ } readdir DIR;
84 opendir DIR, $dbupdir2 or die "$!";
85 my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
88 # slurp the translations in
106 my %old_texts = %{ $self->{texts} || {} };
108 map({ handle_file($_, $bindir); } @progfiles);
109 map({ handle_file($_, $dbupdir); } @dbplfiles);
110 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
113 my ($file, $dir) = @_;
114 print "\n$file" if $opt_v;
119 &scanfile("$dir/$file");
121 # scan custom_{module}.pl or {login}_{module}.pl files
122 foreach my $customfile (@customfiles) {
123 if ($customfile =~ /_$file/) {
124 if (-f "$dir/$customfile") {
125 &scanfile("$dir/$customfile");
130 # if this is the menu.pl file
131 if ($file eq 'menu.pl') {
132 foreach my $item (@menufiles) {
133 &scanmenu("$basedir/$item");
137 if ($file eq 'menunew.pl') {
138 foreach my $item (@menufiles) {
139 &scanmenu("$basedir/$item");
146 foreach my $text (keys %$missing) {
147 if ($locale{$text} || $htmllocale{$text}) {
148 unless ($self->{texts}{$text}) {
149 $self->{texts}{$text} = $missing->{$text};
154 open FH, ">$file" or die "$! : $file";
156 print FH q|#!/usr/bin/perl
161 foreach my $key (sort keys %locale) {
162 my $text = $self->{texts}{$key} || $key;
164 $text =~ s/\\$/\\\\/;
167 $keytext =~ s/'/\\'/g;
168 $keytext =~ s/\\$/\\\\/;
170 print FH qq| '$keytext'|
171 . (' ' x (27 - length($keytext)))
172 . qq| => '$text',\n|;
180 foreach my $key (sort keys %subrt) {
183 $text =~ s/\\$/\\\\/;
184 print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
187 foreach my $key (sort keys %submit) {
188 my $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
190 $text =~ s/\\$/\\\\/;
192 my $english_sub = $key;
193 $english_sub =~ s/'/\\'/g;
194 $english_sub =~ s/\\$/\\\\/;
195 $english_sub = lc $key;
197 my $translated_sub = lc $text;
198 $english_sub =~ s/( |-|,)/_/g;
199 $translated_sub =~ s/( |-|,)/_/g;
200 print FH qq| '$translated_sub'|
201 . (' ' x (27 - length($translated_sub)))
202 . qq| => '$english_sub',\n|;
216 open FH, ">all" or die "$! : all";
218 print FH q|#!/usr/bin/perl
220 # These are all the texts to build the translations files.
221 # The file has the form of 'english text' => 'foreign text',
222 # you can add the translation in this file or in the 'missing' file
223 # run locales.pl from this directory to rebuild the translation files
228 foreach my $key (sort keys %alllocales) {
229 my $text = $self->{texts}{$key};
234 $text =~ s/\\$/\\\\/;
243 print FH qq| '$key'| . (' ' x (27 - length($key))) . qq| => '$text',\n|;
255 open FH, ">missing" or die "$! : missing";
257 print FH q|#!/usr/bin/perl
259 # add the missing texts and run locales.pl to rebuild
264 foreach my $text (@missing) {
265 print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
277 while (my ($text, $translation) = each %old_texts) {
278 next if ($alllocales{$text});
280 push @lost, { 'text' => $text, 'translation' => $translation };
284 splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
287 print FH "#!/usr/bin/perl\n\n" .
288 "# The last 50 texts that have been removed.\n" .
289 "# This file will be auto-generated by locales.pl. Do not edit it.\n\n" .
292 foreach my $entry (@lost) {
293 $entry->{text} =~ s/\'/\\\'/g;
294 $entry->{translation} =~ s/\'/\\\'/g;
295 print FH " { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
298 print FH ");\n\n1;\n";
302 open(FH, "LANGUAGE");
305 my $trlanguage = $language[0];
309 search_unused_htmlfiles();
312 my $per = sprintf("%.1f", ($count - $notext) / $count * 100);
313 print "\n$trlanguage - ${per}%";
314 print " - $notext/$count missing" if $notext;
321 sub extract_text_between_parenthesis {
322 my ($fh, $line) = @_;
323 my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
326 if (length($line) <= $pos) {
328 return ($text, "") unless ($line);
332 my $cur_char = substr($line, $pos, 1);
334 if (!$inside_string) {
335 if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
336 $inside_string = substr($line, $pos + 2, 1);
339 } elsif ((length($line) >= ($pos + 2)) &&
340 (substr($line, $pos, 1) eq "q")) {
341 $inside_string = substr($line, $pos + 1, 1);
344 } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
345 $inside_string = $cur_char;
347 } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
348 return ($text, substr($line, $pos + 1));
356 } elsif ($cur_char eq '\\') {
360 } elsif ($cur_char eq $inside_string) {
361 undef($inside_string);
374 my $dont_include_subs = shift;
375 my $scanned_files = shift;
380 $scanned_files = {} unless ($scanned_files);
381 return if ($scanned_files->{$file});
382 $scanned_files->{$file} = 1;
384 if (!defined $cached{$file}) {
386 return unless (-f "$file");
388 my $fh = new FileHandle;
389 open $fh, "$file" or die "$! : $file";
391 my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
396 # is this another file
397 if (/require\s+\W.*\.pl/) {
399 $newfile =~ s/require\s+\W//;
400 $newfile =~ s|bin/mozilla||;
401 # &scanfile("$bindir/$newfile", 0, $scanned_files);
402 $cached{$file}{scan}{"$bindir/$newfile"} = 1;
403 } elsif (/use\s+SL::(.*?);/) {
406 # &scanfile("../../SL/${1}.pm", 1, $scanned_files);
407 $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
410 # is this a template call?
411 if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
412 my $newfile = "$basedir/templates/webpages/$1.html";
413 if (/parse_html_template2/) {
414 print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
417 # &scanhtmlfile($newfile);
418 $cached{$file}{scanh}{$newfile} = 1;
421 print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
427 next if ($dont_include_subs);
428 my $subrt = (split / +/)[1];
429 # $subrt{$subrt} = 1;
430 $cached{$file}{subr}{$subrt} = 1;
439 my ($null, $country) = split /,/;
440 $country =~ s/^ +[\"\']//;
441 $country =~ s/[\"\'].*//;
447 # is it a submit button before $locale->
448 if (/$submitsearch/) {
450 if ($` !~ /locale->text/) {
452 $sub_line_no = $line_no;
456 my ($found) = /locale->text.*?\(/;
457 my $postmatch = "$'";
461 ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
464 # if there is no $ in the string record it
465 unless (($string =~ /\$\D.*/) || ("" eq $string)) {
467 # this guarantees one instance of string
468 # $locale{$string} = 1;
469 $cached{$file}{locale}{$string} = 1;
471 # this one is for all the locales
472 # $alllocales{$string} = 1;
473 $cached{$file}{all}{$string} = 1;
475 # is it a submit button before $locale->
477 # $submit{$string} = 1;
478 $cached{$file}{submit}{$string} = 1;
481 } elsif ($postmatch =~ />/) {
485 # exit loop if there are no more locales on this line
486 ($rc) = ($postmatch =~ /locale->text/);
488 if ( ($postmatch =~ />/)
489 || (!$found && ($sub_line_no != $line_no) && />/)) {
499 map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
500 map { $locale{$_} = 1 } keys %{$cached{$file}{locale}};
501 map { $submit{$_} = 1 } keys %{$cached{$file}{submit}};
502 map { $subrt{$_} = 1 } keys %{$cached{$file}{subr}};
503 map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
504 map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
505 map { &scanhtmlfile($_) } keys %{$cached{$file}{scanh}};
507 @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
513 my $fh = new FileHandle;
514 open $fh, "$file" or die "$! : $file";
516 my @a = grep m/^\[/, <$fh>;
520 grep { s/(\[|\])//g } @a;
522 foreach my $item (@a) {
523 my @b = split /--/, $item;
524 foreach my $string (@b) {
526 $locale{$string} = 1;
527 $alllocales{$string} = 1;
533 sub unescape_template_string {
544 if (!defined $cached{$file}) {
545 my %plugins = ( 'loaded' => { }, 'needed' => { } );
547 open(IN, $file) || die $file;
552 while (my $line = <IN>) {
555 while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
556 $plugins{loaded}->{$1} = 1;
559 while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
561 $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
564 while ($line =~ m/(?: # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
565 (LxERP\.t8)\( # LxERP.t8( ::Parameter $1::
566 ([\'\"]) # Anfang des zu übersetzenden Strings ::Parameter $2::
567 (.*?) # Der zu übersetzende String ::Parameter $3::
568 (?<!\\)\2 # Ende des zu übersetzenden Strings
569 | # Start von Variante 2: [% '...' | $T8 %]
570 \[\% # Template-Start-Tag
571 [\-~#]* # Whitespace-Unterdrückung
572 \s* # Optional beliebig viele Whitespace
573 ([\'\"]) # Anfang des zu übersetzenden Strings ::Parameter $4::
574 (.*?) # Der zu übersetzende String ::Parameter $5::
575 (?<!\\)\4 # Ende des zu übersetzenden Strings
576 \s*\|\s* # Pipe-Zeichen mit optionalen Whitespace davor und danach
577 (\$T8) # Filteraufruf ::Parameter $6::
578 .*? # Optionale Argumente für den Filter
580 [\-~#]* # Whitespace-Unterdrückung
581 \%\] # Template-Ende-Tag
584 my $module = $1 || $6;
585 my $string = $3 || $5;
586 print "Found filter >>>$string<<<\n" if $debug;
587 substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
589 $string = unescape_template_string($string);
590 $cached{$file}{all}{$string} = 1;
591 $cached{$file}{html}{$string} = 1;
592 $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
593 $plugins{needed}->{T8} = 1 if $module eq '$T8';
594 $plugins{needed}->{LxERP} = 1 if $module eq 'LxERP.t8';
597 while ($line =~ m/\[\% # Template-Start-Tag
598 [\-~#]? # Whitespace-Unterdrückung
599 \s* # Optional beliebig viele Whitespace
600 (?: # Die erkannten Template-Direktiven
605 \s+ # Mindestens ein Whitespace
606 [\'\"]? # Anfang des Dateinamens
607 ([^\s]+) # Beliebig viele Nicht-Whitespaces -- Dateiname
608 \.html # Endung ".html", ansonsten kann es der Name eines Blocks sein
610 my $new_file_name = "$basedir/templates/webpages/$1.html";
611 $cached{$file}{scanh}{$new_file_name} = 1;
612 substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
618 foreach my $plugin (keys %{ $plugins{needed} }) {
619 next if ($plugins{loaded}->{$plugin});
620 print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
624 # copy back into global arrays
625 map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
626 map { $htmllocale{$_} = 1 } keys %{$cached{$file}{html}};
627 map { $submit{$_} = 1 } keys %{$cached{$file}{submit}};
629 map { scanhtmlfile($_) } keys %{$cached{$file}{scanh}};
631 @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
634 sub search_unused_htmlfiles {
635 my @unscanned_dirs = ('../../templates/webpages');
637 while (scalar @unscanned_dirs) {
638 my $dir = shift @unscanned_dirs;
640 foreach my $entry (<$dir/*>) {
642 push @unscanned_dirs, $entry;
644 } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
645 print "W: unused HTML template: " . strip_base($entry) . "\n";
653 my $s = "$_[0]"; # Create a copy of the string.
656 $s =~ s|templates/webpages/||;
665 locales.pl - Collect strings for translation in Lx-Office
672 -n, --no-custom-files Do not process files whose name contains "_"
673 -c, --check-files Run extended checks on HTML files
674 -v, --verbose Be more verbose
675 -h, --help Show this help
681 =item B<-n>, B<--no-custom-files>
683 Do not process files whose name contains "_", e.g. "custom_io.pl".
685 =item B<-c>, B<--check-files>
687 Run extended checks on the usage of templates. This can be used to
688 discover HTML templates that are never used as well as the usage of
689 non-existing HTML templates.
691 =item B<-v>, B<--verbose>
699 This script collects strings from Perl files, the menu.ini file and
700 HTML templates and puts them into the file "all" for translation. It
701 also distributes those translations back to the individual files.