| 1 |
joy |
1.1 |
#! /usr/bin/perl
|
| 2 |
|
|
|
| 3 |
|
|
# webwml-stattrans - Website 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 |
joy |
1.6 |
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
| 19 |
joy |
1.1 |
|
| 20 |
|
|
use POSIX qw(strftime);
|
| 21 |
joy |
1.6 |
use Getopt::Std;
|
| 22 |
joy |
1.1 |
|
| 23 |
joy |
1.6 |
$opt_h = "/org/www.debian.org/debian.org/devel/website/stats";
|
| 24 |
|
|
$opt_w = "/org/www.debian.org/webwml";
|
| 25 |
|
|
$opt_p = "*.wml";
|
| 26 |
|
|
$opt_t = "Website Translation Statistics";
|
| 27 |
|
|
$opt_v = 0;
|
| 28 |
|
|
getopts('hwptv');
|
| 29 |
joy |
1.1 |
%config = (
|
| 30 |
joy |
1.6 |
'htmldir' => $opt_h,
|
| 31 |
|
|
'wmldir' => $opt_w,
|
| 32 |
|
|
'wmlpat' => $opt_p,
|
| 33 |
|
|
'title' => $opt_t,
|
| 34 |
|
|
'verbose' => $opt_v,
|
| 35 |
joy |
1.1 |
);
|
| 36 |
|
|
|
| 37 |
|
|
$max_versions = 5;
|
| 38 |
|
|
$min_versions = 1;
|
| 39 |
|
|
|
| 40 |
joy |
1.4 |
# from english/template/debian/languages.wml
|
| 41 |
joy |
1.6 |
# TODO: Needs to be synced frequently or fixed so it's automatic
|
| 42 |
joy |
1.1 |
my %langs = ( english => "en",
|
| 43 |
|
|
hellas => "el",
|
| 44 |
|
|
turkish => "tr",
|
| 45 |
|
|
romanian => "ro",
|
| 46 |
|
|
esperanto => "eo",
|
| 47 |
|
|
finnish => "fi",
|
| 48 |
|
|
portuguese => "pt",
|
| 49 |
|
|
danish => "da",
|
| 50 |
|
|
french => "fr",
|
| 51 |
|
|
dutch => "nl",
|
| 52 |
|
|
german => "de",
|
| 53 |
|
|
italian => "it",
|
| 54 |
|
|
spanish => "es",
|
| 55 |
|
|
korean => "ko",
|
| 56 |
|
|
japanese => "ja",
|
| 57 |
|
|
croatian => "hr",
|
| 58 |
|
|
chinese => "zh",
|
| 59 |
|
|
swedish => "sv",
|
| 60 |
|
|
polish => "pl",
|
| 61 |
|
|
norwegian => "no",
|
| 62 |
|
|
russian => "ru",
|
| 63 |
|
|
hungarian => "hu",
|
| 64 |
|
|
);
|
| 65 |
|
|
|
| 66 |
joy |
1.4 |
$border_head = "<table width=95% align=center border=0 cellpadding=0 cellspacing=0><tr bgcolor=#000000><td>"
|
| 67 |
joy |
1.1 |
."<table width=100% border=0 cellpadding=0 cellspacing=1><tr bgcolor=#ffffff><td>";
|
| 68 |
|
|
$border_foot = "</td></tr></table></td></tr></table>";
|
| 69 |
|
|
|
| 70 |
|
|
|
| 71 |
|
|
$date = strftime "%a %b %e %H:%M:%S %Y %z", localtime;
|
| 72 |
|
|
|
| 73 |
|
|
sub get_cvs_version
|
| 74 |
|
|
{
|
| 75 |
|
|
my ($dir, $wmlfile) = @_;
|
| 76 |
|
|
my $file;
|
| 77 |
|
|
my @comp;
|
| 78 |
|
|
my $version;
|
| 79 |
|
|
|
| 80 |
|
|
@comp = split (/\//, "$dir/$wmlfile");
|
| 81 |
|
|
pop @comp;
|
| 82 |
|
|
$dir = join ("/", @comp);
|
| 83 |
|
|
|
| 84 |
|
|
@comp = split (/\//, "$wmlfile");
|
| 85 |
|
|
$file = pop @comp;
|
| 86 |
|
|
|
| 87 |
|
|
if (open (CVS,"$dir/CVS/Entries")) {
|
| 88 |
|
|
while (<CVS>) {
|
| 89 |
|
|
($version) = $_ =~ m,/\Q$file\E/([\d\.]*),;
|
| 90 |
|
|
last if $version;
|
| 91 |
|
|
}
|
| 92 |
|
|
}
|
| 93 |
|
|
|
| 94 |
|
|
return $version;
|
| 95 |
|
|
}
|
| 96 |
|
|
|
| 97 |
|
|
sub get_translation_version
|
| 98 |
|
|
{
|
| 99 |
|
|
my ($dir, $file) = @_;
|
| 100 |
|
|
my $checktrans;
|
| 101 |
|
|
|
| 102 |
|
|
if (open (F, "$dir/$file")) {
|
| 103 |
|
|
$checktrans = 0;
|
| 104 |
|
|
while (<F>) {
|
| 105 |
|
|
chomp;
|
| 106 |
|
|
if (/^\#use wml::debian::translation-check/) {
|
| 107 |
|
|
$checktrans = 1;
|
| 108 |
|
|
return $1 if ($_ =~ /translation="([^\" ]+)"/);
|
| 109 |
|
|
last;
|
| 110 |
|
|
}
|
| 111 |
|
|
}
|
| 112 |
|
|
close (F);
|
| 113 |
|
|
}
|
| 114 |
|
|
return "";
|
| 115 |
|
|
}
|
| 116 |
|
|
|
| 117 |
|
|
# Count wml files in given directory
|
| 118 |
|
|
#
|
| 119 |
|
|
sub getwmlfiles
|
| 120 |
|
|
{
|
| 121 |
|
|
my $lang = shift;
|
| 122 |
|
|
my $cmd = "find $config{'wmldir'}/$lang -name \"$config{'wmlpat'}\"";
|
| 123 |
|
|
my $cutfrom = length ($config{'wmldir'})+length($lang)+2;
|
| 124 |
|
|
my $count = 0;
|
| 125 |
|
|
my $is_english = ($lang eq "english")?1:0;
|
| 126 |
|
|
my $file, $v;
|
| 127 |
joy |
1.6 |
my $l = $langs{$lang};
|
| 128 |
joy |
1.1 |
|
| 129 |
|
|
return if (! -d "$config{'wmldir'}/$lang");
|
| 130 |
|
|
open (FIND, "$cmd|") || die "Can't read from $cmd";
|
| 131 |
|
|
while (<FIND>) {
|
| 132 |
|
|
next if (/\/sitemap\.wml/);
|
| 133 |
|
|
next if (/\/template\//);
|
| 134 |
|
|
next if (/\/MailingLists\/(un)?subscribe\.wml/);
|
| 135 |
|
|
chomp;
|
| 136 |
|
|
$file = substr ($_, $cutfrom);
|
| 137 |
|
|
$file =~ s/\.wml$//;
|
| 138 |
joy |
1.6 |
$wmlfiles{$l} .= " " . $file;
|
| 139 |
joy |
1.1 |
if ($is_english) {
|
| 140 |
|
|
$version{"$lang/$file"} = get_cvs_version ("$config{'wmldir'}/$lang", "$file.wml");
|
| 141 |
|
|
} else {
|
| 142 |
|
|
$version{"$lang/$file"} = get_translation_version ("$config{'wmldir'}/$lang", "$file.wml");
|
| 143 |
|
|
}
|
| 144 |
|
|
$count++;
|
| 145 |
|
|
}
|
| 146 |
|
|
close (FIND);
|
| 147 |
joy |
1.6 |
$wmlfiles{$l} .= " ";
|
| 148 |
|
|
$wml{$l} = $count;
|
| 149 |
joy |
1.1 |
}
|
| 150 |
|
|
|
| 151 |
|
|
sub get_color
|
| 152 |
|
|
{
|
| 153 |
|
|
my $percent = shift;
|
| 154 |
|
|
|
| 155 |
|
|
if ((255 - ($percent * (255/75))) < 0) {
|
| 156 |
|
|
return sprintf ("#%02x%02x00", 255 - ($percent * (255/100)), $percent * (255/100));
|
| 157 |
|
|
} else {
|
| 158 |
|
|
return sprintf ("#%02x%02x00", 255 - ($percent * (255/75)), $percent * (255/100));
|
| 159 |
|
|
}
|
| 160 |
|
|
}
|
| 161 |
|
|
|
| 162 |
|
|
sub check_translation
|
| 163 |
|
|
{
|
| 164 |
|
|
my ($translation, $version, $file) = @_;
|
| 165 |
|
|
my @version_numbers, $major_number, $last_number;
|
| 166 |
|
|
my @translation_numbers, $major_translated_number, $last_translated_number;
|
| 167 |
|
|
|
| 168 |
|
|
if ($version ne "" && $translation ne "") {
|
| 169 |
|
|
@version_numbers = split /\./,$version;
|
| 170 |
|
|
$major_number = @version_numbers[0];
|
| 171 |
|
|
$last_number = pop @version_numbers;
|
| 172 |
|
|
die "Invalid CVS revision for $file: $version\n"
|
| 173 |
|
|
unless ($major_number =~ /\d+/ && $last_number =~ /\d+/);
|
| 174 |
|
|
|
| 175 |
|
|
@translation_numbers = split /\./,$translation;
|
| 176 |
|
|
$major_translated_number = @translation_numbers[0];
|
| 177 |
|
|
$last_translated_number = pop @translation_numbers;
|
| 178 |
|
|
die "Invalid translation revision for $file: $translation\n"
|
| 179 |
|
|
unless ($major_translated_number =~ /\d+/ && $last_translated_number =~ /\d+/);
|
| 180 |
|
|
|
| 181 |
|
|
# Here we compare the original version with the translated one and print
|
| 182 |
|
|
# a note for the user if their first or last numbers are too far apart
|
| 183 |
|
|
# From translation-check.wml
|
| 184 |
|
|
|
| 185 |
|
|
if ($version eq "") {
|
| 186 |
|
|
return "The original no longer exists";
|
| 187 |
|
|
} elsif ( $major_number != $major_translated_number ) {
|
| 188 |
|
|
return "This translation is too out of date";
|
| 189 |
|
|
} elsif ( $last_number - $last_translated_number >= $max_versions ) {
|
| 190 |
|
|
return "This translation is too out of date";
|
| 191 |
|
|
} elsif ( $last_number - $last_translated_number >= $min_versions ) {
|
| 192 |
|
|
return "The original is newer than this translation";
|
| 193 |
|
|
}
|
| 194 |
|
|
}
|
| 195 |
|
|
return "";
|
| 196 |
|
|
}
|
| 197 |
|
|
|
| 198 |
|
|
print "Investigating english \n" if ($config{'verbose'});
|
| 199 |
|
|
|
| 200 |
|
|
getwmlfiles ('english');
|
| 201 |
|
|
|
| 202 |
|
|
foreach $l (keys %langs) {
|
| 203 |
|
|
next if ($l eq "english");
|
| 204 |
|
|
print "$l " if ($config{'verbose'});
|
| 205 |
joy |
1.6 |
getwmlfiles ($l);
|
| 206 |
joy |
1.1 |
}
|
| 207 |
|
|
print "\n" if ($config{'verbose'});
|
| 208 |
|
|
|
| 209 |
|
|
# =============== Create HTML files ===============
|
| 210 |
|
|
mkdir ($config{'htmldir'}, 0755) if (! -d $config{'htmldir'});
|
| 211 |
|
|
|
| 212 |
|
|
@sorted_english = sort (split (/ /, $wmlfiles{'en'}));
|
| 213 |
|
|
|
| 214 |
|
|
foreach $lang (sort (keys %langs)) {
|
| 215 |
|
|
$l = $langs{$lang};
|
| 216 |
|
|
printf "Creating %s.html...\n", $l if ($config{'verbose'});
|
| 217 |
joy |
1.4 |
|
| 218 |
|
|
foreach $file (@sorted_english) {
|
| 219 |
|
|
next if ($file eq "");
|
| 220 |
|
|
# Translated pages
|
| 221 |
|
|
if (index ($wmlfiles{$l}, " $file ") >= 0) {
|
| 222 |
|
|
$t_body .= sprintf ("<a href=\"/%s.%s.html\">%s</a><br>\n",
|
| 223 |
|
|
$file, $l, $file);
|
| 224 |
|
|
$translated{$lang}++;
|
| 225 |
|
|
# Outdated translations
|
| 226 |
|
|
$msg = check_translation ($version{"$lang/$file"}, $version{"english/$file"}, "$lang/$file");
|
| 227 |
|
|
if (length ($msg)) {
|
| 228 |
|
|
$o_body .= sprintf ("<tr><td><a href=\"/%s.%s.html\">%s</a></td><td>%s</td><td>%s</td>"
|
| 229 |
|
|
."<td>%s</td></tr>\n",
|
| 230 |
|
|
$file, $l, $file, $version{"$lang/$file"}, $version{"english/$file"}, $msg);
|
| 231 |
|
|
$outdated{$lang}++;
|
| 232 |
|
|
}
|
| 233 |
|
|
}
|
| 234 |
|
|
# Untranslated pages
|
| 235 |
|
|
else {
|
| 236 |
|
|
$u_body .= sprintf ("<a href=\"/%s\">%s</a><br>", $file, $file);
|
| 237 |
|
|
$untranslated{$lang}++;
|
| 238 |
|
|
}
|
| 239 |
|
|
}
|
| 240 |
joy |
1.6 |
|
| 241 |
|
|
$translated{$lang} = $translated{$lang} - $outdated{$lang};
|
| 242 |
|
|
|
| 243 |
joy |
1.5 |
$percent_a{$l} = $wml{$l}/$wml{en} * 100;
|
| 244 |
|
|
$percent_t{$l} = $translated{$lang}/$wml{en} * 100;
|
| 245 |
|
|
$percent_o{$l} = $outdated{$lang}/$wml{en} * 100;
|
| 246 |
|
|
$percent_u{$l} = $untranslated{$lang}/$wml{en} * 100;
|
| 247 |
joy |
1.4 |
|
| 248 |
joy |
1.1 |
if (open (HTML, ">$config{'htmldir'}/$l.html")) {
|
| 249 |
|
|
printf HTML "<html><head><title>%s: %s</title></head><body bgcolor=#ffffff>\n", $config{'title'}, $l;
|
| 250 |
|
|
|
| 251 |
joy |
1.5 |
$color = get_color ($percent_a{$l});
|
| 252 |
joy |
1.1 |
|
| 253 |
|
|
printf HTML "<table width=100%% cellpadding=2 cellspacing=0 bgcolor=%s>\n", $color;
|
| 254 |
|
|
|
| 255 |
joy |
1.4 |
printf HTML "<tr><td colspan=4><h1 align=center>%s: %s</h1></td></tr>", $config{'title'}, $l;
|
| 256 |
joy |
1.1 |
|
| 257 |
joy |
1.4 |
print HTML "<tr>\n";
|
| 258 |
joy |
1.5 |
printf HTML "<td align=center width=25%%><b>%d files (%d%%) translated</b></td>", $wml{$l}, $percent_a{$l};
|
| 259 |
|
|
printf HTML "<td align=center width=25%%><b>%d files (%d%%) up to date</b></td>", $translated{$lang}, $percent_t{$l};
|
| 260 |
|
|
printf HTML "<td align=center width=25%%><b>%d files (%d%%) outdated</b></td>", $outdated{$lang}, $percent_o{$l};
|
| 261 |
|
|
printf HTML "<td align=center width=25%%><b>%d files (%d%%) not translated</b></td>", $untranslated{$lang}, $percent_u{$l};
|
| 262 |
joy |
1.4 |
print HTML "</tr>\n</table>\n";
|
| 263 |
joy |
1.1 |
|
| 264 |
joy |
1.3 |
print HTML "<p><a href=\"./\">Index</a><p>\n";
|
| 265 |
|
|
print HTML "<p><a href=\"../\">Working on the website</a><p>\n";
|
| 266 |
joy |
1.1 |
|
| 267 |
joy |
1.4 |
if ($o_body) {
|
| 268 |
|
|
print HTML "<h3>Outdated translations:</h3>";
|
| 269 |
joy |
1.1 |
print HTML "<table border=0 cellpadding=1 cellspacing=1>\n";
|
| 270 |
|
|
print HTML "<tr><th>File</th><th>Translated</th><th>English</th><th>Comment</th></tr>\n";
|
| 271 |
joy |
1.4 |
print HTML $o_body;
|
| 272 |
joy |
1.1 |
print HTML "</table>\n";
|
| 273 |
|
|
}
|
| 274 |
joy |
1.4 |
if ($u_body) {
|
| 275 |
|
|
print HTML "<h3>Pages not translated:</h3>";
|
| 276 |
|
|
print HTML $u_body;
|
| 277 |
joy |
1.1 |
}
|
| 278 |
joy |
1.4 |
if ($t_body) {
|
| 279 |
|
|
print HTML "<h3>Translations up to date:</h3>";
|
| 280 |
|
|
print HTML $t_body;
|
| 281 |
joy |
1.1 |
}
|
| 282 |
|
|
|
| 283 |
|
|
print HTML "</table>\n";
|
| 284 |
|
|
print HTML "<hr><address>Compiled at $date</address>\n";
|
| 285 |
|
|
print HTML "</body></html>";
|
| 286 |
|
|
close (HTML);
|
| 287 |
|
|
}
|
| 288 |
|
|
}
|
| 289 |
|
|
|
| 290 |
|
|
# =============== Creating index.html ===============
|
| 291 |
|
|
print "Creating index.html...\n" if ($config{'verbose'});
|
| 292 |
|
|
|
| 293 |
|
|
open (HTML, ">$config{'htmldir'}/index.html")
|
| 294 |
|
|
|| die "Can't open $config{'htmldir'}/index.html";
|
| 295 |
|
|
|
| 296 |
joy |
1.3 |
printf HTML "<html>\n<head><title>%s</title></head>\n<body bgcolor=#ffffff>\n", $config{'title'};
|
| 297 |
joy |
1.4 |
printf HTML "<h1 align=center>%s</h1>\n", $config{'title'};
|
| 298 |
joy |
1.1 |
|
| 299 |
|
|
print HTML $border_head;
|
| 300 |
joy |
1.4 |
print HTML "<table width=100% border=0 bgcolor=\"#cdc9c9\">\n";
|
| 301 |
joy |
1.6 |
print HTML "<tr><th>Language</th><th>Files</th><th>Up to date</th><th>Outdated</th><th>Not translated</th></tr>\n";
|
| 302 |
joy |
1.1 |
foreach $lang (sort (keys %langs)) {
|
| 303 |
|
|
$l = $langs{$lang};
|
| 304 |
joy |
1.4 |
|
| 305 |
joy |
1.5 |
$color = get_color ($percent_a{$l});
|
| 306 |
joy |
1.4 |
|
| 307 |
|
|
print HTML "<tr>";
|
| 308 |
|
|
printf HTML "<td><a href=\"%s.html\">%s</a> (%s)</td>", $l, $lang, $l;
|
| 309 |
joy |
1.5 |
printf HTML "<td bgcolor=\"%s\" align=right>%d (%d%%)</td>", $color, $wml{$l}, $percent_a{$l};
|
| 310 |
joy |
1.6 |
if ($l ne "en") {
|
| 311 |
|
|
printf HTML "<td align=right>%d (%d%%)</td>", $translated{$lang}, $percent_t{$l};
|
| 312 |
|
|
printf HTML "<td align=right>%d (%d%%)</td>", $outdated{$lang}, $percent_o{$l};
|
| 313 |
|
|
printf HTML "<td align=right>%d (%d%%)</td>", $untranslated{$lang}, $percent_u{$l};
|
| 314 |
|
|
} else {
|
| 315 |
|
|
print HTML "<td>-</td><td>-</td><td>-</td>";
|
| 316 |
|
|
}
|
| 317 |
joy |
1.4 |
print HTML "</tr>\n",
|
| 318 |
joy |
1.1 |
}
|
| 319 |
|
|
|
| 320 |
|
|
print HTML "</tr></table>";
|
| 321 |
|
|
print HTML $border_foot;
|
| 322 |
|
|
|
| 323 |
joy |
1.3 |
print HTML "</table>\n";
|
| 324 |
joy |
1.4 |
print HTML "<p><hr noshade size=1 width=100%>\n";
|
| 325 |
|
|
print HTML "<p>Created with <a href=\"http://cvs.debian.org/webwml/stattrans.pl?cvsroot=webwml\">webwml-stattrans</a> at $date\n";
|
| 326 |
joy |
1.3 |
print HTML "</body></html>\n";
|
| 327 |
joy |
1.1 |
close (HTML);
|
| 328 |
|
|
|
| 329 |
|
|
|
| 330 |
|
|
# Note:
|
| 331 |
|
|
# Translated pages on ll.html may be higher than in index.html.
|
| 332 |
|
|
# This is due to the fact that some english pages were removed.
|
| 333 |
|
|
|
| 334 |
|
|
# printf "%s\n", join ("\n", keys %version);
|
| 335 |
|
|
# printf "%s - %s\n", $version{'german/devel/index'}, $version{'english/devel/index'};
|
Parent Directory
| 
Revision Log