locale/de/locales.pl

   1 #!/usr/bin/perl
   2
   3 # -n do not include custom_ scripts
   4 # -v verbose mode, shows progress stuff
   5
   6 # this version of locles processes not only all required .pl files
   7 # but also all parse_html_templated files.
   8
   9 use strict;
  10
  11 use Data::Dumper;
  12 use English;
  13 use FileHandle;
  14 use Getopt::Long;
  15 use List::Util qw(first);
  16 use POSIX;
  17 use Pod::Usage;
  18
  19 $OUTPUT_AUTOFLUSH = 1;
  20
  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;
  27
  28 my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit, %subrt);
  29
  30 my $count  = 0;
  31 my $notext = 0;
  32
  33 my $debug  = 0;
  34
  35 my $opt_v  = 0;
  36 my $opt_n  = 0;
  37 my $opt_c  = 0;
  38
  39 sub parse_args {
  40   my ($help, $man);
  41
  42   GetOptions('no-custom-files' => \$opt_n,
  43              'check-files'     => \$opt_c,
  44              'verbose'         => \$opt_v,
  45              'help'            => \$help,
  46              'man'             => \$man,);
  47
  48   if ($help) {
  49     pod2usage(1);
  50     exit 0;
  51   }
  52
  53   if ($man) {
  54     pod2usage(-exitstatus => 0, -verbose => 2);
  55     exit 0;
  56   }
  57 }
  58
  59 parse_args();
  60
  61 opendir DIR, "$bindir" or die "$!";
  62 my @progfiles = grep { /\.pl$/ && !/(_custom|^\.)/ } readdir DIR;
  63 seekdir DIR, 0;
  64 my @customfiles = grep /_custom/, readdir DIR;
  65 closedir DIR;
  66
  67 # put customized files into @customfiles
  68 my @menufiles;
  69
  70 if ($opt_n) {
  71   @customfiles = ();
  72   @menufiles   = ($menufile);
  73 } else {
  74   opendir DIR, "$basedir" or die "$!";
  75   @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
  76   closedir DIR;
  77   unshift @menufiles, $menufile;
  78 }
  79
  80 opendir DIR, $dbupdir or die "$!";
  81 my @dbplfiles = grep { /\.pl$/ } readdir DIR;
  82 closedir DIR;
  83
  84 opendir DIR, $dbupdir2 or die "$!";
  85 my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
  86 closedir DIR;
  87
  88 # slurp the translations in
  89 our $self    = {};
  90 our $missing = {};
  91 our @missing = ();
  92 our @lost    = ();
  93
  94 if (-f 'all') {
  95   require 'all';
  96 }
  97 if (-f 'missing') {
  98   require 'missing' ;
  99   unlink 'missing';
 100 }
 101 if (-f 'lost') {
 102   require 'lost';
 103   unlink 'lost';
 104 }
 105
 106 my %old_texts = %{ $self->{texts} || {} };
 107
 108 # Read HTML templates.
 109 #%htmllocale = ();
 110 #@htmltemplates = <../../templates/webpages/*/*_master.html>;
 111 #foreach $file (@htmltemplates) {
 112 #  scanhtmlfile($file);
 113 #}
 114
 115 map({ handle_file($_, $bindir); } @progfiles);
 116 map({ handle_file($_, $dbupdir); } @dbplfiles);
 117 map({ handle_file($_, $dbupdir2); } @dbplfiles2);
 118
 119 sub handle_file {
 120   my ($file, $dir) = @_;
 121   print "\n$file" if $opt_v;
 122   %locale = ();
 123   %submit = ();
 124   %subrt  = ();
 125
 126   &scanfile("$dir/$file");
 127
 128   # scan custom_{module}.pl or {login}_{module}.pl files
 129   foreach my $customfile (@customfiles) {
 130     if ($customfile =~ /_$file/) {
 131       if (-f "$dir/$customfile") {
 132         &scanfile("$dir/$customfile");
 133       }
 134     }
 135   }
 136
 137   # if this is the menu.pl file
 138   if ($file eq 'menu.pl') {
 139     foreach my $item (@menufiles) {
 140       &scanmenu("$basedir/$item");
 141     }
 142   }
 143
 144   if ($file eq 'menunew.pl') {
 145     foreach my $item (@menufiles) {
 146       &scanmenu("$basedir/$item");
 147       print "." if $opt_v;
 148     }
 149   }
 150
 151   $file =~ s/\.pl//;
 152
 153   foreach my $text (keys %$missing) {
 154     if ($locale{$text} || $htmllocale{$text}) {
 155       unless ($self->{texts}{$text}) {
 156         $self->{texts}{$text} = $missing->{$text};
 157       }
 158     }
 159   }
 160
 161   open FH, ">$file" or die "$! : $file";
 162
 163   print FH q|#!/usr/bin/perl
 164
 165 $self->{texts} = {
 166 |;
 167
 168   foreach my $key (sort keys %locale) {
 169     my $text    =  $self->{texts}{$key} || $key;
 170     $text       =~ s/'/\\'/g;
 171     $text       =~ s/\\$/\\\\/;
 172
 173     my $keytext =  $key;
 174     $keytext    =~ s/'/\\'/g;
 175     $keytext    =~ s/\\$/\\\\/;
 176
 177     print FH qq|  '$keytext'|
 178       . (' ' x (27 - length($keytext)))
 179       . qq| => '$text',\n|;
 180   }
 181
 182   print FH q|};
 183
 184 $self->{subs} = {
 185 |;
 186
 187   foreach my $key (sort keys %subrt) {
 188     my $text =  $key;
 189     $text    =~ s/'/\\'/g;
 190     $text    =~ s/\\$/\\\\/;
 191     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
 192   }
 193
 194   foreach my $key (sort keys %submit) {
 195     my $text           =  ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
 196     $text              =~ s/'/\\'/g;
 197     $text              =~ s/\\$/\\\\/;
 198
 199     my $english_sub    =  $key;
 200     $english_sub       =~ s/'/\\'/g;
 201     $english_sub       =~ s/\\$/\\\\/;
 202     $english_sub       = lc $key;
 203
 204     my $translated_sub =  lc $text;
 205     $english_sub       =~ s/( |-|,)/_/g;
 206     $translated_sub    =~ s/( |-|,)/_/g;
 207     print FH qq|  '$translated_sub'|
 208       . (' ' x (27 - length($translated_sub)))
 209       . qq| => '$english_sub',\n|;
 210   }
 211
 212   print FH q|};
 213
 214 1;
 215 |;
 216
 217   close FH;
 218
 219 }
 220
 221 #foreach $file (@htmltemplates) {
 222 #  converthtmlfile($file);
 223 #}
 224
 225 # now print out all
 226
 227 open FH, ">all" or die "$! : all";
 228
 229 print FH q|#!/usr/bin/perl
 230
 231 # These are all the texts to build the translations files.
 232 # The file has the form of 'english text'  => 'foreign text',
 233 # you can add the translation in this file or in the 'missing' file
 234 # run locales.pl from this directory to rebuild the translation files
 235
 236 $self->{texts} = {
 237 |;
 238
 239 foreach my $key (sort keys %alllocales) {
 240   my $text = $self->{texts}{$key};
 241
 242   $count++;
 243
 244   $text =~ s/'/\\'/g;
 245   $text =~ s/\\$/\\\\/;
 246   $key  =~ s/'/\\'/g;
 247   $key  =~ s/\\$/\\\\/;
 248
 249   unless ($text) {
 250     $notext++;
 251     push @missing, $key;
 252   }
 253
 254   print FH qq|  '$key'| . (' ' x (27 - length($key))) . qq| => '$text',\n|;
 255
 256 }
 257
 258 print FH q|};
 259
 260 1;
 261 |;
 262
 263 close FH;
 264
 265 if (@missing) {
 266   open FH, ">missing" or die "$! : missing";
 267
 268   print FH q|#!/usr/bin/perl
 269
 270 # add the missing texts and run locales.pl to rebuild
 271
 272 $missing = {
 273 |;
 274
 275   foreach my $text (@missing) {
 276     print FH qq|  '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
 277   }
 278
 279   print FH q|};
 280
 281 1;
 282 |;
 283
 284   close FH;
 285
 286 }
 287
 288 while (my ($text, $translation) = each %old_texts) {
 289   next if ($alllocales{$text});
 290
 291   push @lost, { 'text' => $text, 'translation' => $translation };
 292 }
 293
 294 if (scalar @lost) {
 295   splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
 296
 297   open FH, ">lost";
 298   print FH "#!/usr/bin/perl\n\n" .
 299     "# The last 50 texts that have been removed.\n" .
 300     "# This file will be auto-generated by locales.pl. Do not edit it.\n\n" .
 301     "\@lost = (\n";
 302
 303   foreach my $entry (@lost) {
 304     $entry->{text}        =~ s/\'/\\\'/g;
 305     $entry->{translation} =~ s/\'/\\\'/g;
 306     print FH "  { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
 307   }
 308
 309   print FH ");\n\n1;\n";
 310   close FH;
 311 }
 312
 313 open(FH, "LANGUAGE");
 314 my @language = <FH>;
 315 close(FH);
 316 my $trlanguage = $language[0];
 317 chomp $trlanguage;
 318
 319 if ($opt_c) {
 320   search_unused_htmlfiles();
 321   search_translated_htmlfiles_wo_master();
 322 }
 323
 324 my $per = sprintf("%.1f", ($count - $notext) / $count * 100);
 325 print "\n$trlanguage - ${per}%";
 326 print " - $notext/$count missing" if $notext;
 327 print "\n";
 328
 329 exit;
 330
 331 # eom
 332
 333 sub extract_text_between_parenthesis {
 334   my ($fh, $line) = @_;
 335   my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
 336
 337   while (1) {
 338     if (length($line) <= $pos) {
 339       $line = <$fh>;
 340       return ($text, "") unless ($line);
 341       $pos = 0;
 342     }
 343
 344     my $cur_char = substr($line, $pos, 1);
 345
 346     if (!$inside_string) {
 347       if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
 348         $inside_string = substr($line, $pos + 2, 1);
 349         $pos += 2;
 350
 351       } elsif ((length($line) >= ($pos + 2)) &&
 352                (substr($line, $pos, 1) eq "q")) {
 353         $inside_string = substr($line, $pos + 1, 1);
 354         $pos++;
 355
 356       } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
 357         $inside_string = $cur_char;
 358
 359       } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
 360         return ($text, substr($line, $pos + 1));
 361       }
 362
 363     } else {
 364       if ($quote_next) {
 365         $text .= $cur_char;
 366         $quote_next = 0;
 367
 368       } elsif ($cur_char eq '\\') {
 369         $text .= $cur_char;
 370         $quote_next = 1;
 371
 372       } elsif ($cur_char eq $inside_string) {
 373         undef($inside_string);
 374
 375       } else {
 376         $text .= $cur_char;
 377
 378       }
 379     }
 380     $pos++;
 381   }
 382 }
 383
 384 sub scanfile {
 385   my $file = shift;
 386   my $dont_include_subs = shift;
 387   my $scanned_files = shift;
 388
 389   # sanitize file
 390   $file =~ s=/+=/=g;
 391
 392   $scanned_files = {} unless ($scanned_files);
 393   return if ($scanned_files->{$file});
 394   $scanned_files->{$file} = 1;
 395
 396   if (!defined $cached{$file}) {
 397
 398     return unless (-f "$file");
 399
 400     my $fh = new FileHandle;
 401     open $fh, "$file" or die "$! : $file";
 402
 403     my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
 404
 405     while (<$fh>) {
 406       $line_no++;
 407
 408       # is this another file
 409       if (/require\s+\W.*\.pl/) {
 410         my $newfile = $&;
 411         $newfile =~ s/require\s+\W//;
 412         $newfile =~ s|bin/mozilla||;
 413 #         &scanfile("$bindir/$newfile", 0, $scanned_files);
 414          $cached{$file}{scan}{"$bindir/$newfile"} = 1;
 415       } elsif (/use\s+SL::(.*?);/) {
 416         my $module =  $1;
 417         $module    =~ s|::|/|g;
 418 #         &scanfile("../../SL/${1}.pm", 1, $scanned_files);
 419         $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
 420       }
 421
 422       # is this a template call?
 423       if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
 424         my $newfile = "$basedir/templates/webpages/$1_master.html";
 425         if (/parse_html_template2/) {
 426           print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
 427         }
 428         if (-f $newfile) {
 429 #           &scanhtmlfile($newfile);
 430 #           &converthtmlfile($newfile);
 431            $cached{$file}{scanh}{$newfile} = 1;
 432           print "." if $opt_v;
 433         } elsif ($opt_c) {
 434           print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
 435         }
 436       }
 437
 438       # is this a sub ?
 439       if (/^sub /) {
 440         next if ($dont_include_subs);
 441         my $subrt = (split / +/)[1];
 442 #        $subrt{$subrt} = 1;
 443         $cached{$file}{subr}{$subrt} = 1;
 444         next;
 445       }
 446
 447       my $rc = 1;
 448
 449       while ($rc) {
 450         if (/Locale/) {
 451           unless (/^use /) {
 452             my ($null, $country) = split /,/;
 453             $country =~ s/^ +[\"\']//;
 454             $country =~ s/[\"\'].*//;
 455           }
 456         }
 457
 458         my $postmatch = "";
 459
 460         # is it a submit button before $locale->
 461         if (/$submitsearch/) {
 462           $postmatch = "$'";
 463           if ($` !~ /locale->text/) {
 464             $is_submit   = 1;
 465             $sub_line_no = $line_no;
 466           }
 467         }
 468
 469         my ($found) = /locale->text.*?\(/;
 470         my $postmatch = "$'";
 471
 472         if ($found) {
 473           my $string;
 474           ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
 475           $postmatch = $_;
 476
 477           # if there is no $ in the string record it
 478           unless (($string =~ /\$\D.*/) || ("" eq $string)) {
 479
 480             # this guarantees one instance of string
 481 #            $locale{$string} = 1;
 482             $cached{$file}{locale}{$string} = 1;
 483
 484             # this one is for all the locales
 485 #            $alllocales{$string} = 1;
 486             $cached{$file}{all}{$string} = 1;
 487
 488             # is it a submit button before $locale->
 489             if ($is_submit) {
 490 #              $submit{$string} = 1;
 491               $cached{$file}{submit}{$string} = 1;
 492             }
 493           }
 494         } elsif ($postmatch =~ />/) {
 495           $is_submit = 0;
 496         }
 497
 498         # exit loop if there are no more locales on this line
 499         ($rc) = ($postmatch =~ /locale->text/);
 500
 501         if (   ($postmatch =~ />/)
 502             || (!$found && ($sub_line_no != $line_no) && />/)) {
 503           $is_submit = 0;
 504         }
 505       }
 506     }
 507
 508     close($fh);
 509
 510   }
 511
 512   map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
 513   map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
 514   map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
 515   map { $subrt{$_} = 1 }        keys %{$cached{$file}{subr}};
 516   map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
 517   map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
 518   map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
 519
 520   @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
 521 }
 522
 523 sub scanmenu {
 524   my $file = shift;
 525
 526   my $fh = new FileHandle;
 527   open $fh, "$file" or die "$! : $file";
 528
 529   my @a = grep m/^\[/, <$fh>;
 530   close($fh);
 531
 532   # strip []
 533   grep { s/(\[|\])//g } @a;
 534
 535   foreach my $item (@a) {
 536     my @b = split /--/, $item;
 537     foreach my $string (@b) {
 538       chomp $string;
 539       $locale{$string}     = 1;
 540       $alllocales{$string} = 1;
 541     }
 542   }
 543
 544 }
 545
 546 sub scanhtmlfile {
 547   local *IN;
 548
 549   if (!defined $cached{$_[0]}) {
 550     my %plugins = ( 'loaded' => { }, 'needed' => { } );
 551
 552     open(IN, $_[0]) || die $_[0];
 553
 554     my $copying  = 0;
 555     my $issubmit = 0;
 556     my $text     = "";
 557     while (my $line = <IN>) {
 558       chomp($line);
 559
 560       while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
 561         $plugins{loaded}->{$1} = 1;
 562       }
 563
 564       while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
 565         my $plugin = $1;
 566         $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
 567       }
 568
 569       while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
 570                           (LxERP\.t8)\( #   LxERP.t8(
 571                           [\'\"]        #   Anfang des zu übersetzenden Strings
 572                           (.*?)         #   Der zu übersetzende String
 573                           [\'\"]        #   Ende des zu übersetzenden Strings
 574                         |               # Start von Variante 2: [% '...' | $T8 %]
 575                           \[\%          #   Template-Start-Tag
 576                           [\-~#]*       #   Whitespace-Unterdrückung
 577                           \s*           #   Optional beliebig viele Whitespace
 578                           [\'\"]        #   Anfang des zu übersetzenden Strings
 579                           (.*?)         #   Der zu übersetzende String
 580                           [\'\"]        #   Ende des zu übersetzenden Strings
 581                           \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
 582                           (\$T8)        #   Filteraufruf
 583                           .*?           #   Optionale Argumente für den Filter
 584                           \s*           #   Whitespaces
 585                           [\-~#]*       #   Whitespace-Unterdrückung
 586                           \%\]          #   Template-Ende-Tag
 587                         )
 588                        /ix) {
 589         my $module = $1 || $4;
 590         my $string = $2 || $3;
 591         print "Found filter >>>$string<<<\n" if $debug;
 592         substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 593
 594         $cached{$_[0]}{all}{$string}    = 1;
 595         $cached{$_[0]}{html}{$string}   = 1;
 596         $cached{$_[0]}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
 597         $plugins{needed}->{T8}          = 1 if $module eq '$T8';
 598       }
 599
 600       while ("" ne $line) {
 601         if (!$copying) {
 602           if ($line =~ m|<translate>|i) {
 603             my $eom = $+[0];
 604             if ($` =~ /$submitsearch/) {
 605               $issubmit = 1
 606             }
 607             substr($line, 0, $eom) = "";
 608             $copying = 1;
 609           } else {
 610             $line = "";
 611           }
 612
 613         } else {
 614           if ($line =~ m|</translate>|i) {
 615             $text .= $`;
 616             substr($line, 0, $+[0]) = "";
 617             $text =~ s/\s+/ /g;
 618
 619             $copying = 0;
 620             if ($issubmit) {
 621   #            $submit{$text} = 1;
 622                $cached{$_[0]}{submit}{$text} = 1;
 623               $issubmit = 0;
 624             }
 625   #          $alllocales{$text} = 1;
 626              $cached{$_[0]}{all}{$text} = 1;
 627   #          $htmllocale{$text} = 1;
 628              $cached{$_[0]}{html}{$text} = 1;
 629             $text = "";
 630
 631           } else {
 632             $text .= $line;
 633             $line = "";
 634           }
 635         }
 636       }
 637     }
 638
 639     close(IN);
 640
 641     foreach my $plugin (keys %{ $plugins{needed} }) {
 642       next if ($plugins{loaded}->{$plugin});
 643       print "E: " . strip_base($_[0]) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
 644     }
 645
 646     &converthtmlfile($_[0]);
 647   }
 648
 649   # copy back into global arrays
 650   map { $alllocales{$_} = 1 } keys %{$cached{$_[0]}{all}};
 651   map { $htmllocale{$_} = 1 } keys %{$cached{$_[0]}{html}};
 652   map { $submit{$_} = 1 }     keys %{$cached{$_[0]}{submit}};
 653 }
 654
 655 sub converthtmlfile {
 656   local *IN;
 657   local *OUT;
 658
 659   my $file = shift;
 660
 661   open(IN, $file) || die;
 662
 663   my $langcode = (split("/", getcwd()))[-1];
 664   $file =~ s/_master.html$/_${langcode}.html/;
 665
 666   open(OUT, ">$file") || die;
 667
 668   my $copying = 0;
 669   my $text = "";
 670   while (my $line = <IN>) {
 671     chomp($line);
 672     if ("" eq $line) {
 673       print(OUT "\n");
 674       next;
 675     }
 676
 677     while ("" ne $line) {
 678       if (!$copying) {
 679         if ($line =~ m|<translate>|i) {
 680           print(OUT $`);
 681           substr($line, 0, $+[0]) = "";
 682           $copying = 1;
 683           print(OUT "\n") if ("" eq $line);
 684
 685         } else {
 686           print(OUT "${line}\n");
 687           $line = "";
 688         }
 689
 690       } else {
 691         if ($line =~ m|</translate>|i) {
 692           $text .= $`;
 693           substr($line, 0, $+[0]) = "";
 694           $text =~ s/\s+/ /g;
 695           $copying = 0;
 696           $alllocales{$text} = 1;
 697           $htmllocale{$text} = 1;
 698           print(OUT $self->{"texts"}{$text} || $text);
 699           print(OUT "\n") if ("" eq $line);
 700           $text = "";
 701
 702         } else {
 703           $text .= $line;
 704           $line = "";
 705         }
 706       }
 707     }
 708   }
 709
 710   close(IN);
 711   close(OUT);
 712 }
 713
 714 sub search_unused_htmlfiles {
 715   my @unscanned_dirs = ('../../templates/webpages');
 716
 717   while (scalar @unscanned_dirs) {
 718     my $dir = shift @unscanned_dirs;
 719
 720     foreach my $entry (<$dir/*>) {
 721       if (-d $entry) {
 722         push @unscanned_dirs, $entry;
 723
 724       } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
 725         print "W: unused HTML template: " . strip_base($entry) . "\n";
 726
 727       }
 728     }
 729   }
 730 }
 731
 732 sub search_translated_htmlfiles_wo_master {
 733   my @unscanned_dirs = ('../../templates/webpages');
 734
 735   while (scalar @unscanned_dirs) {
 736     my $dir = shift @unscanned_dirs;
 737
 738     foreach my $entry (<$dir/*>) {
 739       if (-d $entry) {
 740         push @unscanned_dirs, $entry;
 741
 742       } elsif (($entry =~ /_[a-z]+\.html$/) && ($entry !~ /_master.html$/) && -f $entry) {
 743         my $master =  $entry;
 744         $master    =~ s/[a-z]+\.html$/master.html/;
 745         if (! -f $master) {
 746           print "W: translated HTML template without master: " . strip_base($entry) . "\n";
 747         }
 748       }
 749     }
 750   }
 751 }
 752
 753 sub strip_base {
 754   my $s =  "$_[0]";             # Create a copy of the string.
 755
 756   $s    =~ s|^../../||;
 757   $s    =~ s|templates/webpages/||;
 758
 759   return $s;
 760 }
 761
 762 __END__
 763
 764 =head1 NAME
 765
 766 locales.pl - Collect strings for translation in Lx-Office
 767
 768 =head1 SYNOPSIS
 769
 770 locales.pl [options]
 771
 772  Options:
 773   -n, --no-custom-files  Do not process files whose name contains "_"
 774   -c, --check-files      Run extended checks on HTML files
 775   -v, --verbose          Be more verbose
 776   -h, --help             Show this help
 777
 778 =head1 OPTIONS
 779
 780 =over 8
 781
 782 =item B<-n>, B<--no-custom-files>
 783
 784 Do not process files whose name contains "_", e.g. "custom_io.pl".
 785
 786 =item B<-c>, B<--check-files>
 787
 788 Run extended checks on the usage of templates. This can be used to
 789 discover HTML templates that are never used as well as the usage of
 790 non-existing HTML templates.
 791
 792 =item B<-v>, B<--verbose>
 793
 794 Be more verbose.
 795
 796 =back
 797
 798 =head1 DESCRIPTION
 799
 800 This script collects strings from Perl files, the menu.ini file and
 801 HTML templates and puts them into the file "all" for translation.  It
 802 also distributes those translations back to the individual files.
 803
 804 =cut