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