karma.pl 5.92 KB
Newer Older
1
#!/usr/bin/perl
2 3 4 5

# This is a toy to compute the karma of translators in the Debian web site

# It use information about translation revisions please see
6
# https://www.debian.org/devel/website/uptodate
7
# it also need informations about the maintainer. Just add
8 9 10 11 12
#   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>.
13
# Copyright 2008 Bas Zoetekouw <bas@debian.org>.
14 15

# Invocation:
16
#   ./karma.pl [language]
17 18 19 20
# 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
21
#    slovene spanish swedish turkish
22 23 24
#
# The script needs to be run from the top level webwml directory.
#
25 26 27
use File::Basename;
use File::Spec::Functions;
use FindBin;
28

29 30
# These modules reside under webwml/Perl
use lib "$FindBin::Bin/Perl";
31
use Local::VCS;
32 33 34 35
use Local::WmlDiffTrans;
use Webwml::TransCheck;
use Webwml::TransIgnore;

36 37 38 39 40 41 42
use strict;
use warnings;

$| = 1;

# where to compute the Karma
my %Karma;
43 44

# include only files matching $filename
45
my $MATCH = '(\.wml$)|(\.html$)';
46
my $SKIP  = '^template/';
47 48 49 50 51 52 53 54 55

# parse command line;
die("Please specify a language to examine\n")  if not @ARGV;
my @DIRS = @ARGV;
foreach my $d (@DIRS)
{
	$d =~ s{ /$ }{}x;
	die("Language `$d' not found.\n")  unless -d $d;
}
56

57 58 59
print "Reading data...";

my $lang_from = 'english';
60 61
my $VCS = Local::VCS->new();
my %info_from = $VCS->path_info( $lang_from, 
62 63 64 65
	match_pat => $MATCH, 
	skip_pat  => $SKIP,
	recursive => 1, 
	verbose   => 1 
66
);
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84

print "\n";

foreach my $subdir (@DIRS)
{
	print "Examining $subdir...\n";

	# find language from path
	my ($lang_to) = $subdir =~ m{ ^ ([^/]+) }x;
	die("No language found") unless $lang_to;

	# remove the language from the subdir
	$subdir =~ s{ ^ $lang_to /? }{}x;


	# TODO: transignore

	# fetch a list of all (translated) files in this subdir
85
	my %info_to = $VCS->path_info( catfile($lang_to,$subdir), 
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
		match_pat => $MATCH, 
		skip_pat  => $SKIP,
		recursive => 1, 
		verbose   => 1 
	);

	foreach my $file ( sort keys %info_to )
	{
		my $path      = $subdir ? catfile( $subdir, $file ) : $file;
		my $path_to   = catfile( $lang_to,   $path );
		my $path_from = catfile( $lang_from, $path );

		# NOTE: all keys in %info_from are relative to $WEBWML/english
		#       all keys in $info_to   are relative to $WEBWML/$lang_to/$subdir
		# so, use ONLY $info_from{$path} and ONLY $info_to{$file} 

		#print "  ==> $file : $path : $path_to : $path_from\n";

		# check if the english file exists 
		# (if not, the $path_to isn't a translation, so skip it )
		next unless exists $info_from{$path};

		# check if the translated file exists (if not, you've found a bug)
		die("No such file `$path_to'")   unless exists $info_to{$file};

		# check if the file is in a transignore
		my $dir = dirname($path_to);
		my $transignore = new Webwml::TransIgnore->new($dir) or die;
		if ( $transignore->is_local($path_to) or $transignore->is_global($path_to) )
		{
			#print "Ignoring $path_to\n";
			next;
		}

		my $rev_from  = $info_from{$path}->{'cmt_rev'}  or  die;;

		check_file( \%Karma, $lang_to, $path_to, $path_from, $rev_from );
123 124 125
	}
}

126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
foreach my $translator (sort {$Karma{$b} <=> $Karma{$a}} keys %Karma) 
{
	printf "%s has a web karma of %s\n", $translator, $Karma{$translator};
}

exit 0;


sub check_file 
{
	my $karma      = shift or die;
	my $language   = shift or die;
	my $file_trans = shift or die;
	my $file_orig  = shift or die;
	my $revision   = shift or die;

	return unless (-r $file_trans); # file_trans does not exists
143

144 145 146 147 148
	my $transcheck = Webwml::TransCheck->new($file_trans);
	my $oldr = $transcheck->revision() || 0;

	my $translator = $transcheck->maintainer() || 'ANONYMOUS';
	my $original   = $transcheck->original();
149 150

	return if $original; # if not, we'll loose karma if this page is badly translated
151 152 153 154 155

	$translator = ucfirst($language) . " " . $translator;
	$translator =~ s/^\s+ |\s+$//;

	# calculate the number of revision the original english file has has
156
	my $numrev = $VCS->count_changes( $file_trans, undef, $revision );
157
	# calculate the age of the translated file
158
	my $age    = $VCS->count_changes( $file_orig,  $oldr, $revision );
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197

	$karma->{$translator} += $numrev; # page translated. GOOD
	$karma->{$translator} -= $numrev*$age/4; #out of date page; Bad
}

__END__

sub check_file {
my ($name, $revision,$translator) = @_;
my ($oldr, $oldname, $original);
my $docname = $name;
$docname =~ s#^$lang_to/##;
$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#$lang_to/international/$lang_to#i)) {
#   This document is original, check for
#   english/international/$lang_to...
$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;
198 199 200 201 202 203
#	print "$translator: ";
#	if ($age > 0) {
#	    print "NeedToUpdate $name from version 1.$numoldr to version 1.$numrev\n";
#	} else {
#	    print "Uptodate $name\n";
#	}
204 205
$karma{$translator} += $numrev; # page translated. GOOD
$karma{$translator} -= $numrev*$age/4; #out of date page; Bad
206 207 208
}

foreach my $translator (sort {$karma{$b} <=> $karma{$a}} keys %karma) {
209
print "$translator has a web karma of ".$karma{$translator}.".\n";
210
}