| 1 |
polish |
1.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 |
barbier |
1.9 |
# 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 |
polish |
1.1 |
|
| 29 |
|
|
# Set this to 1 for debugging
|
| 30 |
polish |
1.3 |
$debug = 0;
|
| 31 |
polish |
1.1 |
|
| 32 |
|
|
sub rebuild {
|
| 33 |
|
|
my $file = shift;
|
| 34 |
|
|
$now = time;
|
| 35 |
polish |
1.3 |
print "touching $file\n" if $debug;
|
| 36 |
polish |
1.1 |
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 |
barbier |
1.9 |
# 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 |
polish |
1.1 |
$argfile = $ARGV[0] or die "Invalid number of arguments";
|
| 82 |
polish |
1.2 |
die "Invalid number of arguments" unless $ARGV[1];
|
| 83 |
joey |
1.4 |
$arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]";
|
| 84 |
barbier |
1.9 |
$argfile =~ m+(.*)/(.*\.wml)+ or die "pattern does not match";
|
| 85 |
polish |
1.1 |
my ($path, $file) = ($1, $2);
|
| 86 |
|
|
|
| 87 |
barbier |
1.9 |
my $cvs = Local::Cvsinfo->new();
|
| 88 |
|
|
$cvs->options(matchfile => [ $file ]);
|
| 89 |
|
|
$cvs->readinfo($path);
|
| 90 |
|
|
my $origrev = $cvs->revision($argfile) || "1.0";
|
| 91 |
polish |
1.1 |
|
| 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 |
polish |
1.3 |
print "Now checking $lang\n" if $debug;
|
| 98 |
polish |
1.1 |
$transfile =~ s+$arglang+$lang+ or die "wrong argument: pattern does not match file: $transfile";
|
| 99 |
|
|
|
| 100 |
|
|
# Parse the translated file
|
| 101 |
barbier |
1.9 |
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 |
polish |
1.1 |
# 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