| 1 |
#!/usr/bin/perl -w
|
| 2 |
|
| 3 |
# This is a little utility designed to keep track of translations
|
| 4 |
# in the Debian web site CVS repository.
|
| 5 |
|
| 6 |
# For information about translation revisions please see
|
| 7 |
# http://www.debian.org/devel/website/uptodate
|
| 8 |
|
| 9 |
# This is GPL'ed code.
|
| 10 |
# 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>.
|
| 13 |
|
| 14 |
# Invocation:
|
| 15 |
# check_trans.pl [-vqdlM] [-C dir] [-p pattern] [-s subtree]
|
| 16 |
# [-m email -n N] [-c charset] [-g] [-t outputtype]
|
| 17 |
# [language]
|
| 18 |
|
| 19 |
# It needs to be run from the top level webwml directory.
|
| 20 |
# If you don't specify a language on the command line, the language name
|
| 21 |
# will be loaded from a file called language.conf, if such a file exists.
|
| 22 |
|
| 23 |
# For example:
|
| 24 |
# $ check_trans.pl -v italian
|
| 25 |
# You may also check only some subtrees as in:
|
| 26 |
# $ check_trans.pl -s devel italian
|
| 27 |
|
| 28 |
# Options:
|
| 29 |
# -v enable verbose mode
|
| 30 |
# -q just don't whine about missing files
|
| 31 |
# -Q enable really quiet mode
|
| 32 |
# -C <dir> go to <dir> directory before running this script
|
| 33 |
# -d output CVS diffs
|
| 34 |
# -l output CVS log messages
|
| 35 |
# -T output translated diffs
|
| 36 |
# -p <pattern> include only files matching <pattern>,
|
| 37 |
# default is *.html|*.wml
|
| 38 |
# -s <subtree> check only that subtree
|
| 39 |
# -t <type> choose output type (default is `text')
|
| 40 |
# -M display differences for all 'Makefile's
|
| 41 |
|
| 42 |
# Options useful when sending mails:
|
| 43 |
# -m <email> sends mails to translation maintainers
|
| 44 |
# PLEASE CAREFULLY READ THE BELOW TEXT ABOUT MAKING MAILS!
|
| 45 |
# <email> is the default recipient
|
| 46 |
# (it should be the list used for organisation,
|
| 47 |
# e.g. debian-l10n-french@lists.debian.org)
|
| 48 |
# -g debuG
|
| 49 |
# -c <charset> charset used in mails
|
| 50 |
# -n <1|2|3> send mails of priority upper or equal to
|
| 51 |
# 1 (monthly), 2 (weekly) or 3 (daily)
|
| 52 |
|
| 53 |
# Making Mails
|
| 54 |
# If you want to, this script send mails to the maintainer of the mails.
|
| 55 |
# BEWARE, SOME PEOPLE DO NOT LIKE TO RECEIVE AUTOMATIC MAILS!
|
| 56 |
|
| 57 |
# PREREQUISITES:
|
| 58 |
# You will need two databases:
|
| 59 |
# - one in which to see which translator maintains which file
|
| 60 |
# it must be named "./$langto/international/$langto/current_status.pl"
|
| 61 |
# (where $langto equals "french", "italian" or so)
|
| 62 |
# See webwml/french/international/french/current_status.pl" for example.
|
| 63 |
# - one in which to get info about translators and the frequency at
|
| 64 |
# which they want to get mails. It must be named
|
| 65 |
# webwml/$langto/international/$langto/translator.db.pl
|
| 66 |
# Please refer to the French one for more info.
|
| 67 |
|
| 68 |
# USAGE:
|
| 69 |
# If you give the "-g" option, all mails are sent to the default addressee
|
| 70 |
# (i.e. the one given as value to the -m option), without respect to their
|
| 71 |
# normal addressee. It is useful if you want to run it for yourself,
|
| 72 |
# and for debugging.
|
| 73 |
# Without that option, it sends real mails to real addresses.
|
| 74 |
# MAKE SURE THE ADDRESSEES REALLY WANT TO GET THESE MAILS
|
| 75 |
|
| 76 |
use strict;
|
| 77 |
use Getopt::Std;
|
| 78 |
use IO::Handle;
|
| 79 |
use Date::Parse;
|
| 80 |
|
| 81 |
# These modules reside under webwml/Perl
|
| 82 |
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
|
| 83 |
use Local::Cvsinfo;
|
| 84 |
use Local::WmlDiffTrans;
|
| 85 |
use Webwml::TransCheck;
|
| 86 |
use Webwml::TransIgnore;
|
| 87 |
|
| 88 |
# TODO:
|
| 89 |
# get the revisions from $lang/intl/$lang so diffing works
|
| 90 |
# need to quote dirnames?
|
| 91 |
# use a file to bind a file to a translator?
|
| 92 |
|
| 93 |
# global db variables
|
| 94 |
my $translations_status;
|
| 95 |
my $translators;# the ref resulting of require
|
| 96 |
my %translators;# the real hash
|
| 97 |
|
| 98 |
# misc hardcoded things
|
| 99 |
my $maintainer = "mquinson\@ens-lyon.fr"; # the default e-mail at which to bitch :-)
|
| 100 |
|
| 101 |
# options (note: with perl 5.6, this could change to our())
|
| 102 |
use vars qw($opt_C $opt_M $opt_Q $opt_c $opt_d $opt_g $opt_l $opt_m $opt_n $opt_p $opt_q $opt_s $opt_t $opt_T $opt_v);
|
| 103 |
$opt_n = 5; # an invalid default
|
| 104 |
$opt_s = '';
|
| 105 |
$opt_C = '.';
|
| 106 |
$opt_t = 'text';
|
| 107 |
|
| 108 |
unless (getopts('vgdqQC:m:c:s:Tt:p:ln:M'))
|
| 109 |
{
|
| 110 |
open SELF, "<$0" or die "Unable to display help: $!\n";
|
| 111 |
HELP: while (<SELF>)
|
| 112 |
{
|
| 113 |
print, next if /^$/;
|
| 114 |
last HELP if (/^use/);
|
| 115 |
s/^# ?//;
|
| 116 |
next if /^!/;
|
| 117 |
print;
|
| 118 |
}
|
| 119 |
exit;
|
| 120 |
}
|
| 121 |
|
| 122 |
die "you can't have both verbose and quiet, doh!\n" if (($opt_v) && ($opt_Q));
|
| 123 |
|
| 124 |
warn "Checking subtree $opt_s only\n" if (($opt_v) && ($opt_s));
|
| 125 |
|
| 126 |
# include only files matching $filename
|
| 127 |
my $filename = $opt_p || '(\.wml$)|(\.html$)';
|
| 128 |
|
| 129 |
# Go to desired directory
|
| 130 |
chdir($opt_C) || die "Cannot go to $opt_C\n";
|
| 131 |
|
| 132 |
my $cvs = Local::Cvsinfo->new();
|
| 133 |
$cvs->options(
|
| 134 |
recursive => 1,
|
| 135 |
matchfile => [ $filename ],
|
| 136 |
skipdir => [ "template" ],
|
| 137 |
);
|
| 138 |
# This object is used to retrieve information when original is
|
| 139 |
# not English
|
| 140 |
my $altcvs = $cvs->new();
|
| 141 |
|
| 142 |
# Global .transignore
|
| 143 |
my $globtrans = Webwml::TransIgnore->new(".");
|
| 144 |
|
| 145 |
# language configuration
|
| 146 |
my $defaultlanguage = 'italian';
|
| 147 |
if (exists $ENV{DWWW_LANG})
|
| 148 |
{
|
| 149 |
$defaultlanguage = $ENV{DWWW_LANG};
|
| 150 |
}
|
| 151 |
elsif (open CONF, "<language.conf")
|
| 152 |
{
|
| 153 |
$defaultlanguage = <CONF>;
|
| 154 |
chomp $defaultlanguage;
|
| 155 |
close CONF;
|
| 156 |
}
|
| 157 |
|
| 158 |
my $from = 'english';
|
| 159 |
my $to = shift || $defaultlanguage;
|
| 160 |
$to =~ s%/$%%; # Remove slash from the end
|
| 161 |
|
| 162 |
my $langto = $to;
|
| 163 |
$langto =~ s,^([^/]*).*$,$1,;
|
| 164 |
if (-e "./$langto/international/$langto/current_status.pl" &&
|
| 165 |
-e "./$langto/international/$langto/translator.db.pl") {
|
| 166 |
print "READ PAGES DB: $langto/international/$langto/current_status.pl\n"
|
| 167 |
if $opt_v;
|
| 168 |
push(@INC,"./$langto/international/$langto");
|
| 169 |
require 'current_status.pl';
|
| 170 |
print "READ TRANSLATOR DB: $langto/international/$langto/translator.db.pl\n"
|
| 171 |
if $opt_v;
|
| 172 |
require 'translator.db.pl';
|
| 173 |
%translators=%{init_translators()};
|
| 174 |
if (defined($translators{default})) {
|
| 175 |
my @field_list = keys %{$translators{default}};
|
| 176 |
foreach my $user (keys %translators) {
|
| 177 |
next unless $user =~ m/ /;
|
| 178 |
foreach my $f (@field_list) {
|
| 179 |
$translators{$user}{$f} = $translators{default}{$f}
|
| 180 |
unless defined($translators{$user}{$f});
|
| 181 |
}
|
| 182 |
}
|
| 183 |
}
|
| 184 |
} else {
|
| 185 |
die "I need my DBs to send mails !\n Please read the comments in the script and try again\n" if $opt_m;
|
| 186 |
}
|
| 187 |
|
| 188 |
if ($opt_m) {
|
| 189 |
unless ($opt_n =~ m,[123],) {
|
| 190 |
die "Invalid priority. Please set -n value to 1, 2 or 3.\n".
|
| 191 |
"(assuming you know what you're doing)\n";
|
| 192 |
}
|
| 193 |
}
|
| 194 |
|
| 195 |
$from = "$from/$opt_s";
|
| 196 |
$to = "$to/$opt_s";
|
| 197 |
|
| 198 |
init_mails();
|
| 199 |
|
| 200 |
print "\$translations = {\n" if $opt_t eq 'perl';
|
| 201 |
|
| 202 |
# Check the files in the English directory
|
| 203 |
|
| 204 |
$cvs->readinfo($from);
|
| 205 |
foreach my $path (@{$cvs->dirs()}) {
|
| 206 |
my $tpath = $path;
|
| 207 |
$tpath =~ s/^$from/$to/o;
|
| 208 |
my $transignore = Webwml::TransIgnore->new($tpath);
|
| 209 |
next unless $transignore->found();
|
| 210 |
warn "Loading $tpath/.transignore\n" if $opt_v;
|
| 211 |
foreach (@{$transignore->local()}) {
|
| 212 |
s/^$to/$from/o;
|
| 213 |
$cvs->removefile($_);
|
| 214 |
}
|
| 215 |
}
|
| 216 |
|
| 217 |
my %checkedfile;
|
| 218 |
|
| 219 |
foreach (sort @{$cvs->files()}) {
|
| 220 |
my ($path, $tpath);
|
| 221 |
$path = $_;
|
| 222 |
$tpath = $path;
|
| 223 |
$tpath =~ s/^$from/$to/o;
|
| 224 |
$checkedfile{$tpath} = 1; # Remember which files we found here
|
| 225 |
check_file($tpath,
|
| 226 |
$cvs->revision($path),
|
| 227 |
str2time($cvs->date($path)),
|
| 228 |
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';
|
| 257 |
|
| 258 |
send_mails();
|
| 259 |
|
| 260 |
if ($opt_M) {
|
| 261 |
foreach my $makefile (split(/\n/, `find $from -name Makefile -print`)) {
|
| 262 |
my $destination = $makefile;
|
| 263 |
$destination =~ s/^$from/$to/o;
|
| 264 |
if (-e $destination) {
|
| 265 |
STDOUT->flush;
|
| 266 |
system("diff -u $destination $makefile");
|
| 267 |
STDOUT->flush;
|
| 268 |
}
|
| 269 |
}
|
| 270 |
}
|
| 271 |
|
| 272 |
sub verify_send {
|
| 273 |
return 1 unless ($opt_m);
|
| 274 |
# returns true whether we have to send this part to this guy
|
| 275 |
my $name=shift;
|
| 276 |
my $part=shift;
|
| 277 |
$name =~ s,<.*?>,,;
|
| 278 |
$name =~ s,^ *(.*?) *$,$1,;
|
| 279 |
print "$name is unknown\n" unless defined($translators{$name});
|
| 280 |
# print "pri=$opt_n ; maint_pri=${translators{$name}{$part}}\n";
|
| 281 |
return $opt_m # if we have to send any mail
|
| 282 |
&& defined($translators{$name}) # if this guy is known
|
| 283 |
&& defined($translators{$name}{$part}) # we know something about the wanted frequency
|
| 284 |
&& ($opt_n <= $translators{$name}{$part}); # check if the frequency is ok
|
| 285 |
}
|
| 286 |
|
| 287 |
sub get_translators_from_db {
|
| 288 |
my $id=shift;
|
| 289 |
my $res='';
|
| 290 |
|
| 291 |
$id=~ s,^$langto/,,;
|
| 292 |
$id=~ s/\.wml$//;
|
| 293 |
if (defined(%{$$translations_status{$id}})
|
| 294 |
&& defined ($$translations_status{$id}{'translation_maintainer'})) {
|
| 295 |
foreach my $n (sort @{$$translations_status{$id}{'translation_maintainer'}}) {
|
| 296 |
$res .= " $n";
|
| 297 |
}
|
| 298 |
} else {
|
| 299 |
$res = "";
|
| 300 |
}
|
| 301 |
return $res;
|
| 302 |
}
|
| 303 |
|
| 304 |
sub init_mails {
|
| 305 |
return unless $opt_m;
|
| 306 |
eval q{use MIME::Lite};
|
| 307 |
foreach my $name (keys %translators) {
|
| 308 |
return if defined $translators{$name}{"msg"};
|
| 309 |
next if $name eq 'default' || $translators{$name}{email} eq '';
|
| 310 |
$translators{$name}{"msg"} = MIME::Lite->new(
|
| 311 |
From => "Script watching translation state <$maintainer>",
|
| 312 |
To => ($opt_g ? $opt_m : $translators{$name}{"email"}),
|
| 313 |
Subject => $translators{$name}{mailsubject},
|
| 314 |
Type => 'multipart/mixed');
|
| 315 |
my $str;
|
| 316 |
{
|
| 317 |
open (MAIL, "< $translators{$name}{mailbody}")
|
| 318 |
or die "$name: Unable to read \`$translators{$name}{mailbody}'";
|
| 319 |
local $/ = undef;
|
| 320 |
$str= <MAIL>;
|
| 321 |
close (MAIL);
|
| 322 |
}
|
| 323 |
1 while ($str =~ s/#(.*?)#/eval $1/ge);
|
| 324 |
|
| 325 |
my $part = MIME::Lite->new(
|
| 326 |
Type => 'TEXT',
|
| 327 |
Data => $str);
|
| 328 |
$part->attr('content-type.charset' => $opt_c) if $opt_c;
|
| 329 |
$translators{$name}{"msg"}->attach($part);
|
| 330 |
$translators{$name}{"send"}=0;
|
| 331 |
}
|
| 332 |
}
|
| 333 |
|
| 334 |
sub send_mails {
|
| 335 |
#Makes the mails and send them
|
| 336 |
return unless $opt_m;
|
| 337 |
foreach my $name (sort keys %translators) {
|
| 338 |
next if $name eq 'default' || $translators{$name}{email} eq '';
|
| 339 |
$translators{$name}{"msg"}->attach(
|
| 340 |
Type => 'TEXT',
|
| 341 |
Filename => 'NeedToUpdate_summary',
|
| 342 |
Data => $translators{$name}{"part_summary"})
|
| 343 |
if defined($translators{$name}{"part_summary"});
|
| 344 |
$translators{$name}{"msg"}->attach(
|
| 345 |
Type => 'TEXT',
|
| 346 |
Filename => 'Missing_summary',
|
| 347 |
Data => $translators{$name}{"part_missing"})
|
| 348 |
if defined($translators{$name}{"part_missing"});
|
| 349 |
foreach my $part (qw (file logs diff tdiff)) {
|
| 350 |
if (defined($translators{$name}{"part_$part"})) {
|
| 351 |
foreach my $file (sort keys %{$translators{$name}{"part_$part"}}) {
|
| 352 |
$translators{$name}{"msg"}->attach(
|
| 353 |
Type => 'TEXT',
|
| 354 |
Filename => "$file.$part",
|
| 355 |
Data => $translators{$name}{"part_$part"}{$file});
|
| 356 |
}
|
| 357 |
}
|
| 358 |
}
|
| 359 |
if ($translators{$name}{"send"}) {
|
| 360 |
print "send mail to $name\n" unless $opt_Q;
|
| 361 |
if (($name =~ m,mquinson,) || ($opt_g && $opt_m eq $maintainer)) {
|
| 362 |
print "Well, detourned to $maintainer\n" unless $opt_Q;
|
| 363 |
$translators{$name}{"msg"}->send;
|
| 364 |
}
|
| 365 |
# $translators{$name}{"msg"}->print_header;
|
| 366 |
$translators{$name}{"msg"}->send;
|
| 367 |
} else {
|
| 368 |
print "didn't send mail to $name: nothing to say to him\n" unless $opt_Q;
|
| 369 |
}
|
| 370 |
}
|
| 371 |
}
|
| 372 |
|
| 373 |
sub add_part {
|
| 374 |
my $name = shift;
|
| 375 |
my $part = shift;
|
| 376 |
my $txt = shift;
|
| 377 |
$name =~ s,<.*?>,,;
|
| 378 |
$name =~ s,^ *(.*?) *$,$1,;
|
| 379 |
if (verify_send($name,$part)) {
|
| 380 |
$translators{$name}{"part_$part"}.=$txt;
|
| 381 |
$translators{$name}{"send"}=1;
|
| 382 |
}
|
| 383 |
}
|
| 384 |
|
| 385 |
sub add_sub_part {
|
| 386 |
my $name = shift;
|
| 387 |
my $part = shift;
|
| 388 |
my $subpart=shift;
|
| 389 |
my $txt = shift;
|
| 390 |
$name =~ s,<.*?>,,;
|
| 391 |
$name =~ s,^ *(.*?) *$,$1,;
|
| 392 |
# print "add_sub_part($name)(part=$part)($subpart):$txt" if $opt_v;
|
| 393 |
STDOUT->flush;
|
| 394 |
if (verify_send($name,$part)) {
|
| 395 |
# print "YES\n";
|
| 396 |
$translators{$name}{"part_$part"}{$subpart}.= "$txt";
|
| 397 |
$translators{$name}{"send"}=1;
|
| 398 |
}
|
| 399 |
# print "no\n";
|
| 400 |
}
|
| 401 |
|
| 402 |
sub get_diff_txt {
|
| 403 |
my ($oldr, $revision, $oldname, $name) = @_;
|
| 404 |
my $cmd;
|
| 405 |
|
| 406 |
# Get old revision file
|
| 407 |
$cmd = "cvs -z3 update -r $oldr -p $oldname 2>/dev/null";
|
| 408 |
# print "!get_diff_txt: cvs -z3 update -r ".$oldr." -p ".$oldname."\n";
|
| 409 |
my @old_rev_file_lines = qx($cmd);
|
| 410 |
|
| 411 |
# Get translation file
|
| 412 |
open (FILE,"$name") || die ("Can't open `$name' for read");
|
| 413 |
my @translation_file_lines;
|
| 414 |
while (<FILE>) {
|
| 415 |
$translation_file_lines[scalar @translation_file_lines] = $_;
|
| 416 |
}
|
| 417 |
close FILE || die ("Can't close $name after reading");
|
| 418 |
|
| 419 |
# Get diff lines
|
| 420 |
$cmd = "cvs -z3 diff -u -r$oldr -r $revision $oldname 2>/dev/null";
|
| 421 |
# print "get_diff_txt: $cmd: cvs -z3 diff -u -r$oldr -r $revision $oldname\n";
|
| 422 |
my @diff_lines = qx($cmd);
|
| 423 |
|
| 424 |
my $txt = Local::WmlDiffTrans::find_trans_parts(\@old_rev_file_lines,
|
| 425 |
\@translation_file_lines,
|
| 426 |
\@diff_lines);
|
| 427 |
|
| 428 |
return $txt;
|
| 429 |
}
|
| 430 |
|
| 431 |
sub check_file {
|
| 432 |
my ($name, $revision, $mtime, $translator) = @_;
|
| 433 |
$revision ||= 'n/a';
|
| 434 |
my ($oldr, $oldname, $original, $fromname);
|
| 435 |
warn "Checking $name, English revision $revision\n" if $opt_v;
|
| 436 |
my $docname = $name;
|
| 437 |
$docname =~ s#^$langto/##;
|
| 438 |
$docname =~ s#\.wml$##;
|
| 439 |
unless (-r $name) {
|
| 440 |
(my $iname = $name) =~ s/^$to//o;
|
| 441 |
if (!$globtrans->is_global($iname)) {
|
| 442 |
unless (($opt_q) || ($opt_Q)) {
|
| 443 |
if ($opt_t eq 'perl') {
|
| 444 |
print "'$docname' => {\n\t'type' => 'Web',\n";
|
| 445 |
print "\t'revision' => '$revision',\n";
|
| 446 |
print "\t'mtime' => '$mtime',\n";
|
| 447 |
print "\t'status' => 1,\n";
|
| 448 |
print "},\n";
|
| 449 |
} else {
|
| 450 |
print "Missing $name version $revision\n";
|
| 451 |
}
|
| 452 |
add_part("untranslated","missing","Missing $name version $revision\n");
|
| 453 |
}
|
| 454 |
} else {
|
| 455 |
warn "Ignored $name\n" if $opt_v;
|
| 456 |
}
|
| 457 |
return;
|
| 458 |
}
|
| 459 |
my $transcheck = Webwml::TransCheck->new($name);
|
| 460 |
$oldr = $transcheck->revision() || 0;
|
| 461 |
if (!$oldr && ($name =~ m#$langto/international/$langto#i)) {
|
| 462 |
# This document is original, check for
|
| 463 |
# english/international/$langto...
|
| 464 |
$name =~ s{^$to}{$from};
|
| 465 |
$transcheck = Webwml::TransCheck->new($name);
|
| 466 |
$oldr = $transcheck->revision() || 0;
|
| 467 |
}
|
| 468 |
$translator = $transcheck->maintainer() || "";
|
| 469 |
$original = $transcheck->original();
|
| 470 |
warn "Found translation for $oldr\n" if $opt_v and $oldr;
|
| 471 |
warn "Translated by $translator\n" if $opt_v and $translator;
|
| 472 |
warn "Original is $original\n" if $opt_v and $original;
|
| 473 |
if ($original) {
|
| 474 |
my ($fromdir);
|
| 475 |
$fromname = $name;
|
| 476 |
$fromname =~ s{^[^/]+}{$original};
|
| 477 |
$fromdir = $fromname;
|
| 478 |
$fromdir =~ s{/+[^/]+$}{};
|
| 479 |
$altcvs->reset();
|
| 480 |
$altcvs->readinfo($fromdir, matchfile => [$fromname]);
|
| 481 |
$revision = $altcvs->revision($fromname);
|
| 482 |
warn "Original is $original, revision $revision\n" if $opt_v;
|
| 483 |
}
|
| 484 |
|
| 485 |
$translator =~ s/^\s+//;
|
| 486 |
$translator =~ s/\s+$//;
|
| 487 |
|
| 488 |
my $str;
|
| 489 |
my $status = 8; # Unknown
|
| 490 |
(my $numrev) = $revision =~ m/^1\.(\d+)$/; $numrev ||= "0";
|
| 491 |
(my $numoldr) = $oldr =~ m/^1\.(\d+)$/; $numoldr ||= "0";
|
| 492 |
|
| 493 |
if ($revision ne 'n/a')
|
| 494 |
{
|
| 495 |
# The original version of this file exists (English or otherwise)
|
| 496 |
# - compare the translated version number to the original
|
| 497 |
if (!$oldr) {
|
| 498 |
$oldr = '1.0';
|
| 499 |
$str = "Unknown status of $name (revision should be $revision)";
|
| 500 |
} elsif ($oldr eq $revision) {
|
| 501 |
$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;
|
| 528 |
if ($opt_t eq 'perl') {
|
| 529 |
print "'$docname' => {\n\t'type' => 'Web',\n";
|
| 530 |
print "\t'revision' => '$revision',\n";
|
| 531 |
print "\t'mtime' => '$mtime',\n";
|
| 532 |
print "\t'base_revision' => '$oldr',\n";
|
| 533 |
print "\t'translation_maintainer' => ['$translator'],\n" if $translator;
|
| 534 |
print "\t'status' => $status,\n";
|
| 535 |
print "},\n";
|
| 536 |
} elsif ($str && $oldr ne $revision) {
|
| 537 |
$str .= "\n";
|
| 538 |
print $str unless ($opt_Q);
|
| 539 |
}
|
| 540 |
|
| 541 |
# Return if we're up-to-date or the original is missing
|
| 542 |
return if (defined($oldr) && ($oldr eq $revision || $revision eq 'n/a'));
|
| 543 |
|
| 544 |
if ($original)
|
| 545 |
{
|
| 546 |
# Source is non-English, use name we set up above
|
| 547 |
$oldname = $fromname;
|
| 548 |
}
|
| 549 |
else
|
| 550 |
{
|
| 551 |
# Source is English
|
| 552 |
$oldname = $name;
|
| 553 |
$oldname =~ s/^$to/$from/;
|
| 554 |
}
|
| 555 |
|
| 556 |
my @logrev = split(/\./, $oldr);
|
| 557 |
$logrev[$#logrev] ++;
|
| 558 |
my $logoldr = join('.', @logrev);
|
| 559 |
my $maxdelta = $transcheck->maxdelta() || $translators{maxdelta}{maxdelta} || 5;
|
| 560 |
|
| 561 |
if ($opt_m) {
|
| 562 |
my @list_tr;
|
| 563 |
if ($translator eq "") {
|
| 564 |
if ($numrev - $numoldr >= $maxdelta) {
|
| 565 |
@list_tr = ("maxdelta");
|
| 566 |
} else {
|
| 567 |
@list_tr = ("unmaintained");
|
| 568 |
}
|
| 569 |
} elsif ($numrev - $numoldr >= $maxdelta) {
|
| 570 |
@list_tr = ($translator, "maxdelta");
|
| 571 |
} else {
|
| 572 |
@list_tr = ($translator);
|
| 573 |
}
|
| 574 |
foreach my $tname (@list_tr) {
|
| 575 |
add_part($tname,"summary",$str);
|
| 576 |
add_sub_part($tname,"diff",$name,
|
| 577 |
join("",qx(cvs -z3 diff -u -r'$oldr' -r $revision $oldname)));
|
| 578 |
add_sub_part($tname,"tdiff",$name,
|
| 579 |
get_diff_txt("$oldr","$revision","$oldname","$name"));
|
| 580 |
|
| 581 |
add_sub_part($tname,"logs",$name,
|
| 582 |
join("",qx(cvs -z3 log -r$logoldr:$revision $oldname)));
|
| 583 |
add_sub_part($tname,"file",$name,
|
| 584 |
join("",qx(cat $name)));
|
| 585 |
}
|
| 586 |
}
|
| 587 |
|
| 588 |
if ($opt_d) {
|
| 589 |
STDOUT->flush;
|
| 590 |
my $cvsline = "cvs -z3 log -r'$logoldr:$revision' '$oldname'";
|
| 591 |
warn "Running $cvsline\n" if (($opt_v) && ($opt_l));
|
| 592 |
system($cvsline) if $opt_l;
|
| 593 |
STDOUT->flush if $opt_l;
|
| 594 |
$cvsline = "cvs -z3 diff -u -r '$oldr' -r '$revision' '$oldname'";
|
| 595 |
warn "Running $cvsline\n" if $opt_v;
|
| 596 |
system($cvsline);
|
| 597 |
STDOUT->flush;
|
| 598 |
}
|
| 599 |
|
| 600 |
if ($opt_T) {
|
| 601 |
print get_diff_txt("$oldr", "$revision", "$oldname", "$name")."\n";
|
| 602 |
}
|
| 603 |
}
|
Parent Directory
| 
Revision Log