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