| 1 |
#!/usr/bin/perl -w
|
| 2 |
|
| 3 |
# This script is used during build of English documents to check if
|
| 4 |
# translations are up-to date.
|
| 5 |
|
| 6 |
# This script takes full path to a original .wml file, and the language of
|
| 7 |
# the original.
|
| 8 |
# For every language defined in @langs, the script:
|
| 9 |
# - checks if a translated file exists for such language
|
| 10 |
# - checks if the translated file is at least N revisions old
|
| 11 |
# (N is any number defined in @stages)
|
| 12 |
# - if it is, and it hasn't been touched because of this particular
|
| 13 |
# "N", it is touched and a marker file is created
|
| 14 |
# This allows the file to be rebuilt _exactly_ the number of times it should
|
| 15 |
# (i.e. $#stages times)
|
| 16 |
|
| 17 |
# (C) 2000 by Marcin Owsiany <porridge@pandora.info.bielsko.pl>
|
| 18 |
|
| 19 |
# TODOs:
|
| 20 |
# - compare both major and minor revision number
|
| 21 |
# - think of a better way to check when the file has been rebuilt last
|
| 22 |
|
| 23 |
|
| 24 |
# This should contain all languages
|
| 25 |
%langs = (
|
| 26 |
"ar" => "arabic",
|
| 27 |
"zh" => "chinese",
|
| 28 |
"hr" => "croatian",
|
| 29 |
"da" => "danish",
|
| 30 |
"nl" => "dutch",
|
| 31 |
"el" => "hellas",
|
| 32 |
"en" => "english",
|
| 33 |
"eo" => "esperanto",
|
| 34 |
"fi" => "finnish",
|
| 35 |
"fr" => "french",
|
| 36 |
"de" => "german",
|
| 37 |
"hu" => "hungarian",
|
| 38 |
"it" => "italian",
|
| 39 |
"ja" => "japanese",
|
| 40 |
"ko" => "korean",
|
| 41 |
"no" => "norwegian",
|
| 42 |
"pl" => "polish",
|
| 43 |
"pt" => "portuguese",
|
| 44 |
"ro" => "romanian",
|
| 45 |
"ru" => "russian",
|
| 46 |
"es" => "spanish",
|
| 47 |
"sv" => "swedish",
|
| 48 |
"tr" => "turkish");
|
| 49 |
|
| 50 |
@langs = values(%langs);
|
| 51 |
|
| 52 |
# Set this to 1 for debugging
|
| 53 |
$debug = 0;
|
| 54 |
|
| 55 |
sub rebuild {
|
| 56 |
my $file = shift;
|
| 57 |
$now = time;
|
| 58 |
print "touching $file\n" if $debug;
|
| 59 |
utime $now, $now, $file or die "$file: $!";
|
| 60 |
}
|
| 61 |
|
| 62 |
sub mark_forced {
|
| 63 |
my $file = shift;
|
| 64 |
my $val = shift;
|
| 65 |
my $foo = "$file".".forced";
|
| 66 |
open LOG, ">$foo" or die "$foo: $!";
|
| 67 |
print LOG "$val";
|
| 68 |
close LOG;
|
| 69 |
print "Created $file.forced with $val inside\n" if $debug;
|
| 70 |
}
|
| 71 |
|
| 72 |
sub was_forced {
|
| 73 |
my $file = shift;
|
| 74 |
if (open LOG, "<$file.forced") {
|
| 75 |
close LOG;
|
| 76 |
print "$file.forced exists\n" if $debug;
|
| 77 |
return 1;
|
| 78 |
} else {
|
| 79 |
print "$file.forced does not exists\n" if $debug;
|
| 80 |
return 0;
|
| 81 |
}
|
| 82 |
}
|
| 83 |
|
| 84 |
sub when_forced {
|
| 85 |
my $file = shift;
|
| 86 |
if (open LOG, "<$file.forced") {
|
| 87 |
$_ = <LOG>;
|
| 88 |
chomp($_);
|
| 89 |
print "$file.forced contains $_"."\n" if $debug;
|
| 90 |
close LOG;
|
| 91 |
return $_;
|
| 92 |
} else {
|
| 93 |
print "$file.forced : $!\n" if $debug;
|
| 94 |
return 0;
|
| 95 |
}
|
| 96 |
}
|
| 97 |
|
| 98 |
$argfile = $ARGV[0] or die "Invalid number of arguments";
|
| 99 |
die "Invalid number of arguments" unless $ARGV[1];
|
| 100 |
$arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]";
|
| 101 |
$argfile =~ m+(.*)/(.*)\.wml+ or die "pattern does not match";
|
| 102 |
my ($path, $file) = ($1, $2);
|
| 103 |
|
| 104 |
# Get the revision of the original file
|
| 105 |
my $origrev;
|
| 106 |
open FILE, "${path}/CVS/Entries" or die "${path}/CVS/Entries: $!";
|
| 107 |
while (<FILE>) {
|
| 108 |
if (m,^/$file.wml/([^/]+)/,) {
|
| 109 |
$origrev = $1;
|
| 110 |
last;
|
| 111 |
}
|
| 112 |
}
|
| 113 |
|
| 114 |
foreach $lang (@langs) {
|
| 115 |
next if ($lang eq $arglang);
|
| 116 |
my $transfile = $argfile;
|
| 117 |
my ($maxdelta, $mindelta) = (5, 2);
|
| 118 |
my ($original, $langrev);
|
| 119 |
print "Now checking $lang\n" if $debug;
|
| 120 |
$transfile =~ s+$arglang+$lang+ or die "wrong argument: pattern does not match file: $transfile";
|
| 121 |
|
| 122 |
# Parse the translated file
|
| 123 |
open FILE, "$transfile" or next;
|
| 124 |
while (<FILE>) {
|
| 125 |
if (/translation-check translation="([.0-9]*)"\s*(.*)/oi) {
|
| 126 |
$langrev = $1;
|
| 127 |
my $stuff = $2;
|
| 128 |
if ($stuff =~ /original="([^"]+)"/) {
|
| 129 |
$original = $1;
|
| 130 |
}
|
| 131 |
if ($stuff =~ /maxdelta="([^"]+)"/) {
|
| 132 |
$maxdelta = $1;
|
| 133 |
}
|
| 134 |
if ($stuff =~ /mindelta="([^"]+)"/) {
|
| 135 |
$mindelta = $1;
|
| 136 |
}
|
| 137 |
last;
|
| 138 |
}
|
| 139 |
}
|
| 140 |
close FILE;
|
| 141 |
next if not defined $langrev;
|
| 142 |
# TODO - would cause unspecified results if 1. changed to 2.
|
| 143 |
$origrev =~ s/1\.//;
|
| 144 |
$langrev =~ s/1\.//;
|
| 145 |
|
| 146 |
next unless not defined $original or $original eq $arglang;
|
| 147 |
|
| 148 |
# Compare the revisions
|
| 149 |
print "Orig: $origrev, lang: $langrev\n" if $debug;
|
| 150 |
$difference = $origrev-$langrev;
|
| 151 |
if ($difference < $mindelta) {
|
| 152 |
next unless was_forced($transfile);
|
| 153 |
print "unlinking $transfile.forced\n" if $debug;
|
| 154 |
unlink "$transfile.forced";
|
| 155 |
next;
|
| 156 |
}
|
| 157 |
my $forced_at = when_forced($transfile);
|
| 158 |
if ($difference < $maxdelta) {
|
| 159 |
if ($forced_at != $mindelta) {
|
| 160 |
print "difference matches $mindelta, but wasn't rebuilt at $mindelta\n" if $debug;
|
| 161 |
rebuild($transfile);
|
| 162 |
mark_forced($transfile, $mindelta);
|
| 163 |
last;
|
| 164 |
}
|
| 165 |
} elsif ($forced_at != $maxdelta) {
|
| 166 |
print "difference matches $maxdelta, but wasn't rebuilt at $maxdelta\n" if $debug;
|
| 167 |
rebuild($transfile);
|
| 168 |
mark_forced($transfile, $maxdelta);
|
| 169 |
last;
|
| 170 |
}
|
| 171 |
}
|