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 $string = $1 || $2;
 590         print "Found filter >>>$string<<<\n" if $debug;
 591         substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 592
 593         $cached{$_[0]}{all}{$string}    = 1;
 594         $cached{$_[0]}{html}{$string}   = 1;
 595         $cached{$_[0]}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
 596         $plugins{needed}->{T8}          = 1;
 597       }
 598
 599       while ("" ne $line) {
 600         if (!$copying) {
 601           if ($line =~ m|<translate>|i) {
 602             my $eom = $+[0];
 603             if ($` =~ /$submitsearch/) {
 604               $issubmit = 1
 605             }
 606             substr($line, 0, $eom) = "";
 607             $copying = 1;
 608           } else {
 609             $line = "";
 610           }
 611
 612         } else {
 613           if ($line =~ m|</translate>|i) {
 614             $text .= $`;
 615             substr($line, 0, $+[0]) = "";
 616             $text =~ s/\s+/ /g;
 617
 618             $copying = 0;
 619             if ($issubmit) {
 620   #            $submit{$text} = 1;
 621                $cached{$_[0]}{submit}{$text} = 1;
 622               $issubmit = 0;
 623             }
 624   #          $alllocales{$text} = 1;
 625              $cached{$_[0]}{all}{$text} = 1;
 626   #          $htmllocale{$text} = 1;
 627              $cached{$_[0]}{html}{$text} = 1;
 628             $text = "";
 629
 630           } else {
 631             $text .= $line;
 632             $line = "";
 633           }
 634         }
 635       }
 636     }
 637
 638     close(IN);
 639
 640     foreach my $plugin (keys %{ $plugins{needed} }) {
 641       next if ($plugins{loaded}->{$plugin});
 642       print "E: " . strip_base($_[0]) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
 643     }
 644
 645     &converthtmlfile($_[0]);
 646   }
 647
 648   # copy back into global arrays
 649   map { $alllocales{$_} = 1 } keys %{$cached{$_[0]}{all}};
 650   map { $htmllocale{$_} = 1 } keys %{$cached{$_[0]}{html}};
 651   map { $submit{$_} = 1 }     keys %{$cached{$_[0]}{submit}};
 652 }
 653
 654 sub converthtmlfile {
 655   local *IN;
 656   local *OUT;
 657
 658   my $file = shift;
 659
 660   open(IN, $file) || die;
 661
 662   my $langcode = (split("/", getcwd()))[-1];
 663   $file =~ s/_master.html$/_${langcode}.html/;
 664
 665   open(OUT, ">$file") || die;
 666
 667   my $copying = 0;
 668   my $text = "";
 669   while (my $line = <IN>) {
 670     chomp($line);
 671     if ("" eq $line) {
 672       print(OUT "\n");
 673       next;
 674     }
 675
 676     while ("" ne $line) {
 677       if (!$copying) {
 678         if ($line =~ m|<translate>|i) {
 679           print(OUT $`);
 680           substr($line, 0, $+[0]) = "";
 681           $copying = 1;
 682           print(OUT "\n") if ("" eq $line);
 683
 684         } else {
 685           print(OUT "${line}\n");
 686           $line = "";
 687         }
 688
 689       } else {
 690         if ($line =~ m|</translate>|i) {
 691           $text .= $`;
 692           substr($line, 0, $+[0]) = "";
 693           $text =~ s/\s+/ /g;
 694           $copying = 0;
 695           $alllocales{$text} = 1;
 696           $htmllocale{$text} = 1;
 697           print(OUT $self->{"texts"}{$text} || $text);
 698           print(OUT "\n") if ("" eq $line);
 699           $text = "";
 700
 701         } else {
 702           $text .= $line;
 703           $line = "";
 704         }
 705       }
 706     }
 707   }
 708
 709   close(IN);
 710   close(OUT);
 711 }
 712
 713 sub search_unused_htmlfiles {
 714   my @unscanned_dirs = ('../../templates/webpages');
 715
 716   while (scalar @unscanned_dirs) {
 717     my $dir = shift @unscanned_dirs;
 718
 719     foreach my $entry (<$dir/*>) {
 720       if (-d $entry) {
 721         push @unscanned_dirs, $entry;
 722
 723       } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
 724         print "W: unused HTML template: " . strip_base($entry) . "\n";
 725
 726       }
 727     }
 728   }
 729 }
 730
 731 sub search_translated_htmlfiles_wo_master {
 732   my @unscanned_dirs = ('../../templates/webpages');
 733
 734   while (scalar @unscanned_dirs) {
 735     my $dir = shift @unscanned_dirs;
 736
 737     foreach my $entry (<$dir/*>) {
 738       if (-d $entry) {
 739         push @unscanned_dirs, $entry;
 740
 741       } elsif (($entry =~ /_[a-z]+\.html$/) && ($entry !~ /_master.html$/) && -f $entry) {
 742         my $master =  $entry;
 743         $master    =~ s/[a-z]+\.html$/master.html/;
 744         if (! -f $master) {
 745           print "W: translated HTML template without master: " . strip_base($entry) . "\n";
 746         }
 747       }
 748     }
 749   }
 750 }
 751
 752 sub strip_base {
 753   my $s =  "$_[0]";             # Create a copy of the string.
 754
 755   $s    =~ s|^../../||;
 756   $s    =~ s|templates/webpages/||;
 757
 758   return $s;
 759 }
 760
 761 __END__
 762
 763 =head1 NAME
 764
 765 locales.pl - Collect strings for translation in Lx-Office
 766
 767 =head1 SYNOPSIS
 768
 769 locales.pl [options]
 770
 771  Options:
 772   -n, --no-custom-files  Do not process files whose name contains "_"
 773   -c, --check-files      Run extended checks on HTML files
 774   -v, --verbose          Be more verbose
 775   -h, --help             Show this help
 776
 777 =head1 OPTIONS
 778
 779 =over 8
 780
 781 =item B<-n>, B<--no-custom-files>
 782
 783 Do not process files whose name contains "_", e.g. "custom_io.pl".
 784
 785 =item B<-c>, B<--check-files>
 786
 787 Run extended checks on the usage of templates. This can be used to
 788 discover HTML templates that are never used as well as the usage of
 789 non-existing HTML templates.
 790
 791 =item B<-v>, B<--verbose>
 792
 793 Be more verbose.
 794
 795 =back
 796
 797 =head1 DESCRIPTION
 798
 799 This script collects strings from Perl files, the menu.ini file and
 800 HTML templates and puts them into the file "all" for translation.  It
 801 also distributes those translations back to the individual files.
 802
 803 =cut