webwml/webwml/touch_translations.pl

#!/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>

# TODOs:
#       - compare both major and minor revision number
#       - think of a better way to check when the file has been rebuilt last


# This should contain all languages
%langs = (
        "ar" => "arabic",
        "zh" => "chinese",
        "hr" => "croatian",
        "da" => "danish",
        "nl" => "dutch",
        "en" => "english",
        "eo" => "esperanto",
        "fi" => "finnish",
        "fr" => "french",
        "de" => "german",
        "hu" => "hungarian",
        "it" => "italian",
        "ja" => "japanese",
        "ko" => "korean",
        "no" => "norwegian",
        "pl" => "polish",
        "pt" => "portuguese",
        "ro" => "romanian",
        "ru" => "russian",
        "es" => "spanish",
        "sv" => "swedish",
        "tr" => "turkish");

@langs = values(%langs);

# Set this to 1 for debugging
$debug = 1;

sub rebuild {
    my $file = shift;
    $now = time;
    print "touching $file\n";
    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 exists\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;
    }
}

$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";
$argfile =~ m+(.*)/(.*)\.wml+ or die "pattern does not match";
my ($path, $file) = ($1, $2);

# Get the revision of the original file
my $origrev;
open FILE, "${path}/CVS/Entries" or die "${path}/CVS/Entries: $!";
while (<FILE>) {
    if (m,^/$file.wml/([^/]+)/,) {
        $origrev = $1;
        last;
    }
}

foreach $lang (@langs) {
    next if ($lang eq $arglang);
    my $transfile = $argfile;
    my ($maxdelta, $mindelta) = (5, 2);
    my ($original, $langrev);
    print "Now checking $lang\n";
    $transfile =~ s+$arglang+$lang+ or die "wrong argument: pattern does not match file: $transfile";

    # Parse the translated file
    open FILE, "$transfile" or next;
    while (<FILE>) { 
        if (/translation-check translation="([.0-9]*)"\s*(.*)/oi) {
            $langrev = $1;
            my $stuff = $2;
            if ($stuff =~ /original="([^"]+)"/) {
                $original = $1;
            }
            if ($stuff =~ /maxdelta="([^"]+)"/) {
                $maxdelta = $1;
            }
            if ($stuff =~ /mindelta="([^"]+)"/) {
                $mindelta = $1;
            }
            last;
        }
    }
    close FILE;
    next if not defined $langrev;
    # TODO - would cause unspecified results if 1. changed to 2.
    $origrev =~ s/1\.//;
    $langrev =~ s/1\.//;
    
    next unless not defined $original or $original eq $arglang;

    # Compare the revisions
    print "Orig: $origrev, lang: $langrev\n" if $debug;
    $difference = $origrev-$langrev;
    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;
    }
}
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
24			# This should contain all languages
25	polish	1.2	%langs = (
26			"ar" => "arabic",
27			"zh" => "chinese",
28			"hr" => "croatian",
29			"da" => "danish",
30			"nl" => "dutch",
31			"en" => "english",
32			"eo" => "esperanto",
33			"fi" => "finnish",
34			"fr" => "french",
35			"de" => "german",
36			"hu" => "hungarian",
37			"it" => "italian",
38			"ja" => "japanese",
39			"ko" => "korean",
40			"no" => "norwegian",
41			"pl" => "polish",
42			"pt" => "portuguese",
43			"ro" => "romanian",
44			"ru" => "russian",
45			"es" => "spanish",
46			"sv" => "swedish",
47			"tr" => "turkish");
48
49			@langs = values(%langs);
50	polish	1.1
51			# Set this to 1 for debugging
52			$debug = 1;
53
54			sub rebuild {
55			my $file = shift;
56			$now = time;
57			print "touching $file\n";
58			utime $now, $now, $file or die "$file: $!";
59			}
60
61			sub mark_forced {
62			my $file = shift;
63			my $val = shift;
64			my $foo = "$file".".forced";
65			open LOG, ">$foo" or die "$foo: $!";
66			print LOG "$val";
67			close LOG;
68			print "Created $file.forced with $val inside\n" if $debug;
69			}
70
71			sub was_forced {
72			my $file = shift;
73			if (open LOG, "<$file.forced") {
74			close LOG;
75			print "$file.forced exists\n" if $debug;
76			return 1;
77			} else {
78			print "$file.forced does not exists\n" if $debug;
79			return 0;
80			}
81			}
82
83			sub when_forced {
84			my $file = shift;
85			if (open LOG, "<$file.forced") {
86			$_ = <LOG>;
87			chomp($_);
88			print "$file.forced contains $_"."\n" if $debug;
89			close LOG;
90			return $_;
91			} else {
92			print "$file.forced : $!\n" if $debug;
93			return 0;
94			}
95			}
96
97			$argfile = $ARGV[0] or die "Invalid number of arguments";
98	polish	1.2	die "Invalid number of arguments" unless $ARGV[1];
99			$arglang = $langs{$ARGV[1]} or die "Invalid lang argument";
100	polish	1.1	$argfile =~ m+(.)/(.)\.wml+ or die "pattern does not match";
101			my ($path, $file) = ($1, $2);
102
103			# Get the revision of the original file
104			my $origrev;
105			open FILE, "${path}/CVS/Entries" or die "${path}/CVS/Entries: $!";
106			while (<FILE>) {
107			if (m,^/$file.wml/([^/]+)/,) {
108			$origrev = $1;
109			last;
110			}
111			}
112
113			foreach $lang (@langs) {
114			next if ($lang eq $arglang);
115			my $transfile = $argfile;
116			my ($maxdelta, $mindelta) = (5, 2);
117			my ($original, $langrev);
118			print "Now checking $lang\n";
119			$transfile =~ s+$arglang+$lang+ or die "wrong argument: pattern does not match file: $transfile";
120
121			# Parse the translated file
122			open FILE, "$transfile" or next;
123			while (<FILE>) {
124			if (/translation-check translation="([.0-9])"\s(.*)/oi) {
125			$langrev = $1;
126			my $stuff = $2;
127			if ($stuff =~ /original="([^"]+)"/) {
128			$original = $1;
129			}
130			if ($stuff =~ /maxdelta="([^"]+)"/) {
131			$maxdelta = $1;
132			}
133			if ($stuff =~ /mindelta="([^"]+)"/) {
134			$mindelta = $1;
135			}
136			last;
137			}
138			}
139			close FILE;
140			next if not defined $langrev;
141			# TODO - would cause unspecified results if 1. changed to 2.
142			$origrev =~ s/1\.//;
143			$langrev =~ s/1\.//;
144
145			next unless not defined $original or $original eq $arglang;
146
147			# Compare the revisions
148			print "Orig: $origrev, lang: $langrev\n" if $debug;
149			$difference = $origrev-$langrev;
150			if ($difference < $mindelta) {
151			next unless was_forced($transfile);
152			print "unlinking $transfile.forced\n" if $debug;
153			unlink "$transfile.forced";
154			next;
155			}
156			my $forced_at = when_forced($transfile);
157			if ($difference < $maxdelta) {
158			if ($forced_at != $mindelta) {
159			print "difference matches $mindelta, but wasn't rebuilt at $mindelta\n" if $debug;
160			rebuild($transfile);
161			mark_forced($transfile, $mindelta);
162			last;
163			}
164			} elsif ($forced_at != $maxdelta) {
165			print "difference matches $maxdelta, but wasn't rebuilt at $maxdelta\n" if $debug;
166			rebuild($transfile);
167			mark_forced($transfile, $maxdelta);
168			last;
169			}
170			}