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