touch_translations.pl 4.42 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#!/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)
16
#
17
# (C) 2000 by Marcin Owsiany <porridge@pandora.info.bielsko.pl>
18 19 20 21
#     Original script
#
# (C) 2018 Steve McIntyre <93sam@debian.org>
#     Converted to use Local::VCS to allow for usage with git instead of CVS
22
#
23
#    These modules reside under webwml/Perl
24

25
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
26
use Local::VCS;
27 28
use Webwml::Langs;
use Webwml::TransCheck;
29

30
# Set this to non-zero for debugging
31
$debug = 0;
32

33
my $VCS = Local::VCS->new("DEBUG" => $debug);
34

35 36 37
sub rebuild {
    my $file = shift;
    $now = time;
38
    print "touching $file\n" if $debug;
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
    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 {
59
        print "$file.forced does not exist\n" if $debug;
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
        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;
    }
}

78 79 80 81
my $l = Webwml::Langs->new();
my %langs = $l->iso_name();
my @langs = $l->names();

82
$argfile = $ARGV[0] or die "Invalid number of arguments";
83
die "Invalid number of arguments" unless $ARGV[1];
84
$arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]";
85
$argfile =~ m+(.*)/(.*\.wml)+ or die "pattern does not match";
86 87
my ($path, $file) = ($1, $2);

88 89 90 91 92 93
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";
}
94 95 96 97 98 99

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

    # Parse the translated file
104 105 106 107 108 109
    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();
110 111 112 113 114 115 116 117 118 119 120 121

    # 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;
    }
122

123
    $difference = $VCS->count_changes($argfile, $langrev, $origrev);
124
    if (!defined $difference) {
125
	die "count_changes failed when looking at $argfile as original for $transfile\n";
126
    }
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
    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;
    }
}