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