| 8 |
|
|
| 9 |
# This is GPL'ed code. |
# This is GPL'ed code. |
| 10 |
# Copyright 1998 Paolo Molaro <lupus@debian.org>. |
# Copyright 1998 Paolo Molaro <lupus@debian.org>. |
| 11 |
|
# Copyright 1999-2002 Peter Karlsson <peterk@debian.org>. |
| 12 |
# Copyright 2000,2001 Martin Quinson <mquinson@ens-lyon.fr>. |
# Copyright 2000,2001 Martin Quinson <mquinson@ens-lyon.fr>. |
| 13 |
|
|
| 14 |
# Invocation: |
# Invocation: |
| 199 |
|
|
| 200 |
print "\$translations = {\n" if $opt_t eq 'perl'; |
print "\$translations = {\n" if $opt_t eq 'perl'; |
| 201 |
|
|
| 202 |
|
# Check the files in the English directory |
| 203 |
|
|
| 204 |
$cvs->readinfo($from); |
$cvs->readinfo($from); |
| 205 |
foreach my $path (@{$cvs->dirs()}) { |
foreach my $path (@{$cvs->dirs()}) { |
| 206 |
my $tpath = $path; |
my $tpath = $path; |
| 214 |
} |
} |
| 215 |
} |
} |
| 216 |
|
|
| 217 |
|
my %checkedfile; |
| 218 |
|
|
| 219 |
foreach (sort @{$cvs->files()}) { |
foreach (sort @{$cvs->files()}) { |
| 220 |
my ($path, $tpath); |
my ($path, $tpath); |
| 221 |
$path = $_; |
$path = $_; |
| 222 |
$tpath = $path; |
$tpath = $path; |
| 223 |
$tpath =~ s/^$from/$to/o; |
$tpath =~ s/^$from/$to/o; |
| 224 |
|
$checkedfile{$tpath} = 1; # Remember which files we found here |
| 225 |
check_file($tpath, |
check_file($tpath, |
| 226 |
$cvs->revision($path), |
$cvs->revision($path), |
| 227 |
str2time($cvs->date($path)), |
str2time($cvs->date($path)), |
| 228 |
get_translators_from_db($tpath)); |
get_translators_from_db($tpath)); |
| 229 |
} |
} |
| 230 |
|
|
| 231 |
|
# Now check all the files in the translated directory as well, there may be |
| 232 |
|
# some files that are not available in the English version. |
| 233 |
|
|
| 234 |
|
$cvs->reset(); |
| 235 |
|
$cvs->readinfo($to); |
| 236 |
|
foreach my $tpath (@{$cvs->dirs()}) |
| 237 |
|
{ |
| 238 |
|
my $transignore = Webwml::TransIgnore->new($tpath); |
| 239 |
|
next unless $transignore->found(); |
| 240 |
|
warn "Loading $tpath/.transignore\n" if $opt_v; |
| 241 |
|
foreach (@{$transignore->local()}) |
| 242 |
|
{ |
| 243 |
|
s/^$to/$from/o; |
| 244 |
|
$cvs->removefile($_); |
| 245 |
|
} |
| 246 |
|
} |
| 247 |
|
|
| 248 |
|
foreach (sort @{$cvs->files()}) |
| 249 |
|
{ |
| 250 |
|
my $tpath = $_; |
| 251 |
|
next if defined $checkedfile{$tpath}; # Don't look at a file twice |
| 252 |
|
warn "$tpath does not match anything in English\n" if $opt_v; |
| 253 |
|
check_file($tpath, undef, undef, get_translators_from_db($tpath)); |
| 254 |
|
} |
| 255 |
|
|
| 256 |
print "}; 1;\n" if $opt_t eq 'perl'; |
print "}; 1;\n" if $opt_t eq 'perl'; |
| 257 |
|
|
| 258 |
send_mails(); |
send_mails(); |
| 430 |
|
|
| 431 |
sub check_file { |
sub check_file { |
| 432 |
my ($name, $revision, $mtime, $translator) = @_; |
my ($name, $revision, $mtime, $translator) = @_; |
| 433 |
|
$revision ||= 'n/a'; |
| 434 |
my ($oldr, $oldname, $original); |
my ($oldr, $oldname, $original); |
| 435 |
warn "Checking $name, English revision $revision\n" if $opt_v; |
warn "Checking $name, English revision $revision\n" if $opt_v; |
| 436 |
my $docname = $name; |
my $docname = $name; |
| 486 |
$translator =~ s/\s+$//; |
$translator =~ s/\s+$//; |
| 487 |
|
|
| 488 |
my $str; |
my $str; |
| 489 |
my $status = 8; |
my $status = 8; # Unknown |
| 490 |
(my $numrev) = $revision =~ m/^1\.(\d+)$/; $numrev ||= "0"; |
(my $numrev) = $revision =~ m/^1\.(\d+)$/; $numrev ||= "0"; |
| 491 |
(my $numoldr) = $oldr =~ m/^1\.(\d+)$/; $numoldr ||= "0"; |
(my $numoldr) = $oldr =~ m/^1\.(\d+)$/; $numoldr ||= "0"; |
| 492 |
if (!$oldr) { |
|
| 493 |
$oldr = '1.0'; |
if ($revision ne 'n/a') |
| 494 |
$str = "Unknown status of $name (revision should be $revision)"; |
{ |
| 495 |
} elsif ($oldr eq $revision) { |
# The original version of this file exists (English or otherwise) |
| 496 |
$status = 4; |
# - compare the translated version number to the original |
| 497 |
} elsif ($numoldr > $numrev) { |
if (!$oldr) { |
| 498 |
$str = "Broken revision number $oldr for $name, it should be $revision"; |
$oldr = '1.0'; |
| 499 |
} else { |
$str = "Unknown status of $name (revision should be $revision)"; |
| 500 |
$str = "NeedToUpdate $name from version $oldr to version $revision"; |
} elsif ($oldr eq $revision) { |
| 501 |
$status = 3; |
$status = 4; # Up-to-date |
| 502 |
} |
} elsif ($numoldr > $numrev) { |
| 503 |
|
$str = "Broken revision number $oldr for $name, it should be $revision"; |
| 504 |
|
} else { |
| 505 |
|
$str = "NeedToUpdate $name from version $oldr to version $revision"; |
| 506 |
|
$status = 3; # Needs update |
| 507 |
|
} |
| 508 |
|
} |
| 509 |
|
else |
| 510 |
|
{ |
| 511 |
|
# There is no English file matching this one. |
| 512 |
|
if ($oldr eq '0') |
| 513 |
|
{ |
| 514 |
|
# There is no translation-check header, so it must be the |
| 515 |
|
# original version, and is thus always up-to-date. |
| 516 |
|
$status = 4; # Up-to-date |
| 517 |
|
} |
| 518 |
|
else |
| 519 |
|
{ |
| 520 |
|
# There is a translation-check header referencing an English |
| 521 |
|
# version, which means that the English file has been removed. |
| 522 |
|
$status = 7; # Obsolete |
| 523 |
|
$str = "Obsolete $name"; |
| 524 |
|
} |
| 525 |
|
} |
| 526 |
|
|
| 527 |
$str .= " (maintainer: $translator)" if $translator; |
$str .= " (maintainer: $translator)" if $translator; |
| 528 |
if ($opt_t eq 'perl') { |
if ($opt_t eq 'perl') { |
| 529 |
print "'$docname' => {\n\t'type' => 'Web',\n"; |
print "'$docname' => {\n\t'type' => 'Web',\n"; |
Parent Directory
| 
Revision Log
| 
Patch