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",
        "el" => "hellas",
        "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 = 0;

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 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: $ARGV[1]";
$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" if $debug;
    $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	joey	1.4	"el" => "hellas",
32	polish	1.2	"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	polish	1.1
52			# Set this to 1 for debugging
53	polish	1.3	$debug = 0;
54	polish	1.1
55			sub rebuild {
56			my $file = shift;
57			$now = time;
58	polish	1.3	print "touching $file\n" if $debug;
59	polish	1.1	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	polish	1.2	die "Invalid number of arguments" unless $ARGV[1];
100	joey	1.4	$arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]";
101	polish	1.1	$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	polish	1.3	print "Now checking $lang\n" if $debug;
120	polish	1.1	$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			}