1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
#!/usr/bin/perl -w
# This script is used during build of English documents to check if
# translations are up-to date.
# This script takes full path to a original .wml file, and the language of
# the original.
# For every language defined in @langs, the script:
# - checks if a translated file exists for such language
# - checks if the translated file is at least N revisions old
# (N is any number defined in @stages)
# - if it is, and it hasn't been touched because of this particular
# "N", it is touched and a marker file is created
# This allows the file to be rebuilt _exactly_ the number of times it should
# (i.e. $#stages times)
#
# (C) 2000 by Marcin Owsiany <porridge@pandora.info.bielsko.pl>
# Original script
#
# (C) 2018 Steve McIntyre <93sam@debian.org>
# Converted to use Local::VCS to allow for usage with git instead of CVS
#
# These modules reside under webwml/Perl
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
use Local::VCS;
use Webwml::Langs;
use Webwml::TransCheck;
# Set this to non-zero for debugging
$debug = 0;
my $VCS = Local::VCS->new("DEBUG" => $debug);
sub rebuild {
my $file = shift;
$now = time;
print "touching $file\n" if $debug;
utime $now, $now, $file or die "$file: $!";
}
sub mark_forced {
my $file = shift;
my $val = shift;
my $foo = "$file".".forced";
open LOG, ">$foo" or die "$foo: $!";
print LOG "$val";
close LOG;
print "Created $file.forced with $val inside\n" if $debug;
}
sub was_forced {
my $file = shift;
if (open LOG, "<$file.forced") {
close LOG;
print "$file.forced exists\n" if $debug;
return 1;
} else {
print "$file.forced does not exist\n" if $debug;
return 0;
}
}
sub when_forced {
my $file = shift;
if (open LOG, "<$file.forced") {
$_ = <LOG>;
chomp($_);
print "$file.forced contains $_"."\n" if $debug;
close LOG;
return $_;
} else {
print "$file.forced : $!\n" if $debug;
return 0;
}
}
my $l = Webwml::Langs->new();
my %langs = $l->iso_name();
my @langs = $l->names();
$argfile = $ARGV[0] or die "Invalid number of arguments";
die "Invalid number of arguments" unless $ARGV[1];
$arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]";
$argfile =~ m+(.*)/(.*\.wml)+ or die "pattern does not match";
my ($path, $file) = ($1, $2);
my %file_info = $VCS->file_info($argfile);
my $origrev = $file_info{'cmt_rev'};
unless ($origrev)
{
die "Could not get revision number for $argfile - bug in script?\n";
}
foreach $lang (@langs) {
next if ($lang eq $arglang);
my $transfile = $argfile;
my ($maxdelta, $mindelta) = (5, 2);
my ($original, $langrev);
print "Now checking $lang\n" if $debug;
$transfile =~ s+$arglang+$lang+ or die "wrong argument: pattern does not match file: $transfile";
# Parse the translated file
my $transcheck = Webwml::TransCheck->new($transfile);
next unless $transcheck->revision();
$langrev = $transcheck->revision();
$original = $transcheck->original();
$maxdelta = $transcheck->maxdelta() if $transcheck->maxdelta();
$mindelta = $transcheck->mindelta() if $transcheck->mindelta();
# English is the default original language if the header in the
# translated file doesn't specify otherwise
if (!defined $original) {
$original = "english";
}
# If the original language in the translated file isn't the
# language we started with here, bail now - it's not interesting
if (! ($original eq $arglang)) {
next;
}
$difference = $VCS->count_changes($argfile, $langrev, $origrev);
if (!defined $difference) {
die "count_changes failed when looking at $argfile as original for $transfile\n";
}
if ($difference < $mindelta) {
next unless was_forced($transfile);
print "unlinking $transfile.forced\n" if $debug;
unlink "$transfile.forced";
next;
}
my $forced_at = when_forced($transfile);
if ($difference < $maxdelta) {
if ($forced_at != $mindelta) {
print "difference matches $mindelta, but wasn't rebuilt at $mindelta\n" if $debug;
rebuild($transfile);
mark_forced($transfile, $mindelta);
last;
}
} elsif ($forced_at != $maxdelta) {
print "difference matches $maxdelta, but wasn't rebuilt at $maxdelta\n" if $debug;
rebuild($transfile);
mark_forced($transfile, $maxdelta);
last;
}
}
|
