| 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 |
# These modules reside under webwml/Perl
|
| 24 |
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
|
| 25 |
use Local::Cvsinfo;
|
| 26 |
use Webwml::Langs;
|
| 27 |
use Webwml::TransCheck;
|
| 28 |
|
| 29 |
# Set this to 1 for debugging
|
| 30 |
$debug = 0;
|
| 31 |
|
| 32 |
sub rebuild {
|
| 33 |
my $file = shift;
|
| 34 |
$now = time;
|
| 35 |
print "touching $file\n" if $debug;
|
| 36 |
utime $now, $now, $file or die "$file: $!";
|
| 37 |
}
|
| 38 |
|
| 39 |
sub mark_forced {
|
| 40 |
my $file = shift;
|
| 41 |
my $val = shift;
|
| 42 |
my $foo = "$file".".forced";
|
| 43 |
open LOG, ">$foo" or die "$foo: $!";
|
| 44 |
print LOG "$val";
|
| 45 |
close LOG;
|
| 46 |
print "Created $file.forced with $val inside\n" if $debug;
|
| 47 |
}
|
| 48 |
|
| 49 |
sub was_forced {
|
| 50 |
my $file = shift;
|
| 51 |
if (open LOG, "<$file.forced") {
|
| 52 |
close LOG;
|
| 53 |
print "$file.forced exists\n" if $debug;
|
| 54 |
return 1;
|
| 55 |
} else {
|
| 56 |
print "$file.forced does not exists\n" if $debug;
|
| 57 |
return 0;
|
| 58 |
}
|
| 59 |
}
|
| 60 |
|
| 61 |
sub when_forced {
|
| 62 |
my $file = shift;
|
| 63 |
if (open LOG, "<$file.forced") {
|
| 64 |
$_ = <LOG>;
|
| 65 |
chomp($_);
|
| 66 |
print "$file.forced contains $_"."\n" if $debug;
|
| 67 |
close LOG;
|
| 68 |
return $_;
|
| 69 |
} else {
|
| 70 |
print "$file.forced : $!\n" if $debug;
|
| 71 |
return 0;
|
| 72 |
}
|
| 73 |
}
|
| 74 |
|
| 75 |
# We call constructor without argument. It means there must be a
|
| 76 |
# CVS/Repository file or program will abort.
|
| 77 |
my $l = Webwml::Langs->new();
|
| 78 |
my %langs = $l->iso_name();
|
| 79 |
my @langs = $l->names();
|
| 80 |
|
| 81 |
$argfile = $ARGV[0] or die "Invalid number of arguments";
|
| 82 |
die "Invalid number of arguments" unless $ARGV[1];
|
| 83 |
$arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]";
|
| 84 |
$argfile =~ m+(.*)/(.*\.wml)+ or die "pattern does not match";
|
| 85 |
my ($path, $file) = ($1, $2);
|
| 86 |
|
| 87 |
my $cvs = Local::Cvsinfo->new();
|
| 88 |
$cvs->options(matchfile => [ $file ]);
|
| 89 |
$cvs->readinfo($path);
|
| 90 |
my $origrev = $cvs->revision($argfile) || "1.0";
|
| 91 |
|
| 92 |
foreach $lang (@langs) {
|
| 93 |
next if ($lang eq $arglang);
|
| 94 |
my $transfile = $argfile;
|
| 95 |
my ($maxdelta, $mindelta) = (5, 2);
|
| 96 |
my ($original, $langrev);
|
| 97 |
print "Now checking $lang\n" if $debug;
|
| 98 |
$transfile =~ s+$arglang+$lang+ or die "wrong argument: pattern does not match file: $transfile";
|
| 99 |
|
| 100 |
# Parse the translated file
|
| 101 |
my $transcheck = Webwml::TransCheck->new($transfile);
|
| 102 |
next unless $transcheck->revision();
|
| 103 |
$langrev = $transcheck->revision();
|
| 104 |
$original = $transcheck->original();
|
| 105 |
$maxdelta = $transcheck->maxdelta() if $transcheck->maxdelta();
|
| 106 |
$mindelta = $transcheck->mindelta() if $transcheck->mindelta();
|
| 107 |
# TODO - would cause unspecified results if 1. changed to 2.
|
| 108 |
$origrev =~ s/1\.//;
|
| 109 |
$langrev =~ s/1\.//;
|
| 110 |
|
| 111 |
next unless not defined $original or $original eq $arglang;
|
| 112 |
|
| 113 |
# Compare the revisions
|
| 114 |
print "Orig: $origrev, lang: $langrev\n" if $debug;
|
| 115 |
$difference = $origrev-$langrev;
|
| 116 |
if ($difference < $mindelta) {
|
| 117 |
next unless was_forced($transfile);
|
| 118 |
print "unlinking $transfile.forced\n" if $debug;
|
| 119 |
unlink "$transfile.forced";
|
| 120 |
next;
|
| 121 |
}
|
| 122 |
my $forced_at = when_forced($transfile);
|
| 123 |
if ($difference < $maxdelta) {
|
| 124 |
if ($forced_at != $mindelta) {
|
| 125 |
print "difference matches $mindelta, but wasn't rebuilt at $mindelta\n" if $debug;
|
| 126 |
rebuild($transfile);
|
| 127 |
mark_forced($transfile, $mindelta);
|
| 128 |
last;
|
| 129 |
}
|
| 130 |
} elsif ($forced_at != $maxdelta) {
|
| 131 |
print "difference matches $maxdelta, but wasn't rebuilt at $maxdelta\n" if $debug;
|
| 132 |
rebuild($transfile);
|
| 133 |
mark_forced($transfile, $maxdelta);
|
| 134 |
last;
|
| 135 |
}
|
| 136 |
}
|
Parent Directory
| 
Revision Log