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 use YAML ();
  29 use YAML::Loader (); # YAML tries to load Y:L at runtime, but can't find it after we chdir'ed
  30 use SL::DBUpgrade2;
  31
  32 $OUTPUT_AUTOFLUSH = 1;
  33
  34 my $opt_v  = 0;
  35 my $opt_n  = 0;
  36 my $opt_c  = 0;
  37 my $opt_f  = 0;
  38 my $debug  = 0;
  39
  40 parse_args();
  41
  42 my $locale;
  43 my $basedir      = "../..";
  44 my $locales_dir  = ".";
  45 my $bindir       = "$basedir/bin/mozilla";
  46 my @progdirs     = ( "$basedir/SL" );
  47 my @menufiles    = glob("${basedir}/menus/*/*");
  48 my @javascript_dirs = ($basedir .'/js', $basedir .'/templates/webpages');
  49 my $javascript_output_dir = $basedir .'/js';
  50 my $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
  51 our $self        = {};
  52 our $missing     = {};
  53 our @lost        = ();
  54
  55 my %ignore_unused_templates = (
  56   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
  57                      failed_background_jobs_report/email.txt)
  58 );
  59
  60 my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit, %jslocale);
  61 my ($ALL_HEADER, $MISSING_HEADER, $LOST_HEADER);
  62
  63 init();
  64
  65 sub find_files {
  66   my ($top_dir_name) = @_;
  67
  68   my (@files, $finder);
  69
  70   $finder = sub {
  71     my ($dir_name) = @_;
  72
  73     tie my %dir_h, 'IO::Dir', $dir_name;
  74
  75     push @files,   grep { -f } map { "${dir_name}/${_}" }                       keys %dir_h;
  76     my @sub_dirs = grep { -d } map { "${dir_name}/${_}" } grep { ! m/^\.\.?$/ } keys %dir_h;
  77
  78     $finder->($_) for @sub_dirs;
  79   };
  80
  81   $finder->($top_dir_name);
  82
  83   return @files;
  84 }
  85
  86 sub merge_texts {
  87 # overwrite existing entries with the ones from 'missing'
  88   $self->{texts}->{$_} = $missing->{$_} for grep { $missing->{$_} } keys %alllocales;
  89
  90   # try to set missing entries from lost ones
  91   my %lost_by_text = map { ($_->{text} => $_->{translation}) } @lost;
  92   $self->{texts}->{$_} = $lost_by_text{$_} for grep { !$self->{texts}{$_} } keys %alllocales;
  93 }
  94
  95 my @bindir_files = find_files($bindir);
  96 my @progfiles    = map { m:^(.+)/([^/]+)$:; [ $2, $1 ]  } grep { /\.pl$/ && !/_custom/ } @bindir_files;
  97 my @customfiles  = grep /_custom/, @bindir_files;
  98
  99 push @progfiles, map { m:^(.+)/([^/]+)$:; [ $2, $1 ] } grep { /\.pm$/ } map { find_files($_) } @progdirs;
 100
 101 # put customized files into @customfiles
 102 my %dir_h;
 103
 104 my @dbplfiles;
 105 foreach my $sub_dir ("Pg-upgrade2", "Pg-upgrade2-auth") {
 106   my $dir = "$basedir/sql/$sub_dir";
 107   tie %dir_h, 'IO::Dir', $dir;
 108   push @dbplfiles, map { [ $_, $dir ] } grep { /\.pl$/ } keys %dir_h;
 109 }
 110
 111 # slurp the translations in
 112 if (-f "$locales_dir/all") {
 113   require "$locales_dir/all";
 114 }
 115 if (-f "$locales_dir/missing") {
 116   require "$locales_dir/missing" ;
 117   unlink "$locales_dir/missing";
 118 }
 119 if (-f "$locales_dir/lost") {
 120   require "$locales_dir/lost";
 121   unlink "$locales_dir/lost";
 122 }
 123
 124 my %old_texts = %{ $self->{texts} || {} };
 125
 126 handle_file(@{ $_ })       for @progfiles;
 127 handle_file(@{ $_ })       for @dbplfiles;
 128 scanmenu($_)               for @menufiles;
 129 scandbupgrades();
 130
 131 for my $file_name (grep { /\.(?:js|html)$/i } map({find_files($_)} @javascript_dirs)) {
 132   scan_javascript_file($file_name);
 133 }
 134
 135 # merge entries to translate with entries from files 'missing' and 'lost'
 136 merge_texts();
 137
 138 # generate all
 139 generate_file(
 140   file      => "$locales_dir/all",
 141   header    => $ALL_HEADER,
 142   data_name => '$self->{texts}',
 143   data_sub  => sub { _print_line($_, $self->{texts}{$_}, @_) for sort keys %alllocales },
 144 );
 145
 146 open(my $js_file, '>:encoding(utf8)', $javascript_output_dir .'/locale/'. $locale .'.js') || die;
 147 print $js_file 'namespace("kivi").setupLocale({';
 148 my $first_entry = 1;
 149 for my $key (sort(keys(%jslocale))) {
 150   print $js_file ((!$first_entry ? ',' : '') ."\n". _double_quote($key) .':'. _double_quote($self->{texts}{$key}));
 151   $first_entry = 0;
 152 }
 153 print $js_file ("\n");
 154 print $js_file ('});'."\n");
 155 close($js_file);
 156
 157   foreach my $text (keys %$missing) {
 158     if ($locale{$text} || $htmllocale{$text}) {
 159       unless ($self->{texts}{$text}) {
 160         $self->{texts}{$text} = $missing->{$text};
 161       }
 162     }
 163   }
 164
 165
 166 # calc and generate missing
 167 my @new_missing = grep { !$self->{texts}{$_} } sort keys %alllocales;
 168
 169 if (@new_missing) {
 170   if ($opt_c) {
 171     my %existing_lc = map { (lc $_ => $_) } grep { $self->{texts}->{$_} } keys %{ $self->{texts} };
 172     foreach my $entry (@new_missing) {
 173       my $other = $existing_lc{lc $entry};
 174       print "W: No entry for '${entry}' exists, but there is one with different case: '${other}'\n" if $other;
 175     }
 176   }
 177
 178   if ($opt_f) {
 179     for my $string (@new_missing) {
 180       print "new string '$string' in files:\n";
 181       print join "",
 182         map   { "  $_\n"                  }
 183         apply { s{^(?:\.\./)+}{}          }
 184         grep  { $cached{$_}{all}{$string} }
 185         keys  %cached;
 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 $menu = YAML::LoadFile($file);
 521
 522   for my $node (@$menu) {
 523     # possible for override files
 524     next unless exists $node->{name};
 525
 526     $locale{$node->{name}}     = 1;
 527     $alllocales{$node->{name}} = 1;
 528     $cached{$file}{all}{$node->{name}} = 1;
 529   }
 530 }
 531
 532 sub scandbupgrades {
 533   # we only need to do this for auth atm, because only auth scripts can include new rights, which are translateable
 534   my $auth = 1;
 535
 536   my $dbu = SL::DBUpgrade2->new(auth => $auth, path => '../../sql/Pg-upgrade2-auth');
 537
 538   for my $upgrade ($dbu->sort_dbupdate_controls) {
 539     for my $string (@{ $upgrade->{locales} || [] }) {
 540       $locale{$string}     = 1;
 541       $alllocales{$string} = 1;
 542     $cached{$upgrade->{tag}}{all}{$string} = 1;
 543     }
 544   }
 545 }
 546
 547 sub unescape_template_string {
 548   my $in =  "$_[0]";
 549   $in    =~ s/\\(.)/$1/g;
 550   return $in;
 551 }
 552
 553 sub scanhtmlfile {
 554   local *IN;
 555
 556   my $file = shift;
 557
 558   return if defined $cached{$file};
 559
 560   my %plugins = ( 'loaded' => { }, 'needed' => { } );
 561
 562   if (!open(IN, '<:encoding(utf8)', $file)) {
 563     print "E: template file '$file' not found\n";
 564     return;
 565   }
 566
 567   my $copying  = 0;
 568   my $issubmit = 0;
 569   my $text     = "";
 570   while (my $line = <IN>) {
 571     chomp($line);
 572
 573     while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
 574       $plugins{loaded}->{$1} = 1;
 575     }
 576
 577     while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
 578       my $plugin = $1;
 579       $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript JSON L P));
 580     }
 581
 582     $plugins{needed}->{T8} = 1 if $line =~ m/\[\%.*\|.*\$T8/;
 583
 584     while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
 585                         (LxERP\.t8)\( #   LxERP.t8(                             ::Parameter $1::
 586                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
 587                         (.*?)         #   Der zu übersetzende String            ::Parameter $3::
 588                         (?<!\\)\2     #   Ende des zu übersetzenden Strings
 589                       |               # Start von Variante 2: [% '...' | $T8 %]
 590                         \[\%          #   Template-Start-Tag
 591                         [\-~#]?       #   Whitespace-Unterdrückung
 592                         \s*           #   Optional beliebig viele Whitespace
 593                         ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
 594                         (.*?)         #   Der zu übersetzende String            ::Parameter $5::
 595                         (?<!\\)\4     #   Ende des zu übersetzenden Strings
 596                         \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
 597                         (\$T8)        #   Filteraufruf                          ::Parameter $6::
 598                         .*?           #   Optionale Argumente für den Filter
 599                         \s*           #   Whitespaces
 600                         [\-~#]?       #   Whitespace-Unterdrückung
 601                         \%\]          #   Template-Ende-Tag
 602                       )
 603                      /ix) {
 604       my $module = $1 || $6;
 605       my $string = $3 || $5;
 606       print "Found filter >>>$string<<<\n" if $debug;
 607       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 608
 609       $string                         = unescape_template_string($string);
 610       $cached{$file}{all}{$string}    = 1;
 611       $cached{$file}{html}{$string}   = 1;
 612       $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
 613       $plugins{needed}->{T8}          = 1 if $module eq '$T8';
 614       $plugins{needed}->{LxERP}       = 1 if $module eq 'LxERP.t8';
 615     }
 616
 617     while ($line =~ m/\[\%          # Template-Start-Tag
 618                       [\-~#]*       # Whitespace-Unterdrückung
 619                       \s*           # Optional beliebig viele Whitespace
 620                       (?:           # Die erkannten Template-Direktiven
 621                         PROCESS
 622                       |
 623                         INCLUDE
 624                       )
 625                       \s+           # Mindestens ein Whitespace
 626                       [\'\"]?       # Anfang des Dateinamens
 627                       ([^\s]+)      # Beliebig viele Nicht-Whitespaces -- Dateiname
 628                       \.(html|js)   # Endung ".html" oder ".js", ansonsten kann es der Name eines Blocks sein
 629                      /ix) {
 630       my $new_file_name = "$basedir/templates/webpages/$1.$2";
 631       $cached{$file}{scanh}{$new_file_name} = 1;
 632       substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
 633     }
 634   }
 635
 636   close(IN);
 637
 638   foreach my $plugin (keys %{ $plugins{needed} }) {
 639     next if ($plugins{loaded}->{$plugin});
 640     print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
 641   }
 642
 643   # copy back into global arrays
 644   $alllocales{$_} = 1            for keys %{$cached{$file}{all}};
 645   $locale{$_}     = 1            for keys %{$cached{$file}{html}};
 646   $submit{$_}     = 1            for keys %{$cached{$file}{submit}};
 647
 648   scanhtmlfile($_)               for keys %{$cached{$file}{scanh}};
 649
 650   $referenced_html_files{$_} = 1 for keys %{$cached{$file}{scanh}};
 651 }
 652
 653 sub scan_javascript_file {
 654   my ($file) = @_;
 655
 656   open(my $fh, '<:encoding(utf8)', $file) || die('can not open file: '. $file);
 657
 658   while( my $line = readline($fh) ) {
 659     while( $line =~ m/
 660                     \bk(?:ivi)?.t8
 661                     \s*
 662                     \(
 663                     \s*
 664                     ([\'\"])
 665                     (.*?)
 666                     (?<!\\)\1
 667                     /ixg )
 668     {
 669       my $text = unescape_template_string($2);
 670
 671       $jslocale{$text} = 1;
 672       $alllocales{$text} = 1;
 673     }
 674   }
 675
 676   close($fh);
 677 }
 678 sub search_unused_htmlfiles {
 679   my @unscanned_dirs = ('../../templates/webpages');
 680
 681   while (scalar @unscanned_dirs) {
 682     my $dir = shift @unscanned_dirs;
 683
 684     foreach my $entry (<$dir/*>) {
 685       if (-d $entry) {
 686         push @unscanned_dirs, $entry;
 687
 688       } elsif (!$ignore_unused_templates{strip_base($entry)} && -f $entry && !$referenced_html_files{$entry}) {
 689         print "W: unused HTML template: " . strip_base($entry) . "\n";
 690
 691       }
 692     }
 693   }
 694 }
 695
 696 sub strip_base {
 697   my $s =  "$_[0]";             # Create a copy of the string.
 698
 699   $s    =~ s|^../../||;
 700   $s    =~ s|templates/webpages/||;
 701
 702   return $s;
 703 }
 704
 705 sub _single_quote {
 706   my $val = shift;
 707   $val =~ s/(\'|\\$)/\\$1/g;
 708   return  "'" . $val .  "'";
 709 }
 710
 711 sub _double_quote {
 712   my $val = shift;
 713   $val =~ s/(\"|\\$)/\\$1/g;
 714   return  '"'. $val .'"';
 715 }
 716
 717 sub _print_line {
 718   my $key      = _single_quote(shift);
 719   my $text     = _single_quote(shift);
 720   my %params   = @_;
 721   my $template = $params{template} || qq|  %-29s => %s,\n|;
 722   my $fh       = $params{fh}       || croak 'need filehandle in _print_line';
 723
 724   print $fh sprintf $template, $key, $text;
 725 }
 726
 727 sub generate_file {
 728   my %params = @_;
 729
 730   my $file      = $params{file}   || croak 'need filename in generate_file';
 731   my $header    = $params{header};
 732   my $lines     = $params{data_sub};
 733   my $data_name = $params{data_name};
 734   my @delim     = split //, ($params{delim} || '{}');
 735
 736   open my $fh, '>:encoding(utf8)', $file or die "$! : $file";
 737
 738   print $fh "#!/usr/bin/perl\n# -*- coding: utf-8; -*-\n# vim: fenc=utf-8\n\nuse utf8;\n\n";
 739   print $fh $header, "\n" if $header;
 740   print $fh "$data_name = $delim[0]\n" if $data_name;
 741
 742   $lines->(fh => $fh);
 743
 744   print $fh qq|$delim[1];\n\n1;\n|;
 745   close $fh;
 746 }
 747
 748 __END__
 749
 750 =head1 NAME
 751
 752 locales.pl - Collect strings for translation in kivitendo
 753
 754 =head1 SYNOPSIS
 755
 756 locales.pl [options] lang_code
 757
 758  Options:
 759   -n, --no-custom-files  Do not process files whose name contains "_"
 760   -c, --check-files      Run extended checks on HTML files
 761   -f, --filenames        Show the filenames where new strings where found
 762   -v, --verbose          Be more verbose
 763   -h, --help             Show this help
 764
 765 =head1 OPTIONS
 766
 767 =over 8
 768
 769 =item B<-n>, B<--no-custom-files>
 770
 771 Do not process files whose name contains "_", e.g. "custom_io.pl".
 772
 773 =item B<-c>, B<--check-files>
 774
 775 Run extended checks on the usage of templates. This can be used to
 776 discover HTML templates that are never used as well as the usage of
 777 non-existing HTML templates.
 778
 779 =item B<-v>, B<--verbose>
 780
 781 Be more verbose.
 782
 783 =back
 784
 785 =head1 DESCRIPTION
 786
 787 This script collects strings from Perl files, the menu files and
 788 HTML templates and puts them into the file "all" for translation.
 789
 790 =cut