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
|
#!/usr/bin/perl -w
# This is a toy to compute the karma of translators in the Debian web site
# CVS repository.
# It use information about translation revisions please see
# http://www.debian.org/devel/website/uptodate
# it also need informations about the maintainer. Just add
# maintainer="Name"
# at the end of the wml::debian::translation-check template invocation
# This is GPL'ed code.
# Copyright 2002 Martin Quinson <martin.quinson@ens-lyon.fr>.
# Invocation:
# karma.pl [language]
# list of languages in webwml:
# english esperanto french japanese german arabic catalan bulgarian
# chinese croatian czech danish dutch farsi finnish greek hungarian
# indonesian italian korean lithuanian norwegian romanian russian
# slovene spanish swedish turkish
use strict;
use Getopt::Std;
use IO::Handle;
use Date::Parse;
# These modules reside under webwml/Perl
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
use Local::Cvsinfo;
use Local::WmlDiffTrans;
use Webwml::TransCheck;
use Webwml::TransIgnore;
#where to compute the karma
my %karma;
# include only files matching $filename
my $filename = '(\.wml$)|(\.html$)';
my $cvs = Local::Cvsinfo->new();
$cvs->options(
recursive => 1,
matchfile => [ $filename ],
skipdir => [ "template" ],
);
# This object is used to retrieve information when original is
# not English
my $altcvs = $cvs->new();
# Global .transignore
my $globtrans = Webwml::TransIgnore->new(".");
my $from = 'english';
my ($to,$langto,$transignore);
while ($to=shift) {
$to =~ s%/$%%; # Remove slash from the end
print "Examine $to\n";
$langto = $to;
$langto =~ s,^([^/]*).*$,$1,;
$cvs->readinfo($from);
foreach my $path (@{$cvs->dirs()}) {
my $tpath = $path;
$tpath =~ s/^$from/$to/o;
my $transignore = Webwml::TransIgnore->new($tpath);
next unless $transignore->found();
foreach (@{$transignore->local()}) {
s/^$to/$from/o;
$cvs->removefile($_);
}
}
foreach (sort @{$cvs->files()}) {
my ($path, $tpath);
$path = $_;
$tpath = $path;
$tpath =~ s/^$from/$to/o;
check_file($tpath,
$cvs->revision($path),
str2time($cvs->date($path)));
}
}
sub check_file {
my ($name, $revision,$translator) = @_;
my ($oldr, $oldname, $original);
my $docname = $name;
$docname =~ s#^$langto/##;
$docname =~ s#\.wml$##;
return unless (-r $name); # file does not exists
my $transcheck = Webwml::TransCheck->new($name);
$oldr = $transcheck->revision() || 0;
if (!$oldr && ($name =~ m#$langto/international/$langto#i)) {
# This document is original, check for
# english/international/$langto...
$name =~ s{^$to}{$from};
$transcheck = Webwml::TransCheck->new($name);
$oldr = $transcheck->revision() || 0;
}
$translator = $transcheck->maintainer();
$original = $transcheck->original();
$translator = "anonymous" unless $translator; # translator not found
$translator = ucfirst($to)." ".$translator;
$translator =~ s/^\s+//;
$translator =~ s/\s+$//;
$karma{$translator}=0 unless defined($karma{$translator});
$translator =~ s/^\s+//;
$translator =~ s/\s+$//;
return if $original; # if not, we'll loose karma if this page is badly translated
(my $numrev) = $revision =~ m/^1\.(\d+)$/; $numrev ||= "0";
(my $numoldr) = $oldr =~ m/^1\.(\d+)$/; $numoldr ||= "0";
my $age=$numrev - $numoldr;
# print "$translator: ";
# if ($age > 0) {
# print "NeedToUpdate $name from version 1.$numoldr to version 1.$numrev\n";
# } else {
# print "Uptodate $name\n";
# }
$karma{$translator} += $numrev; # page translated. GOOD
$karma{$translator} -= $numrev*$age/4; #out of date page; Bad
}
foreach my $translator (sort {$karma{$b} <=> $karma{$a}} keys %karma) {
print "$translator has a web karma of ".$karma{$translator}.".\n";
}
|
