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