Projekt

Allgemein

Profil

Herunterladen (17,5 KB) Statistiken
| Zweig: | Markierung: | Revision:
faeeee8a Sven Schöling
#!/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 $debug = 0;

parse_args();

984d50b3 Moritz Bunkus
my $basedir = "../..";
my $locales_dir = ".";
faeeee8a Sven Schöling
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;
}

984d50b3 Moritz Bunkus
if (@ARGV) {
my $arg = shift @ARGV;
my $ok = 0;
foreach my $dir ("../locale/$arg", "locale/$arg", "../$arg", $arg) {
next unless -d $dir && -f "$dir/all" && -f "$dir/LANGUAGE";
$ok = chdir $dir;
last;
}

if (!$ok) {
print "The locale directory '$arg' could not be found.\n";
exit 1;
}

} elsif (!-f 'all' || !-f 'LANGUAGE') {
print "locales.pl was not called from a locale/* subdirectory,\n"
. "and no locale directory name was given.\n";
exit 1;
}
faeeee8a Sven Schöling
}

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