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