| 1 |
#! /usr/bin/perl
|
| 2 |
|
| 3 |
# webwml-stattrans - Debian Web site Translation Statistics
|
| 4 |
# Copyright (c) 2001 Martin Schulze <joey@debian.org> and others
|
| 5 |
|
| 6 |
# This program is free software; you can redistribute it and/or modify
|
| 7 |
# it under the terms of the GNU General Public License as published by
|
| 8 |
# the Free Software Foundation; either version 2 of the License, or
|
| 9 |
# (at your option) any later version.
|
| 10 |
|
| 11 |
# This program is distributed in the hope that it will be useful,
|
| 12 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
| 13 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
| 14 |
# GNU General Public License for more details.
|
| 15 |
|
| 16 |
# You should have received a copy of the GNU General Public License
|
| 17 |
# along with this program; if not, write to the Free Software
|
| 18 |
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
| 19 |
|
| 20 |
use POSIX qw(strftime);
|
| 21 |
use Getopt::Std;
|
| 22 |
$| = 1;
|
| 23 |
|
| 24 |
$opt_h = "/org/www.debian.org/debian.org/devel/website/stats";
|
| 25 |
$opt_w = "/org/www.debian.org/webwml";
|
| 26 |
$opt_p = "*.wml";
|
| 27 |
$opt_t = "Debian Web site Translation Statistics";
|
| 28 |
$opt_v = 0;
|
| 29 |
$opt_d = "u";
|
| 30 |
$opt_l = undef;
|
| 31 |
getopts('h:w:p:t:vd:l:');
|
| 32 |
%config = (
|
| 33 |
'htmldir' => $opt_h,
|
| 34 |
'wmldir' => $opt_w,
|
| 35 |
'wmlpat' => $opt_p,
|
| 36 |
'title' => $opt_t,
|
| 37 |
'verbose' => $opt_v,
|
| 38 |
'diff' => $opt_d,
|
| 39 |
);
|
| 40 |
|
| 41 |
$max_versions = 5;
|
| 42 |
$min_versions = 1;
|
| 43 |
|
| 44 |
# from english/template/debian/languages.wml
|
| 45 |
# TODO: Needs to be synced frequently or fixed so it's automatic
|
| 46 |
my %langs = ( english => "en",
|
| 47 |
arabic => "ar",
|
| 48 |
catalan => "ca",
|
| 49 |
danish => "da",
|
| 50 |
german => "de",
|
| 51 |
hellas => "el",
|
| 52 |
esperanto => "eo",
|
| 53 |
spanish => "es",
|
| 54 |
finnish => "fi",
|
| 55 |
french => "fr",
|
| 56 |
croatian => "hr",
|
| 57 |
hungarian => "hu",
|
| 58 |
italian => "it",
|
| 59 |
japanese => "ja",
|
| 60 |
korean => "ko",
|
| 61 |
dutch => "nl",
|
| 62 |
norwegian => "no",
|
| 63 |
polish => "pl",
|
| 64 |
portuguese => "pt",
|
| 65 |
romanian => "ro",
|
| 66 |
russian => "ru",
|
| 67 |
swedish => "sv",
|
| 68 |
turkish => "tr",
|
| 69 |
chinese => "zh",
|
| 70 |
);
|
| 71 |
|
| 72 |
$border_head = "<table width=95% align=center border=0 cellpadding=0 cellspacing=0><tr bgcolor=#000000><td>"
|
| 73 |
."<table width=100% border=0 cellpadding=0 cellspacing=1><tr bgcolor=#ffffff><td>";
|
| 74 |
$border_foot = "</td></tr></table></td></tr></table>";
|
| 75 |
|
| 76 |
|
| 77 |
$date = strftime "%a %b %e %H:%M:%S %Y %z", localtime;
|
| 78 |
|
| 79 |
sub get_cvs_version
|
| 80 |
{
|
| 81 |
my ($dir, $wmlfile) = @_;
|
| 82 |
my $file;
|
| 83 |
my @comp;
|
| 84 |
my $version;
|
| 85 |
|
| 86 |
@comp = split (/\//, "$dir/$wmlfile");
|
| 87 |
pop @comp;
|
| 88 |
$dir = join ("/", @comp);
|
| 89 |
|
| 90 |
@comp = split (/\//, "$wmlfile");
|
| 91 |
$file = pop @comp;
|
| 92 |
|
| 93 |
if (open (CVS,"$dir/CVS/Entries")) {
|
| 94 |
while (<CVS>) {
|
| 95 |
($version) = $_ =~ m,/\Q$file\E/([\d\.]*),;
|
| 96 |
last if $version;
|
| 97 |
}
|
| 98 |
}
|
| 99 |
|
| 100 |
return $version;
|
| 101 |
}
|
| 102 |
|
| 103 |
sub get_translation_version
|
| 104 |
{
|
| 105 |
my ($dir, $file) = @_;
|
| 106 |
my $checktrans;
|
| 107 |
|
| 108 |
if (open (F, "$dir/$file")) {
|
| 109 |
$checktrans = 0;
|
| 110 |
while (<F>) {
|
| 111 |
chomp;
|
| 112 |
if (/^\#use wml::debian::translation-check/) {
|
| 113 |
$checktrans = 1;
|
| 114 |
return $1 if ($_ =~ /translation="([^\" ]+)"/);
|
| 115 |
last;
|
| 116 |
}
|
| 117 |
}
|
| 118 |
close (F);
|
| 119 |
}
|
| 120 |
return "";
|
| 121 |
}
|
| 122 |
|
| 123 |
# Count wml files in given directory
|
| 124 |
#
|
| 125 |
sub getwmlfiles
|
| 126 |
{
|
| 127 |
my $lang = shift;
|
| 128 |
my $dir = "$config{'wmldir'}/$lang";
|
| 129 |
my $cmd = "find $dir -name \"$config{'wmlpat'}\"";
|
| 130 |
my $cutfrom = length ($config{'wmldir'})+length($lang)+2;
|
| 131 |
my $count = 0;
|
| 132 |
my $is_english = ($lang eq "english")?1:0;
|
| 133 |
my $file, $v;
|
| 134 |
|
| 135 |
print "$lang " if ($config{verbose});
|
| 136 |
die "$0: can't find $dir!\n" if (! -d "$dir");
|
| 137 |
open (FIND, "$cmd|") || die "Can't read from $cmd";
|
| 138 |
while (<FIND>) {
|
| 139 |
# XXX this list of exceptions needs to be maintained XXX
|
| 140 |
next if (/\/sitemap\.wml/);
|
| 141 |
next if (/\/template\//);
|
| 142 |
next if (/\/MailingLists\/(un)?subscribe\.wml/);
|
| 143 |
next if (/\/devel\/wnpp\/wnpp\.wml/);
|
| 144 |
next if (/\/international\/l10n\/data\/countries\.wml/);
|
| 145 |
next if (/\/international\/l10n\/scripts\/l10nheader\.wml/);
|
| 146 |
chomp;
|
| 147 |
$file = substr ($_, $cutfrom);
|
| 148 |
$file =~ s/\.wml$//;
|
| 149 |
$wmlfiles{$lang} .= " " . $file;
|
| 150 |
if ($is_english) {
|
| 151 |
$version{"$lang/$file"} = get_cvs_version ($dir, "$file.wml");
|
| 152 |
} else {
|
| 153 |
$version{"$lang/$file"} = get_translation_version ($dir, "$file.wml");
|
| 154 |
}
|
| 155 |
$count++;
|
| 156 |
}
|
| 157 |
close (FIND);
|
| 158 |
$wmlfiles{$lang} .= " ";
|
| 159 |
$wml{$lang} = $count;
|
| 160 |
}
|
| 161 |
|
| 162 |
sub get_color
|
| 163 |
{
|
| 164 |
my $percent = shift;
|
| 165 |
|
| 166 |
if ($percent < 50) {
|
| 167 |
return sprintf ("#FF%02x00", (255/50) * $percent);
|
| 168 |
} else {
|
| 169 |
return sprintf ("#%02xFF00", (255/50) * (100 - $percent));
|
| 170 |
}
|
| 171 |
}
|
| 172 |
|
| 173 |
sub check_translation
|
| 174 |
{
|
| 175 |
my ($translation, $version, $file) = @_;
|
| 176 |
my @version_numbers, $major_number, $last_number;
|
| 177 |
my @translation_numbers, $major_translated_number, $last_translated_number;
|
| 178 |
|
| 179 |
if ($version ne "" && $translation ne "") {
|
| 180 |
@version_numbers = split /\./,$version;
|
| 181 |
$major_number = @version_numbers[0];
|
| 182 |
$last_number = pop @version_numbers;
|
| 183 |
die "Invalid CVS revision for $file: $version\n"
|
| 184 |
unless ($major_number =~ /\d+/ && $last_number =~ /\d+/);
|
| 185 |
|
| 186 |
@translation_numbers = split /\./,$translation;
|
| 187 |
$major_translated_number = @translation_numbers[0];
|
| 188 |
$last_translated_number = pop @translation_numbers;
|
| 189 |
die "Invalid translation revision for $file: $translation\n"
|
| 190 |
unless ($major_translated_number =~ /\d+/ && $last_translated_number =~ /\d+/);
|
| 191 |
|
| 192 |
# Here we compare the original version with the translated one and print
|
| 193 |
# a note for the user if their first or last numbers are too far apart
|
| 194 |
# From translation-check.wml
|
| 195 |
|
| 196 |
if ($version eq "") {
|
| 197 |
return "The original no longer exists";
|
| 198 |
} elsif ( $major_number != $major_translated_number ) {
|
| 199 |
return "This translation is too out of date";
|
| 200 |
} elsif ( $last_number - $last_translated_number >= $max_versions ) {
|
| 201 |
return "This translation is too out of date";
|
| 202 |
} elsif ( $last_number - $last_translated_number >= $min_versions ) {
|
| 203 |
return "The original is newer than this translation";
|
| 204 |
}
|
| 205 |
}
|
| 206 |
return "";
|
| 207 |
}
|
| 208 |
|
| 209 |
print "Collecting data in: " if ($config{'verbose'});
|
| 210 |
if ($opt_l) {
|
| 211 |
getwmlfiles ('english');
|
| 212 |
getwmlfiles ($opt_l);
|
| 213 |
} else {
|
| 214 |
getwmlfiles ('english');
|
| 215 |
foreach $lang (keys %langs) {
|
| 216 |
next if ($lang eq "english");
|
| 217 |
getwmlfiles ($lang);
|
| 218 |
}
|
| 219 |
}
|
| 220 |
print "\n" if ($config{'verbose'});
|
| 221 |
|
| 222 |
# =============== Create HTML files ===============
|
| 223 |
mkdir ($config{'htmldir'}, 02775) if (! -d $config{'htmldir'});
|
| 224 |
|
| 225 |
@sorted_english = sort (split (/ /, $wmlfiles{'english'}));
|
| 226 |
|
| 227 |
print "Creating files: " if ($config{'verbose'});
|
| 228 |
my @search_in = ();
|
| 229 |
if ($opt_l) {
|
| 230 |
push @search_in, 'english';
|
| 231 |
push @search_in, $opt_l;
|
| 232 |
} else {
|
| 233 |
@search_in = sort keys %langs;
|
| 234 |
}
|
| 235 |
foreach $lang (@search_in) {
|
| 236 |
$l = $langs{$lang};
|
| 237 |
print "$l.html " if ($config{'verbose'});
|
| 238 |
$l = "zh-cn" if ($l eq "zh"); # kludge
|
| 239 |
|
| 240 |
$t_body = $u_body = $o_body = "";
|
| 241 |
|
| 242 |
foreach $file (@sorted_english) {
|
| 243 |
next if ($file eq "");
|
| 244 |
# Translated pages
|
| 245 |
if (index ($wmlfiles{$lang}, " $file ") >= 0) {
|
| 246 |
$t_body .= sprintf ("<a href=\"/%s.%s.html\">%s</a><br>\n",
|
| 247 |
$file, $l, $file);
|
| 248 |
$translated{$lang}++;
|
| 249 |
next if ($lang eq "english");
|
| 250 |
# Outdated translations
|
| 251 |
$msg = check_translation ($version{"$lang/$file"}, $version{"english/$file"}, "$lang/$file");
|
| 252 |
if (length ($msg)) {
|
| 253 |
$o_body .= "<tr>";
|
| 254 |
$o_body .= sprintf "<td><a href=\"/%s.%s.html\">%s</a></td>", $file, $l, $file;
|
| 255 |
$o_body .= sprintf "<td>%s</td>", $version{"$lang/$file"};
|
| 256 |
$o_body .= sprintf "<td>%s</td>", $version{"english/$file"};
|
| 257 |
$o_body .= sprintf "<td>%s</td>", $msg;
|
| 258 |
$o_body .= sprintf "<td> <a href=\"http://cvs.debian.org/webwml/english/%s.wml.diff\?r1=%s\&r2=%s\&cvsroot=webwml\&diff_format=%s\">%s -> %s</a></td>", $file, $version{"$lang/$file"}, $version{"english/$file"}, $config{'diff_type'}, $version{"$lang/$file"}, $version{"english/$file"};
|
| 259 |
$o_body .= "</tr>\n";
|
| 260 |
$outdated{$lang}++;
|
| 261 |
}
|
| 262 |
}
|
| 263 |
# Untranslated pages
|
| 264 |
else {
|
| 265 |
$u_body .= sprintf ("<a href=\"/%s\">%s</a><br>", $file, $file);
|
| 266 |
$untranslated{$lang}++;
|
| 267 |
}
|
| 268 |
}
|
| 269 |
|
| 270 |
# this is where we discard the files that the translation directory contains
|
| 271 |
# but which don't exist in the English directory
|
| 272 |
# print "extra files: ".$wml{$lang}-$translated{$lang}."\n";
|
| 273 |
$wml{$lang} = $translated{$lang};
|
| 274 |
$translated{$lang} = $translated{$lang} - $outdated{$lang};
|
| 275 |
|
| 276 |
$percent_a{$lang} = $wml{$lang}/$wml{english} * 100;
|
| 277 |
$percent_t{$lang} = $translated{$lang}/$wml{english} * 100;
|
| 278 |
$percent_o{$lang} = $outdated{$lang}/$wml{english} * 100;
|
| 279 |
$percent_u{$lang} = $untranslated{$lang}/$wml{english} * 100;
|
| 280 |
|
| 281 |
if (open (HTML, ">$config{'htmldir'}/$l.html")) {
|
| 282 |
printf HTML "<html><head><title>%s: %s</title></head><body bgcolor=#ffffff>\n", $config{'title'}, ucfirst $lang;
|
| 283 |
|
| 284 |
$color = get_color ($percent_a{$lang});
|
| 285 |
|
| 286 |
printf HTML "<table width=100%% cellpadding=2 cellspacing=0 bgcolor=%s>\n", $color;
|
| 287 |
|
| 288 |
printf HTML "<tr><td colspan=4><h1 align=center>%s: %s</h1></td></tr>", $config{'title'}, ucfirst $lang;
|
| 289 |
|
| 290 |
print HTML "<tr>\n";
|
| 291 |
printf HTML "<td align=center width=25%%><b>%d files (%d%%) translated</b></td>", $wml{$lang}, $percent_a{$lang};
|
| 292 |
printf HTML "<td align=center width=25%%><b>%d files (%d%%) up to date</b></td>", $translated{$lang}, $percent_t{$lang};
|
| 293 |
printf HTML "<td align=center width=25%%><b>%d files (%d%%) outdated</b></td>", $outdated{$lang}, $percent_o{$lang};
|
| 294 |
printf HTML "<td align=center width=25%%><b>%d files (%d%%) not translated</b></td>", $untranslated{$lang}, $percent_u{$lang};
|
| 295 |
print HTML "</tr>\n";
|
| 296 |
print HTML "</table>\n";
|
| 297 |
|
| 298 |
print HTML "<p><a href=\"./\">Index</a><p>\n";
|
| 299 |
print HTML "<p><a href=\"../\">Working on the website</a><p>\n";
|
| 300 |
|
| 301 |
if ($o_body) {
|
| 302 |
print HTML "<h3>Outdated translations:</h3>";
|
| 303 |
print HTML "<table border=0 cellpadding=1 cellspacing=1>\n";
|
| 304 |
print HTML "<tr><th>File</th><th>Translated</th><th>English</th><th>Comment</th>";
|
| 305 |
if ($opt_d eq "u") { print HTML "<th>Unified diff</th>"; }
|
| 306 |
elsif ($opt_d eq "h") { print HTML "<th>Colored diff</th>"; }
|
| 307 |
else { print HTML "<th>Diff</th>"; }
|
| 308 |
print HTML "</tr>\n";
|
| 309 |
print HTML $o_body;
|
| 310 |
print HTML "</table>\n";
|
| 311 |
}
|
| 312 |
if ($u_body) {
|
| 313 |
print HTML "<h3>Pages not translated:</h3>";
|
| 314 |
print HTML $u_body;
|
| 315 |
}
|
| 316 |
if ($t_body) {
|
| 317 |
print HTML "<h3>Translations up to date:</h3>";
|
| 318 |
print HTML $t_body;
|
| 319 |
}
|
| 320 |
|
| 321 |
print HTML "</table>\n";
|
| 322 |
print HTML "<hr><address>Compiled at $date</address>\n";
|
| 323 |
print HTML "</body></html>";
|
| 324 |
close (HTML);
|
| 325 |
}
|
| 326 |
}
|
| 327 |
print "\n" if ($config{'verbose'});
|
| 328 |
|
| 329 |
# =============== Creating index.html ===============
|
| 330 |
print "Creating index.html... " if ($config{'verbose'});
|
| 331 |
|
| 332 |
open (HTML, ">$config{'htmldir'}/index.html")
|
| 333 |
|| die "Can't open $config{'htmldir'}/index.html";
|
| 334 |
|
| 335 |
printf HTML "<html>\n<head><title>%s</title></head>\n<body bgcolor=#ffffff>\n", $config{'title'};
|
| 336 |
printf HTML "<h1 align=center>%s</h1>\n", $config{'title'};
|
| 337 |
|
| 338 |
print HTML $border_head;
|
| 339 |
print HTML "<table width=100% border=0 bgcolor=\"#cdc9c9\">\n";
|
| 340 |
print HTML "<tr><th>Language</th><th>Translations</th><th>Up to date</th><th>Outdated</th><th>Not translated</th></tr>\n";
|
| 341 |
foreach $lang (@search_in) {
|
| 342 |
$l = $langs{$lang};
|
| 343 |
$l = "zh-cn" if ($l eq "zh"); # kludge
|
| 344 |
|
| 345 |
$color = get_color ($percent_a{$lang});
|
| 346 |
|
| 347 |
print HTML "<tr>";
|
| 348 |
printf HTML "<td><a href=\"%s.html\">%s</a> (%s)</td>", $l, ucfirst $lang, $l;
|
| 349 |
printf HTML "<td bgcolor=\"%s\" align=right>%d (%d%%)</td>", $color, $wml{$lang}, $percent_a{$lang};
|
| 350 |
if ($l ne "en") {
|
| 351 |
printf HTML "<td align=right>%d (%d%%)</td>", $translated{$lang}, $percent_t{$lang};
|
| 352 |
printf HTML "<td align=right>%d (%d%%)</td>", $outdated{$lang}, $percent_o{$lang};
|
| 353 |
printf HTML "<td align=right>%d (%d%%)</td>", $untranslated{$lang}, $percent_u{$lang};
|
| 354 |
} else {
|
| 355 |
print HTML "<td align=right>-</td><td align=right>-</td><td align=right>-</td>";
|
| 356 |
}
|
| 357 |
print HTML "</tr>\n",
|
| 358 |
}
|
| 359 |
|
| 360 |
print HTML "</tr></table>";
|
| 361 |
print HTML $border_foot;
|
| 362 |
|
| 363 |
print HTML "</table>\n";
|
| 364 |
print HTML "<p><hr noshade size=1 width=100%>\n";
|
| 365 |
print HTML "<p>Created with <a href=\"http://cvs.debian.org/webwml/stattrans.pl?cvsroot=webwml\">webwml-stattrans</a> at $date\n";
|
| 366 |
print HTML "</body></html>\n";
|
| 367 |
close (HTML);
|
| 368 |
|
| 369 |
print "done.\n" if ($config{'verbose'});
|
| 370 |
|
| 371 |
# Note:
|
| 372 |
# Translated pages on ll.html may be higher than in index.html.
|
| 373 |
# This is due to the fact that some english pages were removed.
|
| 374 |
|
| 375 |
# printf "%s\n", join ("\n", keys %version);
|
| 376 |
# printf "%s - %s\n", $version{'german/devel/index'}, $version{'english/devel/index'};
|
Parent Directory
| 
Revision Log