locales unter scripts legen
authorSven Schöling <s.schoeling@linet-services.de>
Mon, 1 Feb 2010 14:37:52 +0000 (15:37 +0100)
committerSven Schöling <s.schoeling@linet-services.de>
Tue, 20 Jul 2010 09:51:43 +0000 (11:51 +0200)
scripts/locales.pl [new file with mode: 0755]

diff --git a/scripts/locales.pl b/scripts/locales.pl
new file mode 100755 (executable)
index 0000000..dd7c4ca
--- /dev/null
@@ -0,0 +1,636 @@
+#!/usr/bin/perl
+
+# -n do not include custom_ scripts
+# -v verbose mode, shows progress stuff
+
+# this version of locles processes not only all required .pl files
+# but also all parse_html_templated files.
+
+use strict;
+
+use Data::Dumper;
+use English;
+use FileHandle;
+use Getopt::Long;
+use List::Util qw(first);
+use POSIX;
+use Pod::Usage;
+use Carp;
+use File::Slurp qw(slurp);
+
+$OUTPUT_AUTOFLUSH = 1;
+
+my $opt_v  = 0;
+my $opt_n  = 0;
+my $opt_c  = 0;
+my $lang;
+my $debug  = 0;
+
+parse_args();
+
+my $basedir      = ".";
+my $locales_dir  = "$basedir/locale/$lang";
+my $bindir       = "$basedir/bin/mozilla";
+my $dbupdir      = "$basedir/sql/Pg-upgrade";
+my $dbupdir2     = "$basedir/sql/Pg-upgrade2";
+my $menufile     = "menu.ini";
+my $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
+
+my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit);
+my ($ALL_HEADER, $MISSING_HEADER, $LOST_HEADER);
+
+init();
+
+opendir DIR, "$bindir" or die "$!";
+my @progfiles = grep { /\.pl$/ && !/(_custom|^\.)/ } readdir DIR;
+seekdir DIR, 0;
+my @customfiles = grep /_custom/, readdir DIR;
+closedir DIR;
+
+# put customized files into @customfiles
+my @menufiles;
+
+if ($opt_n) {
+  @customfiles = ();
+  @menufiles   = ($menufile);
+} else {
+  opendir DIR, "$basedir" or die "$!";
+  @menufiles = grep { /.*?_$menufile$/ } readdir DIR;
+  closedir DIR;
+  unshift @menufiles, $menufile;
+}
+
+opendir DIR, $dbupdir or die "$!";
+my @dbplfiles = grep { /\.pl$/ } readdir DIR;
+closedir DIR;
+
+opendir DIR, $dbupdir2 or die "$!";
+my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
+closedir DIR;
+
+# slurp the translations in
+our $self    = {};
+our $missing = {};
+our @missing = ();
+our @lost    = ();
+
+if (-f "$locales_dir/all") {
+  require "$locales_dir/all";
+}
+if (-f "$locales_dir/missing") {
+  require "$locales_dir/missing" ;
+  unlink "$locales_dir/missing";
+}
+if (-f "$locales_dir/lost") {
+  require "$locales_dir/lost";
+  unlink "$locales_dir/lost";
+}
+
+my %old_texts = %{ $self->{texts} || {} };
+
+map({ handle_file($_, $bindir); } @progfiles);
+map({ handle_file($_, $dbupdir); } @dbplfiles);
+map({ handle_file($_, $dbupdir2); } @dbplfiles2);
+
+# generate all
+generate_file(
+  file      => "$locales_dir/all",
+  header    => $ALL_HEADER,
+  data_name => '$self->{texts}',
+  data_sub  => sub { _print_line($_, $self->{texts}{$_}, @_) for sort keys %alllocales },
+);
+
+# calc and generate missing
+push @missing, grep { !$self->{texts}{$_} } sort keys %alllocales;
+
+if (@missing) {
+  generate_file(
+    file      => "$locales_dir/missing",
+    header    => $MISSING_HEADER,
+    data_name => '$missing',
+    data_sub  => sub { _print_line($_, '', @_) for @missing },
+  );
+}
+
+# calc and generate lost
+while (my ($text, $translation) = each %old_texts) {
+  next if ($alllocales{$text});
+  push @lost, { 'text' => $text, 'translation' => $translation };
+}
+
+if (scalar @lost) {
+  splice @lost, 0, (scalar @lost - 50) if (scalar @lost > 50);
+  generate_file(
+    file      => "$locales_dir/lost",
+    header    => $LOST_HEADER,
+    delim     => '()',
+    data_name => '@lost',
+    data_sub  => sub {
+      _print_line($_->{text}, $_->{translation}, @_, template => "  { 'text' => %s, 'translation' => %s },") for @lost;
+    },
+  );
+}
+
+my $trlanguage = slurp("$locales_dir/LANGUAGE");
+chomp $trlanguage;
+
+search_unused_htmlfiles() if $opt_c;
+
+my $count  = scalar keys %alllocales;
+my $notext = scalar @missing;
+my $per    = sprintf("%.1f", ($count - $notext) / $count * 100);
+print "\n$trlanguage - ${per}%";
+print " - $notext/$count missing" if $notext;
+print "\n";
+
+exit;
+
+# eom
+
+sub init {
+  $ALL_HEADER = <<EOL;
+# These are all the texts to build the translations files.
+# The file has the form of 'english text'  => 'foreign text',
+# you can add the translation in this file or in the 'missing' file
+# run locales.pl from this directory to rebuild the translation files
+EOL
+  $MISSING_HEADER = <<EOL;
+# add the missing texts and run locales.pl to rebuild
+EOL
+  $LOST_HEADER  = <<EOL;
+# The last 50 texts that have been removed.
+# This file will be auto-generated by locales.pl. Do not edit it.
+EOL
+}
+
+sub parse_args {
+  my ($help, $man);
+
+  GetOptions(
+    'no-custom-files' => \$opt_n,
+    'check-files'     => \$opt_c,
+    'verbose'         => \$opt_v,
+    'help'            => \$help,
+    'man'             => \$man,
+    'debug'           => \$debug,
+  );
+
+  if ($help) {
+    pod2usage(1);
+    exit 0;
+  }
+
+  if ($man) {
+    pod2usage(-exitstatus => 0, -verbose => 2);
+    exit 0;
+  }
+
+  $lang = shift @ARGV   || croak 'need language code as argument';
+}
+
+sub handle_file {
+  my ($file, $dir) = @_;
+  print "\n$file" if $opt_v;
+  %locale = ();
+  %submit = ();
+
+  &scanfile("$dir/$file");
+
+  # scan custom_{module}.pl or {login}_{module}.pl files
+  foreach my $customfile (@customfiles) {
+    if ($customfile =~ /_$file/) {
+      if (-f "$dir/$customfile") {
+        &scanfile("$dir/$customfile");
+      }
+    }
+  }
+
+  # if this is the menu.pl file
+  if ($file eq 'menu.pl') {
+    foreach my $item (@menufiles) {
+      &scanmenu("$basedir/$item");
+    }
+  }
+
+  if ($file eq 'menunew.pl') {
+    foreach my $item (@menufiles) {
+      &scanmenu("$basedir/$item");
+      print "." if $opt_v;
+    }
+  }
+
+  $file =~ s/\.pl//;
+
+  foreach my $text (keys %$missing) {
+    if ($locale{$text} || $htmllocale{$text}) {
+      unless ($self->{texts}{$text}) {
+        $self->{texts}{$text} = $missing->{$text};
+      }
+    }
+  }
+}
+
+sub extract_text_between_parenthesis {
+  my ($fh, $line) = @_;
+  my ($inside_string, $pos, $text, $quote_next) = (undef, 0, "", 0);
+
+  while (1) {
+    if (length($line) <= $pos) {
+      $line = <$fh>;
+      return ($text, "") unless ($line);
+      $pos = 0;
+    }
+
+    my $cur_char = substr($line, $pos, 1);
+
+    if (!$inside_string) {
+      if ((length($line) >= ($pos + 3)) && (substr($line, $pos, 2)) eq "qq") {
+        $inside_string = substr($line, $pos + 2, 1);
+        $pos += 2;
+
+      } elsif ((length($line) >= ($pos + 2)) &&
+               (substr($line, $pos, 1) eq "q")) {
+        $inside_string = substr($line, $pos + 1, 1);
+        $pos++;
+
+      } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
+        $inside_string = $cur_char;
+
+      } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
+        return ($text, substr($line, $pos + 1));
+      }
+
+    } else {
+      if ($quote_next) {
+        $text .= $cur_char;
+        $quote_next = 0;
+
+      } elsif ($cur_char eq '\\') {
+        $text .= $cur_char;
+        $quote_next = 1;
+
+      } elsif ($cur_char eq $inside_string) {
+        undef($inside_string);
+
+      } else {
+        $text .= $cur_char;
+
+      }
+    }
+    $pos++;
+  }
+}
+
+sub scanfile {
+  my $file = shift;
+  my $dont_include_subs = shift;
+  my $scanned_files = shift;
+
+  # sanitize file
+  $file =~ s=/+=/=g;
+
+  $scanned_files = {} unless ($scanned_files);
+  return if ($scanned_files->{$file});
+  $scanned_files->{$file} = 1;
+
+  if (!defined $cached{$file}) {
+
+    return unless (-f "$file");
+
+    my $fh = new FileHandle;
+    open $fh, "$file" or die "$! : $file";
+
+    my ($is_submit, $line_no, $sub_line_no) = (0, 0, 0);
+
+    while (<$fh>) {
+      $line_no++;
+
+      # is this another file
+      if (/require\s+\W.*\.pl/) {
+        my $newfile = $&;
+        $newfile =~ s/require\s+\W//;
+        $newfile =~ s|bin/mozilla||;
+         $cached{$file}{scan}{"$bindir/$newfile"} = 1;
+      } elsif (/use\s+SL::([\w:]*)/) {
+        my $module =  $1;
+        $module    =~ s|::|/|g;
+        $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
+      }
+
+      # is this a template call?
+      if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
+        my $newfile = "$basedir/templates/webpages/$1.html";
+        if (/parse_html_template2/) {
+          print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
+        }
+        if (-f $newfile) {
+           $cached{$file}{scanh}{$newfile} = 1;
+          print "." if $opt_v;
+        } elsif ($opt_c) {
+          print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
+        }
+      }
+
+      my $rc = 1;
+
+      while ($rc) {
+        if (/Locale/) {
+          unless (/^use /) {
+            my ($null, $country) = split /,/;
+            $country =~ s/^ +[\"\']//;
+            $country =~ s/[\"\'].*//;
+          }
+        }
+
+        my $postmatch = "";
+
+        # is it a submit button before $locale->
+        if (/$submitsearch/) {
+          $postmatch = "$'";
+          if ($` !~ /locale->text/) {
+            $is_submit   = 1;
+            $sub_line_no = $line_no;
+          }
+        }
+
+        my ($found) = /locale->text.*?\(/;
+        $postmatch = "$'";
+
+        if ($found) {
+          my $string;
+          ($string, $_) = extract_text_between_parenthesis($fh, $postmatch);
+          $postmatch = $_;
+
+          # if there is no $ in the string record it
+          unless (($string =~ /\$\D.*/) || ("" eq $string)) {
+
+            # this guarantees one instance of string
+            $cached{$file}{locale}{$string} = 1;
+
+            # this one is for all the locales
+            $cached{$file}{all}{$string} = 1;
+
+            # is it a submit button before $locale->
+            if ($is_submit) {
+              $cached{$file}{submit}{$string} = 1;
+            }
+          }
+        } elsif ($postmatch =~ />/) {
+          $is_submit = 0;
+        }
+
+        # exit loop if there are no more locales on this line
+        ($rc) = ($postmatch =~ /locale->text/);
+
+        if (   ($postmatch =~ />/)
+            || (!$found && ($sub_line_no != $line_no) && />/)) {
+          $is_submit = 0;
+        }
+      }
+    }
+
+    close($fh);
+
+  }
+
+  map { $alllocales{$_} = 1 }   keys %{$cached{$file}{all}};
+  map { $locale{$_} = 1 }       keys %{$cached{$file}{locale}};
+  map { $submit{$_} = 1 }       keys %{$cached{$file}{submit}};
+  map { &scanfile($_, 0, $scanned_files) } keys %{$cached{$file}{scan}};
+  map { &scanfile($_, 1, $scanned_files) } keys %{$cached{$file}{scannosubs}};
+  map { &scanhtmlfile($_)  }    keys %{$cached{$file}{scanh}};
+
+  @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
+}
+
+sub scanmenu {
+  my $file = shift;
+
+  my $fh = new FileHandle;
+  open $fh, "$file" or die "$! : $file";
+
+  my @a = grep m/^\[/, <$fh>;
+  close($fh);
+
+  # strip []
+  grep { s/(\[|\])//g } @a;
+
+  foreach my $item (@a) {
+    my @b = split /--/, $item;
+    foreach my $string (@b) {
+      chomp $string;
+      $locale{$string}     = 1;
+      $alllocales{$string} = 1;
+    }
+  }
+
+}
+
+sub unescape_template_string {
+  my $in =  "$_[0]";
+  $in    =~ s/\\(.)/$1/g;
+  return $in;
+}
+
+sub scanhtmlfile {
+  local *IN;
+
+  my $file = shift;
+
+  if (!defined $cached{$file}) {
+    my %plugins = ( 'loaded' => { }, 'needed' => { } );
+
+    open(IN, $file) || die $file;
+
+    my $copying  = 0;
+    my $issubmit = 0;
+    my $text     = "";
+    while (my $line = <IN>) {
+      chomp($line);
+
+      while ($line =~ m/\[\%[^\w]*use[^\w]+(\w+)[^\w]*?\%\]/gi) {
+        $plugins{loaded}->{$1} = 1;
+      }
+
+      while ($line =~ m/\[\%[^\w]*(\w+)\.\w+\(/g) {
+        my $plugin = $1;
+        $plugins{needed}->{$plugin} = 1 if (first { $_ eq $plugin } qw(HTML LxERP JavaScript MultiColumnIterator));
+      }
+
+      while ($line =~ m/(?:             # Start von Variante 1: LxERP.t8('...'); ohne darumliegende [% ... %]-Tags
+                          (LxERP\.t8)\( #   LxERP.t8(                             ::Parameter $1::
+                          ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $2::
+                          (.*?)         #   Der zu übersetzende String            ::Parameter $3::
+                          (?<!\\)\2     #   Ende des zu übersetzenden Strings
+                        |               # Start von Variante 2: [% '...' | $T8 %]
+                          \[\%          #   Template-Start-Tag
+                          [\-~#]?       #   Whitespace-Unterdrückung
+                          \s*           #   Optional beliebig viele Whitespace
+                          ([\'\"])      #   Anfang des zu übersetzenden Strings   ::Parameter $4::
+                          (.*?)         #   Der zu übersetzende String            ::Parameter $5::
+                          (?<!\\)\4     #   Ende des zu übersetzenden Strings
+                          \s*\|\s*      #   Pipe-Zeichen mit optionalen Whitespace davor und danach
+                          (\$T8)        #   Filteraufruf                          ::Parameter $6::
+                          .*?           #   Optionale Argumente für den Filter
+                          \s*           #   Whitespaces
+                          [\-~#]?       #   Whitespace-Unterdrückung
+                          \%\]          #   Template-Ende-Tag
+                        )
+                       /ix) {
+        my $module = $1 || $6;
+        my $string = $3 || $5;
+        print "Found filter >>>$string<<<\n" if $debug;
+        substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
+
+        $string                         = unescape_template_string($string);
+        $cached{$file}{all}{$string}    = 1;
+        $cached{$file}{html}{$string}   = 1;
+        $cached{$file}{submit}{$string} = 1 if $PREMATCH =~ /$submitsearch/;
+        $plugins{needed}->{T8}          = 1 if $module eq '$T8';
+        $plugins{needed}->{LxERP}       = 1 if $module eq 'LxERP.t8';
+      }
+
+      while ($line =~ m/\[\%          # Template-Start-Tag
+                        [\-~#]?       # Whitespace-Unterdrückung
+                        \s*           # Optional beliebig viele Whitespace
+                        (?:           # Die erkannten Template-Direktiven
+                          PROCESS
+                        |
+                          INCLUDE
+                        )
+                        \s+           # Mindestens ein Whitespace
+                        [\'\"]?       # Anfang des Dateinamens
+                        ([^\s]+)      # Beliebig viele Nicht-Whitespaces -- Dateiname
+                        \.html        # Endung ".html", ansonsten kann es der Name eines Blocks sein
+                       /ix) {
+        my $new_file_name = "$basedir/templates/webpages/$1.html";
+        $cached{$file}{scanh}{$new_file_name} = 1;
+        substr $line, $LAST_MATCH_START[1], $LAST_MATCH_END[0] - $LAST_MATCH_START[0], '';
+      }
+    }
+
+    close(IN);
+
+    foreach my $plugin (keys %{ $plugins{needed} }) {
+      next if ($plugins{loaded}->{$plugin});
+      print "E: " . strip_base($file) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
+    }
+  }
+
+  # copy back into global arrays
+  map { $alllocales{$_} = 1 } keys %{$cached{$file}{all}};
+  map { $locale{$_} = 1 }     keys %{$cached{$file}{html}};
+  map { $submit{$_} = 1 }     keys %{$cached{$file}{submit}};
+
+  map { scanhtmlfile($_)  }   keys %{$cached{$file}{scanh}};
+
+  @referenced_html_files{keys %{$cached{$file}{scanh}}} = (1) x scalar keys %{$cached{$file}{scanh}};
+}
+
+sub search_unused_htmlfiles {
+  my @unscanned_dirs = ('../../templates/webpages');
+
+  while (scalar @unscanned_dirs) {
+    my $dir = shift @unscanned_dirs;
+
+    foreach my $entry (<$dir/*>) {
+      if (-d $entry) {
+        push @unscanned_dirs, $entry;
+
+      } elsif (($entry =~ /_master.html$/) && -f $entry && !$referenced_html_files{$entry}) {
+        print "W: unused HTML template: " . strip_base($entry) . "\n";
+
+      }
+    }
+  }
+}
+
+sub strip_base {
+  my $s =  "$_[0]";             # Create a copy of the string.
+
+  $s    =~ s|^../../||;
+  $s    =~ s|templates/webpages/||;
+
+  return $s;
+}
+
+sub _single_quote {
+  my $val = shift;
+  $val =~ s/('|\\$)/\\$1/g;
+  return  "'" . $val .  "'";
+}
+
+sub _print_line {
+  my $key      = _single_quote(shift);
+  my $text     = _single_quote(shift);
+  my %params   = @_;
+  my $template = $params{template} || qq|  %-29s => %s,\n|;
+  my $fh       = $params{fh}       || croak 'need filehandle in _print_line';
+
+  print $fh sprintf $template, $key, $text;
+}
+
+sub generate_file {
+  my %params = @_;
+
+  my $file      = $params{file}   || croak 'need filename in generate_file';
+  my $header    = $params{header};
+  my $lines     = $params{data_sub};
+  my $data_name = $params{data_name};
+  my @delim     = split //, ($params{delim} || '{}');
+
+  open my $fh, '>', $file or die "$! : $file";
+
+  print $fh "#!/usr/bin/perl\n\n";
+  print $fh $header, "\n" if $header;
+  print $fh "$data_name = $delim[0]\n" if $data_name;
+
+  $lines->(fh => $fh);
+
+  print $fh qq|$delim[1];\n\n1;\n|;
+  close $fh;
+}
+
+__END__
+
+=head1 NAME
+
+locales.pl - Collect strings for translation in Lx-Office
+
+=head1 SYNOPSIS
+
+locales.pl [options]
+
+ Options:
+  -n, --no-custom-files  Do not process files whose name contains "_"
+  -c, --check-files      Run extended checks on HTML files
+  -v, --verbose          Be more verbose
+  -h, --help             Show this help
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-n>, B<--no-custom-files>
+
+Do not process files whose name contains "_", e.g. "custom_io.pl".
+
+=item B<-c>, B<--check-files>
+
+Run extended checks on the usage of templates. This can be used to
+discover HTML templates that are never used as well as the usage of
+non-existing HTML templates.
+
+=item B<-v>, B<--verbose>
+
+Be more verbose.
+
+=back
+
+=head1 DESCRIPTION
+
+This script collects strings from Perl files, the menu.ini file and
+HTML templates and puts them into the file "all" for translation.  It
+also distributes those translations back to the individual files.
+
+=cut