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