Revision 3e0a049e
Von Sven Schöling vor fast 15 Jahren hinzugefügt
| locale/de/locales.pl | ||
|---|---|---|
|
# 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;
|
||
|
|
||
|
$| = 1;
|
||
|
$OUTPUT_AUTOFLUSH = 1;
|
||
|
|
||
|
my $basedir = "../..";
|
||
|
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;
|
||
|
|
||
|
$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;
|
||
|
my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit, %subrt);
|
||
|
|
||
|
%referenced_html_files = ();
|
||
|
my $count = 0;
|
||
|
my $notext = 0;
|
||
|
|
||
|
my $opt_v = 0;
|
||
|
my $opt_n = 0;
|
||
|
my $opt_c = 0;
|
||
|
my $debug = 0;
|
||
|
|
||
|
my $opt_v = 0;
|
||
|
my $opt_n = 0;
|
||
|
my $opt_c = 0;
|
||
|
|
||
|
sub parse_args {
|
||
|
my ($help, $man);
|
||
| ... | ... | |
|
parse_args();
|
||
|
|
||
|
opendir DIR, "$bindir" or die "$!";
|
||
|
@progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
|
||
|
my @progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
|
||
|
seekdir DIR, 0;
|
||
|
@customfiles = grep /_/, readdir DIR;
|
||
|
my @customfiles = grep /_/, readdir DIR;
|
||
|
closedir DIR;
|
||
|
|
||
|
# put customized files into @customfiles
|
||
|
my @menufiles;
|
||
|
|
||
|
if ($opt_n) {
|
||
|
@customfiles = ();
|
||
| ... | ... | |
|
}
|
||
|
|
||
|
opendir DIR, $dbupdir or die "$!";
|
||
|
@dbplfiles = grep { /\.pl$/ } readdir DIR;
|
||
|
my @dbplfiles = grep { /\.pl$/ } readdir DIR;
|
||
|
closedir DIR;
|
||
|
|
||
|
opendir DIR, $dbupdir2 or die "$!";
|
||
|
@dbplfiles2 = grep { /\.pl$/ } readdir DIR;
|
||
|
my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
|
||
|
closedir DIR;
|
||
|
|
||
|
# slurp the translations in
|
||
|
my $self = {};
|
||
|
my $missing = {};
|
||
|
my @missing = ();
|
||
|
my @lost = ();
|
||
|
|
||
|
if (-f 'all') {
|
||
|
require "all";
|
||
|
require 'all';
|
||
|
}
|
||
|
if (-f 'missing') {
|
||
|
require 'missing' ;
|
||
|
unlink 'missing';
|
||
|
}
|
||
|
if (-f 'lost') {
|
||
|
require 'lost';
|
||
|
unlink 'lost';
|
||
|
}
|
||
|
|
||
|
my %old_texts = %{ $self->{texts} };
|
||
|
my %old_texts = %{ $self->{texts} || {} };
|
||
|
|
||
|
# Read HTML templates.
|
||
|
#%htmllocale = ();
|
||
| ... | ... | |
|
sub handle_file {
|
||
|
my ($file, $dir) = @_;
|
||
|
print "\n$file" if $opt_v;
|
||
|
%locale = ();
|
||
|
%submit = ();
|
||
|
%subrt = ();
|
||
|
my %locale = ();
|
||
|
my %submit = ();
|
||
|
my %subrt = ();
|
||
|
|
||
|
&scanfile("$dir/$file");
|
||
|
|
||
|
# scan custom_{module}.pl or {login}_{module}.pl files
|
||
|
foreach $customfile (@customfiles) {
|
||
|
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 $item (@menufiles) {
|
||
|
foreach my $item (@menufiles) {
|
||
|
&scanmenu("$basedir/$item");
|
||
|
}
|
||
|
}
|
||
|
|
||
|
if ($file eq 'menunew.pl') {
|
||
|
foreach $item (@menufiles) {
|
||
|
foreach my $item (@menufiles) {
|
||
|
&scanmenu("$basedir/$item");
|
||
|
print "." if $opt_v;
|
||
|
}
|
||
| ... | ... | |
|
|
||
|
$file =~ s/\.pl//;
|
||
|
|
||
|
eval { require 'missing'; };
|
||
|
unlink 'missing';
|
||
|
|
||
|
foreach $text (keys %$missing) {
|
||
|
foreach my $text (keys %$missing) {
|
||
|
if ($locale{$text} || $htmllocale{$text}) {
|
||
|
unless ($self->{texts}{$text}) {
|
||
|
$self->{texts}{$text} = $missing->{$text};
|
||
| ... | ... | |
|
$self->{texts} = {
|
||
|
|;
|
||
|
|
||
|
foreach $key (sort keys %locale) {
|
||
|
if ($self->{texts}{$key}) {
|
||
|
$text = $self->{texts}{$key};
|
||
|
} else {
|
||
|
$text = $key;
|
||
|
}
|
||
|
$text =~ s/'/\\'/g;
|
||
|
$text =~ s/\\$/\\\\/;
|
||
|
foreach my $key (sort keys %locale) {
|
||
|
my $text = $self->{texts}{$key} || $key;
|
||
|
$text =~ s/'/\\'/g;
|
||
|
$text =~ s/\\$/\\\\/;
|
||
|
|
||
|
$keytext = $key;
|
||
|
$keytext =~ s/'/\\'/g;
|
||
|
$keytext =~ s/\\$/\\\\/;
|
||
|
my $keytext = $key;
|
||
|
$keytext =~ s/'/\\'/g;
|
||
|
$keytext =~ s/\\$/\\\\/;
|
||
|
|
||
|
print FH qq| '$keytext'|
|
||
|
. (' ' x (27 - length($keytext)))
|
||
| ... | ... | |
|
$self->{subs} = {
|
||
|
|;
|
||
|
|
||
|
foreach $key (sort keys %subrt) {
|
||
|
$text = $key;
|
||
|
$text =~ s/'/\\'/g;
|
||
|
$text =~ s/\\$/\\\\/;
|
||
|
foreach my $key (sort keys %subrt) {
|
||
|
my $text = $key;
|
||
|
$text =~ s/'/\\'/g;
|
||
|
$text =~ s/\\$/\\\\/;
|
||
|
print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
|
||
|
}
|
||
|
|
||
|
foreach $key (sort keys %submit) {
|
||
|
$text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
|
||
|
$text =~ s/'/\\'/g;
|
||
|
$text =~ s/\\$/\\\\/;
|
||
|
foreach my $key (sort keys %submit) {
|
||
|
my $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
|
||
|
$text =~ s/'/\\'/g;
|
||
|
$text =~ s/\\$/\\\\/;
|
||
|
|
||
|
$english_sub = $key;
|
||
|
$english_sub =~ s/'/\\'/g;
|
||
|
$english_sub =~ s/\\$/\\\\/;
|
||
|
$english_sub = lc $key;
|
||
|
my $english_sub = $key;
|
||
|
$english_sub =~ s/'/\\'/g;
|
||
|
$english_sub =~ s/\\$/\\\\/;
|
||
|
$english_sub = lc $key;
|
||
|
|
||
|
$translated_sub = lc $text;
|
||
|
$english_sub =~ s/( |-|,)/_/g;
|
||
|
$translated_sub =~ s/( |-|,)/_/g;
|
||
|
my $translated_sub = lc $text;
|
||
|
$english_sub =~ s/( |-|,)/_/g;
|
||
|
$translated_sub =~ s/( |-|,)/_/g;
|
||
|
print FH qq| '$translated_sub'|
|
||
|
. (' ' x (27 - length($translated_sub)))
|
||
|
. qq| => '$english_sub',\n|;
|
||
| ... | ... | |
|
$self->{texts} = {
|
||
|
|;
|
||
|
|
||
|
foreach $key (sort keys %alllocales) {
|
||
|
$text = $self->{texts}{$key};
|
||
|
foreach my $key (sort keys %alllocales) {
|
||
|
my $text = $self->{texts}{$key};
|
||
|
|
||
|
$count++;
|
||
|
|
||
| ... | ... | |
|
$missing = {
|
||
|
|;
|
||
|
|
||
|
foreach $text (@missing) {
|
||
|
foreach my $text (@missing) {
|
||
|
print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
|
||
|
}
|
||
|
|
||
| ... | ... | |
|
|
||
|
}
|
||
|
|
||
|
@lost = ();
|
||
|
|
||
|
if (-f "lost") {
|
||
|
require "lost";
|
||
|
unlink "lost";
|
||
|
}
|
||
|
|
||
|
while (($text, $translation) = each %old_texts) {
|
||
|
while (my ($text, $translation) = each %old_texts) {
|
||
|
next if ($alllocales{$text});
|
||
|
|
||
|
push @lost, { 'text' => $text, 'translation' => $translation };
|
||
| ... | ... | |
|
"# This file will be auto-generated by locales.pl. Do not edit it.\n\n" .
|
||
|
"\@lost = (\n";
|
||
|
|
||
|
foreach $entry (@lost) {
|
||
|
foreach my $entry (@lost) {
|
||
|
$entry->{text} =~ s/\'/\\\'/g;
|
||
|
$entry->{translation} =~ s/\'/\\\'/g;
|
||
|
print FH " { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
|
||
| ... | ... | |
|
}
|
||
|
|
||
|
open(FH, "LANGUAGE");
|
||
|
@language = <FH>;
|
||
|
my @language = <FH>;
|
||
|
close(FH);
|
||
|
$trlanguage = $language[0];
|
||
|
my $trlanguage = $language[0];
|
||
|
chomp $trlanguage;
|
||
|
|
||
|
if ($opt_c) {
|
||
| ... | ... | |
|
search_translated_htmlfiles_wo_master();
|
||
|
}
|
||
|
|
||
|
$per = sprintf("%.1f", ($count - $notext) / $count * 100);
|
||
|
my $per = sprintf("%.1f", ($count - $notext) / $count * 100);
|
||
|
print "\n$trlanguage - ${per}%";
|
||
|
print " - $notext/$count missing" if $notext;
|
||
|
print "\n";
|
||
| ... | ... | |
|
# is this a sub ?
|
||
|
if (/^sub /) {
|
||
|
next if ($dont_include_subs);
|
||
|
($null, $subrt) = split / +/;
|
||
|
my $subrt = (split / +/)[1];
|
||
|
# $subrt{$subrt} = 1;
|
||
|
$cached{$file}{subr}{$subrt} = 1;
|
||
|
next;
|
||
| ... | ... | |
|
grep { s/(\[|\])//g } @a;
|
||
|
|
||
|
foreach my $item (@a) {
|
||
|
@b = split /--/, $item;
|
||
|
foreach $string (@b) {
|
||
|
my @b = split /--/, $item;
|
||
|
foreach my $string (@b) {
|
||
|
chomp $string;
|
||
|
$locale{$string} = 1;
|
||
|
$alllocales{$string} = 1;
|
||
Auch abrufbar als: Unified diff
locales.pl strict machen -- Teil 1
Conflicts: