Revision 3e0a049e
Von Sven Schöling vor mehr als 14 Jahren hinzugefügt
| locale/de/locales.pl | ||
|---|---|---|
| 6 | 6 |
# this version of locles processes not only all required .pl files |
| 7 | 7 |
# but also all parse_html_templated files. |
| 8 | 8 |
|
| 9 |
use strict; |
|
| 10 |
|
|
| 9 | 11 |
use Data::Dumper; |
| 12 |
use English; |
|
| 10 | 13 |
use FileHandle; |
| 11 | 14 |
use Getopt::Long; |
| 12 | 15 |
use List::Util qw(first); |
| 13 | 16 |
use POSIX; |
| 14 | 17 |
use Pod::Usage; |
| 15 | 18 |
|
| 16 |
$| = 1; |
|
| 19 |
$OUTPUT_AUTOFLUSH = 1; |
|
| 20 |
|
|
| 21 |
my $basedir = "../.."; |
|
| 22 |
my $bindir = "$basedir/bin/mozilla"; |
|
| 23 |
my $dbupdir = "$basedir/sql/Pg-upgrade"; |
|
| 24 |
my $dbupdir2 = "$basedir/sql/Pg-upgrade2"; |
|
| 25 |
my $menufile = "menu.ini"; |
|
| 26 |
my $submitsearch = qr/type\s*=\s*[\"\']?submit/i; |
|
| 17 | 27 |
|
| 18 |
$basedir = "../.."; |
|
| 19 |
$bindir = "$basedir/bin/mozilla"; |
|
| 20 |
$dbupdir = "$basedir/sql/Pg-upgrade"; |
|
| 21 |
$dbupdir2 = "$basedir/sql/Pg-upgrade2"; |
|
| 22 |
$menufile = "menu.ini"; |
|
| 23 |
$submitsearch = qr/type\s*=\s*[\"\']?submit/i; |
|
| 28 |
my (%referenced_html_files, %locale, %htmllocale, %alllocales, %cached, %submit, %subrt); |
|
| 24 | 29 |
|
| 25 |
%referenced_html_files = (); |
|
| 30 |
my $count = 0; |
|
| 31 |
my $notext = 0; |
|
| 26 | 32 |
|
| 27 |
my $opt_v = 0; |
|
| 28 |
my $opt_n = 0; |
|
| 29 |
my $opt_c = 0; |
|
| 33 |
my $debug = 0; |
|
| 34 |
|
|
| 35 |
my $opt_v = 0; |
|
| 36 |
my $opt_n = 0; |
|
| 37 |
my $opt_c = 0; |
|
| 30 | 38 |
|
| 31 | 39 |
sub parse_args {
|
| 32 | 40 |
my ($help, $man); |
| ... | ... | |
| 51 | 59 |
parse_args(); |
| 52 | 60 |
|
| 53 | 61 |
opendir DIR, "$bindir" or die "$!"; |
| 54 |
@progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
|
|
| 62 |
my @progfiles = grep { /\.pl$/ && !/(_|^\.)/ } readdir DIR;
|
|
| 55 | 63 |
seekdir DIR, 0; |
| 56 |
@customfiles = grep /_/, readdir DIR; |
|
| 64 |
my @customfiles = grep /_/, readdir DIR;
|
|
| 57 | 65 |
closedir DIR; |
| 58 | 66 |
|
| 59 | 67 |
# put customized files into @customfiles |
| 68 |
my @menufiles; |
|
| 60 | 69 |
|
| 61 | 70 |
if ($opt_n) {
|
| 62 | 71 |
@customfiles = (); |
| ... | ... | |
| 69 | 78 |
} |
| 70 | 79 |
|
| 71 | 80 |
opendir DIR, $dbupdir or die "$!"; |
| 72 |
@dbplfiles = grep { /\.pl$/ } readdir DIR;
|
|
| 81 |
my @dbplfiles = grep { /\.pl$/ } readdir DIR;
|
|
| 73 | 82 |
closedir DIR; |
| 74 | 83 |
|
| 75 | 84 |
opendir DIR, $dbupdir2 or die "$!"; |
| 76 |
@dbplfiles2 = grep { /\.pl$/ } readdir DIR;
|
|
| 85 |
my @dbplfiles2 = grep { /\.pl$/ } readdir DIR;
|
|
| 77 | 86 |
closedir DIR; |
| 78 | 87 |
|
| 79 | 88 |
# slurp the translations in |
| 89 |
my $self = {};
|
|
| 90 |
my $missing = {};
|
|
| 91 |
my @missing = (); |
|
| 92 |
my @lost = (); |
|
| 93 |
|
|
| 80 | 94 |
if (-f 'all') {
|
| 81 |
require "all"; |
|
| 95 |
require 'all'; |
|
| 96 |
} |
|
| 97 |
if (-f 'missing') {
|
|
| 98 |
require 'missing' ; |
|
| 99 |
unlink 'missing'; |
|
| 100 |
} |
|
| 101 |
if (-f 'lost') {
|
|
| 102 |
require 'lost'; |
|
| 103 |
unlink 'lost'; |
|
| 82 | 104 |
} |
| 83 | 105 |
|
| 84 |
my %old_texts = %{ $self->{texts} };
|
|
| 106 |
my %old_texts = %{ $self->{texts} || {} };
|
|
| 85 | 107 |
|
| 86 | 108 |
# Read HTML templates. |
| 87 | 109 |
#%htmllocale = (); |
| ... | ... | |
| 97 | 119 |
sub handle_file {
|
| 98 | 120 |
my ($file, $dir) = @_; |
| 99 | 121 |
print "\n$file" if $opt_v; |
| 100 |
%locale = (); |
|
| 101 |
%submit = (); |
|
| 102 |
%subrt = (); |
|
| 122 |
my %locale = ();
|
|
| 123 |
my %submit = ();
|
|
| 124 |
my %subrt = ();
|
|
| 103 | 125 |
|
| 104 | 126 |
&scanfile("$dir/$file");
|
| 105 | 127 |
|
| 106 | 128 |
# scan custom_{module}.pl or {login}_{module}.pl files
|
| 107 |
foreach $customfile (@customfiles) {
|
|
| 129 |
foreach my $customfile (@customfiles) {
|
|
| 108 | 130 |
if ($customfile =~ /_$file/) {
|
| 109 | 131 |
if (-f "$dir/$customfile") {
|
| 110 | 132 |
&scanfile("$dir/$customfile");
|
| ... | ... | |
| 114 | 136 |
|
| 115 | 137 |
# if this is the menu.pl file |
| 116 | 138 |
if ($file eq 'menu.pl') {
|
| 117 |
foreach $item (@menufiles) {
|
|
| 139 |
foreach my $item (@menufiles) {
|
|
| 118 | 140 |
&scanmenu("$basedir/$item");
|
| 119 | 141 |
} |
| 120 | 142 |
} |
| 121 | 143 |
|
| 122 | 144 |
if ($file eq 'menunew.pl') {
|
| 123 |
foreach $item (@menufiles) {
|
|
| 145 |
foreach my $item (@menufiles) {
|
|
| 124 | 146 |
&scanmenu("$basedir/$item");
|
| 125 | 147 |
print "." if $opt_v; |
| 126 | 148 |
} |
| ... | ... | |
| 128 | 150 |
|
| 129 | 151 |
$file =~ s/\.pl//; |
| 130 | 152 |
|
| 131 |
eval { require 'missing'; };
|
|
| 132 |
unlink 'missing'; |
|
| 133 |
|
|
| 134 |
foreach $text (keys %$missing) {
|
|
| 153 |
foreach my $text (keys %$missing) {
|
|
| 135 | 154 |
if ($locale{$text} || $htmllocale{$text}) {
|
| 136 | 155 |
unless ($self->{texts}{$text}) {
|
| 137 | 156 |
$self->{texts}{$text} = $missing->{$text};
|
| ... | ... | |
| 146 | 165 |
$self->{texts} = {
|
| 147 | 166 |
|; |
| 148 | 167 |
|
| 149 |
foreach $key (sort keys %locale) {
|
|
| 150 |
if ($self->{texts}{$key}) {
|
|
| 151 |
$text = $self->{texts}{$key};
|
|
| 152 |
} else {
|
|
| 153 |
$text = $key; |
|
| 154 |
} |
|
| 155 |
$text =~ s/'/\\'/g; |
|
| 156 |
$text =~ s/\\$/\\\\/; |
|
| 168 |
foreach my $key (sort keys %locale) {
|
|
| 169 |
my $text = $self->{texts}{$key} || $key;
|
|
| 170 |
$text =~ s/'/\\'/g; |
|
| 171 |
$text =~ s/\\$/\\\\/; |
|
| 157 | 172 |
|
| 158 |
$keytext = $key;
|
|
| 159 |
$keytext =~ s/'/\\'/g; |
|
| 160 |
$keytext =~ s/\\$/\\\\/; |
|
| 173 |
my $keytext = $key;
|
|
| 174 |
$keytext =~ s/'/\\'/g;
|
|
| 175 |
$keytext =~ s/\\$/\\\\/;
|
|
| 161 | 176 |
|
| 162 | 177 |
print FH qq| '$keytext'| |
| 163 | 178 |
. (' ' x (27 - length($keytext)))
|
| ... | ... | |
| 169 | 184 |
$self->{subs} = {
|
| 170 | 185 |
|; |
| 171 | 186 |
|
| 172 |
foreach $key (sort keys %subrt) {
|
|
| 173 |
$text = $key;
|
|
| 174 |
$text =~ s/'/\\'/g; |
|
| 175 |
$text =~ s/\\$/\\\\/; |
|
| 187 |
foreach my $key (sort keys %subrt) {
|
|
| 188 |
my $text = $key;
|
|
| 189 |
$text =~ s/'/\\'/g;
|
|
| 190 |
$text =~ s/\\$/\\\\/;
|
|
| 176 | 191 |
print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '$text',\n|;
|
| 177 | 192 |
} |
| 178 | 193 |
|
| 179 |
foreach $key (sort keys %submit) {
|
|
| 180 |
$text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
|
|
| 181 |
$text =~ s/'/\\'/g; |
|
| 182 |
$text =~ s/\\$/\\\\/; |
|
| 194 |
foreach my $key (sort keys %submit) {
|
|
| 195 |
my $text = ($self->{texts}{$key}) ? $self->{texts}{$key} : $key;
|
|
| 196 |
$text =~ s/'/\\'/g;
|
|
| 197 |
$text =~ s/\\$/\\\\/;
|
|
| 183 | 198 |
|
| 184 |
$english_sub = $key;
|
|
| 185 |
$english_sub =~ s/'/\\'/g; |
|
| 186 |
$english_sub =~ s/\\$/\\\\/; |
|
| 187 |
$english_sub = lc $key; |
|
| 199 |
my $english_sub = $key;
|
|
| 200 |
$english_sub =~ s/'/\\'/g;
|
|
| 201 |
$english_sub =~ s/\\$/\\\\/;
|
|
| 202 |
$english_sub = lc $key;
|
|
| 188 | 203 |
|
| 189 |
$translated_sub = lc $text;
|
|
| 190 |
$english_sub =~ s/( |-|,)/_/g; |
|
| 191 |
$translated_sub =~ s/( |-|,)/_/g; |
|
| 204 |
my $translated_sub = lc $text;
|
|
| 205 |
$english_sub =~ s/( |-|,)/_/g;
|
|
| 206 |
$translated_sub =~ s/( |-|,)/_/g;
|
|
| 192 | 207 |
print FH qq| '$translated_sub'| |
| 193 | 208 |
. (' ' x (27 - length($translated_sub)))
|
| 194 | 209 |
. qq| => '$english_sub',\n|; |
| ... | ... | |
| 221 | 236 |
$self->{texts} = {
|
| 222 | 237 |
|; |
| 223 | 238 |
|
| 224 |
foreach $key (sort keys %alllocales) {
|
|
| 225 |
$text = $self->{texts}{$key};
|
|
| 239 |
foreach my $key (sort keys %alllocales) {
|
|
| 240 |
my $text = $self->{texts}{$key};
|
|
| 226 | 241 |
|
| 227 | 242 |
$count++; |
| 228 | 243 |
|
| ... | ... | |
| 257 | 272 |
$missing = {
|
| 258 | 273 |
|; |
| 259 | 274 |
|
| 260 |
foreach $text (@missing) {
|
|
| 275 |
foreach my $text (@missing) {
|
|
| 261 | 276 |
print FH qq| '$text'| . (' ' x (27 - length($text))) . qq| => '',\n|;
|
| 262 | 277 |
} |
| 263 | 278 |
|
| ... | ... | |
| 270 | 285 |
|
| 271 | 286 |
} |
| 272 | 287 |
|
| 273 |
@lost = (); |
|
| 274 |
|
|
| 275 |
if (-f "lost") {
|
|
| 276 |
require "lost"; |
|
| 277 |
unlink "lost"; |
|
| 278 |
} |
|
| 279 |
|
|
| 280 |
while (($text, $translation) = each %old_texts) {
|
|
| 288 |
while (my ($text, $translation) = each %old_texts) {
|
|
| 281 | 289 |
next if ($alllocales{$text});
|
| 282 | 290 |
|
| 283 | 291 |
push @lost, { 'text' => $text, 'translation' => $translation };
|
| ... | ... | |
| 292 | 300 |
"# This file will be auto-generated by locales.pl. Do not edit it.\n\n" . |
| 293 | 301 |
"\@lost = (\n"; |
| 294 | 302 |
|
| 295 |
foreach $entry (@lost) {
|
|
| 303 |
foreach my $entry (@lost) {
|
|
| 296 | 304 |
$entry->{text} =~ s/\'/\\\'/g;
|
| 297 | 305 |
$entry->{translation} =~ s/\'/\\\'/g;
|
| 298 | 306 |
print FH " { 'text' => '$entry->{text}', 'translation' => '$entry->{translation}' },\n";
|
| ... | ... | |
| 303 | 311 |
} |
| 304 | 312 |
|
| 305 | 313 |
open(FH, "LANGUAGE"); |
| 306 |
@language = <FH>; |
|
| 314 |
my @language = <FH>;
|
|
| 307 | 315 |
close(FH); |
| 308 |
$trlanguage = $language[0]; |
|
| 316 |
my $trlanguage = $language[0];
|
|
| 309 | 317 |
chomp $trlanguage; |
| 310 | 318 |
|
| 311 | 319 |
if ($opt_c) {
|
| ... | ... | |
| 313 | 321 |
search_translated_htmlfiles_wo_master(); |
| 314 | 322 |
} |
| 315 | 323 |
|
| 316 |
$per = sprintf("%.1f", ($count - $notext) / $count * 100);
|
|
| 324 |
my $per = sprintf("%.1f", ($count - $notext) / $count * 100);
|
|
| 317 | 325 |
print "\n$trlanguage - ${per}%";
|
| 318 | 326 |
print " - $notext/$count missing" if $notext; |
| 319 | 327 |
print "\n"; |
| ... | ... | |
| 430 | 438 |
# is this a sub ? |
| 431 | 439 |
if (/^sub /) {
|
| 432 | 440 |
next if ($dont_include_subs); |
| 433 |
($null, $subrt) = split / +/;
|
|
| 441 |
my $subrt = (split / +/)[1];
|
|
| 434 | 442 |
# $subrt{$subrt} = 1;
|
| 435 | 443 |
$cached{$file}{subr}{$subrt} = 1;
|
| 436 | 444 |
next; |
| ... | ... | |
| 525 | 533 |
grep { s/(\[|\])//g } @a;
|
| 526 | 534 |
|
| 527 | 535 |
foreach my $item (@a) {
|
| 528 |
@b = split /--/, $item; |
|
| 529 |
foreach $string (@b) {
|
|
| 536 |
my @b = split /--/, $item;
|
|
| 537 |
foreach my $string (@b) {
|
|
| 530 | 538 |
chomp $string; |
| 531 | 539 |
$locale{$string} = 1;
|
| 532 | 540 |
$alllocales{$string} = 1;
|
Auch abrufbar als: Unified diff
locales.pl strict machen -- Teil 1
Conflicts: