Aufgrund einer Schwäche im Parser von locales.pl darf innerhalb eines <input type...
[kivitendo-erp.git] / locale / de / locales.pl
index 24adc4b..6fd6e80 100755 (executable)
@@ -10,21 +10,31 @@ use POSIX;
 use FileHandle;
 use Data::Dumper;
 
+use List::Util qw(first);
+
 $| = 1;
 
 $basedir  = "../..";
 $bindir   = "$basedir/bin/mozilla";
 $dbupdir  = "$basedir/sql/Pg-upgrade";
+$dbupdir2 = "$basedir/sql/Pg-upgrade2";
 $menufile = "menu.ini";
 $submitsearch = qr/type\s*=\s*[\"\']?submit/i;
 
+%referenced_html_files = ();
+
+# Arguments:
+#   -v verbose
+#   -n no custom files
+#   -h extended checks on HTML templates
+
 foreach $item (@ARGV) {
   $item =~ s/-//g;
   $arg{$item} = 1;
 }
 
 opendir DIR, "$bindir" or die "$!";
-@progfiles = grep { /\.pl/; !/(_|^\.)/ } readdir DIR;
+@progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
 seekdir DIR, 0;
 @customfiles = grep /_/, readdir DIR;
 closedir DIR;
@@ -45,11 +55,17 @@ opendir DIR, $dbupdir or die "$!";
 @dbplfiles = grep { /\.pl$/ } readdir DIR;
 closedir DIR;
 
+opendir DIR, $dbupdir2 or die "$!";
+@dbplfiles2 = grep { /\.pl$/ } readdir DIR;
+closedir DIR;
+
 # slurp the translations in
 if (-f 'all') {
   require "all";
 }
 
+my %old_texts = %{ $self->{texts} };
+
 # Read HTML templates.
 #%htmllocale = ();
 #@htmltemplates = <../../templates/webpages/*/*_master.html>;
@@ -59,6 +75,7 @@ if (-f 'all') {
 
 map({ handle_file($_, $bindir); } @progfiles);
 map({ handle_file($_, $dbupdir); } @dbplfiles);
+map({ handle_file($_, $dbupdir2); } @dbplfiles2);
 
 sub handle_file {
   my ($file, $dir) = @_;
@@ -99,21 +116,22 @@ sub handle_file {
 
   foreach $text (keys %$missing) {
     if ($locale{$text} || $htmllocale{$text}) {
-      unless ($self{texts}{$text}) {
-        $self{texts}{$text} = $missing->{$text};
+      unless ($self->{texts}{$text}) {
+        $self->{texts}{$text} = $missing->{$text};
       }
     }
   }
 
-  my $localefile = $dir eq $bindir ? $file : "dbupgrade";
-  open FH, ">$localefile" or die "$! : $localefile";
+  open FH, ">$file" or die "$! : $file";
 
-  print FH q|$self{texts} = {
+  print FH q|#!/usr/bin/perl
+
+$self->{texts} = {
 |;
 
   foreach $key (sort keys %locale) {
-    if ($self{texts}{$key}) {
-      $text = $self{texts}{$key};
+    if ($self->{texts}{$key}) {
+      $text = $self->{texts}{$key};
     } else {
       $text = $key;
     }
@@ -131,7 +149,7 @@ sub handle_file {
 
   print FH q|};
 
-$self{subs} = {
+$self->{subs} = {
 |;
 
   foreach $key (sort keys %subrt) {
@@ -142,7 +160,7 @@ $self{subs} = {
   }
 
   foreach $key (sort keys %submit) {
-    $text = ($self{texts}{$key}) ? $self{texts}{$key} : $key;
+    $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
     $text =~ s/'/\\'/g;
     $text =~ s/\\$/\\\\/;
 
@@ -176,16 +194,18 @@ $self{subs} = {
 
 open FH, ">all" or die "$! : all";
 
-print FH q|# These are all the texts to build the translations files.
+print FH q|#!/usr/bin/perl
+
+# 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
 
-$self{texts} = {
+$self->{texts} = {
 |;
 
 foreach $key (sort keys %alllocales) {
-  $text = $self{texts}{$key};
+  $text = $self->{texts}{$key};
 
   $count++;
 
@@ -213,7 +233,9 @@ close FH;
 if (@missing) {
   open FH, ">missing" or die "$! : missing";
 
-  print FH q|# add the missing texts and run locales.pl to rebuild
+  print FH q|#!/usr/bin/perl
+
+# add the missing texts and run locales.pl to rebuild
 
 $missing = {
 |;
@@ -231,12 +253,49 @@ $missing = {
 
 }
 
+@lost = ();
+
+if (-f "lost") {
+  require "lost";
+  unlink "lost";
+}
+
+while (($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);
+
+  open FH, ">lost";
+  print FH "#!/usr/bin/perl\n\n" .
+    "# The last 50 texts that have been removed.\n" .
+    "# This file will be auto-generated by locales.pl. Do not edit it.\n\n" .
+    "\@lost = (\n";
+
+  foreach $entry (@lost) {
+    $entry->{text}        =~ s/\'/\\\'/;
+    $entry->{translation} =~ s/\'/\\\'/;
+    print FH "  { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
+  }
+
+  print FH ");\n\n1;\n";
+  close FH;
+}
+
 open(FH, "LANGUAGE");
 @language = <FH>;
 close(FH);
 $trlanguage = $language[0];
 chomp $trlanguage;
 
+if ($arg{h}) {
+  search_unused_htmlfiles();
+  search_translated_htmlfiles_wo_master();
+}
+
 $per = sprintf("%.1f", ($count - $notext) / $count * 100);
 print "\n$trlanguage - ${per}%";
 print " - $notext missing" if $notext;
@@ -272,7 +331,7 @@ sub extract_text_between_parenthesis {
       } elsif (($cur_char eq '"') || ($cur_char eq '\'')) {
         $inside_string = $cur_char;
 
-      } elsif ($cur_char eq ")") {
+      } elsif (($cur_char eq ")") || ($cur_char eq ',')) {
         return ($text, substr($line, $pos + 1));
       }
 
@@ -302,6 +361,9 @@ sub scanfile {
   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;
@@ -322,22 +384,29 @@ sub scanfile {
       if (/require\s+\W.*\.pl/) {
         my $newfile = $&;
         $newfile =~ s/require\s+\W//;
-        $newfile =~ s/\$form->{path}\///;
+        $newfile =~ s|bin/mozilla||;
 #         &scanfile("$bindir/$newfile", 0, $scanned_files);
          $cached{$file}{scan}{"$bindir/$newfile"} = 1;
       } elsif (/use\s+SL::(.*?);/) {
+        my $module =  $1;
+        $module    =~ s|::|/|g;
 #         &scanfile("../../SL/${1}.pm", 1, $scanned_files);
-         $cached{$file}{scannosubs}{"../../SL/${1}.pm"} = 1;
+        $cached{$file}{scannosubs}{"../../SL/${module}.pm"} = 1;
       }
 
       # is this a template call?
-      if (/parse_html_template\s*\(\s*[\"\']([\w\/]+)/) {
+      if (/parse_html_template2?\s*\(\s*[\"\']([\w\/]+)\s*[\"\']/) {
         my $newfile = "$basedir/templates/webpages/$1_master.html";
+        if (/parse_html_template2/) {
+          print "E: " . strip_base($file) . " is still using 'parse_html_template2' for " . strip_base($newfile) . ".\n";
+        }
         if (-f $newfile) {
 #           &scanhtmlfile($newfile);
 #           &converthtmlfile($newfile);
            $cached{$file}{scanh}{$newfile} = 1;
           print "." if $arg{v};
+        } elsif ($arg{h}) {
+          print "W: missing HTML template: " . strip_base($newfile) . " (referenced from " . strip_base($file) . ")\n";
         }
       }
 
@@ -422,6 +491,8 @@ sub scanfile {
   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 {
@@ -430,7 +501,7 @@ sub scanmenu {
   my $fh = new FileHandle;
   open $fh, "$file" or die "$! : $file";
 
-  my @a = grep /^\[/, <$fh>;
+  my @a = grep m/^\[/, <$fh>;
   close($fh);
 
   # strip []
@@ -449,9 +520,10 @@ sub scanmenu {
 
 sub scanhtmlfile {
   local *IN;
+
   if (!defined $cached{$_[0]}) {
+    my %plugins = ( 'loaded' => { }, 'needed' => { } );
+
     open(IN, $_[0]) || die $_[0];
 
     my $copying = 0;
@@ -460,6 +532,15 @@ sub scanhtmlfile {
     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 ("" ne $line) {
         if (!$copying) {
           if ($line =~ m|<translate>|i) {
@@ -477,7 +558,8 @@ sub scanhtmlfile {
           if ($line =~ m|</translate>|i) {
             $text .= $`;
             substr($line, 0, $+[0]) = "";
-            
+            $text =~ s/\s+/ /g;
+
             $copying = 0; 
             if ($issubmit) {
   #            $submit{$text} = 1;
@@ -499,6 +581,12 @@ sub scanhtmlfile {
     }
 
     close(IN);
+
+    foreach my $plugin (keys %{ $plugins{needed} }) {
+      next if ($plugins{loaded}->{$plugin});
+      print "E: " . strip_base($_[0]) . " requires the Template plugin '$plugin', but is not loaded with '[\% USE $plugin \%]'.\n";
+    }
+
     &converthtmlfile($_[0]);
   }
 
@@ -547,10 +635,11 @@ sub converthtmlfile {
         if ($line =~ m|</translate>|i) {
           $text .= $`;
           substr($line, 0, $+[0]) = "";
+          $text =~ s/\s+/ /g;
           $copying = 0;
           $alllocales{$text} = 1;
           $htmllocale{$text} = 1;
-          print(OUT $self{"texts"}{$text} || $text);
+          print(OUT $self->{"texts"}{$text} || $text);
           print(OUT "\n") if ("" eq $line);
           $text = "";
 
@@ -565,3 +654,51 @@ sub converthtmlfile {
   close(IN);
   close(OUT);
 }
+
+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 search_translated_htmlfiles_wo_master {
+  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 =~ /_[a-z]+\.html$/) && ($entry !~ /_master.html$/) && -f $entry) {
+        my $master =  $entry;
+        $master    =~ s/[a-z]+\.html$/master.html/;
+        if (! -f $master) {
+          print "W: translated HTML template without master: " . strip_base($entry) . "\n";
+        }
+      }
+    }
+  }
+}
+
+sub strip_base {
+  my $s =  "$_[0]";             # Create a copy of the string.
+
+  $s    =~ s|^../../||;
+  $s    =~ s|templates/webpages/||;
+
+  return $s;
+}