/[webwml]/webwml/stattrans.pl
ViewVC logotype

Contents of /webwml/stattrans.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.115 - (show annotations) (download)
Tue Apr 29 15:19:40 2014 UTC (3 months, 3 weeks ago) by pabs
Branch: MAIN
CVS Tags: HEAD
Changes since 1.114: +1 -1 lines
File MIME type: text/plain
Switch from http to https for lists.debian.org at weasel's request
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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
19
20 use POSIX qw(strftime);
21 use Getopt::Std;
22
23 # These modules reside under webwml/Perl
24 use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
25 use Local::Cvsinfo;
26 use Webwml::Langs;
27 use Webwml::TransCheck;
28 use Webwml::TransIgnore;
29 use Debian::L10n::Db ('%LanguageList');
30 use Net::Domain qw(hostfqdn);
31
32 BEGIN {
33 $dde_available = 0;
34 eval {
35 require JSON;
36 require LWP::Simple;
37 LWP::Simple->import;
38 $dde_available = 1;
39 }; if ($@) {
40 warn "One or more modules required for DDE support failed to load: $@\n";
41 }
42 }
43
44
45 $| = 1;
46
47 $opt_h = "/srv/www.debian.org/webwml/english/devel/website/stats";
48 $opt_w = "/srv/www.debian.org/webwml";
49 $opt_p = "*.(wml|src)";
50 $opt_t = '<stats_title>';
51 $opt_v = 0;
52 $opt_d = "u";
53 $opt_l = undef;
54 $opt_b = ""; # Base URL, if not debian.org
55 # URL of JSON data or path to plaintext file with lines: "1299999 /doc/index\n"
56 $opt_f = "http://dde.debian.net/dde/q/static/porridge/stats?t=json";
57 getopts('h:w:b:p:t:vd:l:f:') || die;
58 # Replace filename globbing by Perl regexps
59 $opt_p =~ s/\./\\./g;
60 $opt_p =~ s/\?/./g;
61 $opt_p =~ s/\*/.*/g;
62 $opt_p =~ s/$/\$/g;
63 %config = (
64 'htmldir' => $opt_h,
65 'wmldir' => $opt_w,
66 'wmlpat' => $opt_p,
67 'title' => $opt_t,
68 'verbose' => $opt_v,
69 'difftype'=> $opt_d,
70 'hit_file'=> $opt_f,
71 );
72
73 my $l = Webwml::Langs->new($opt_w);
74 my %langs = $l->name_iso();
75
76 my $transignore = Webwml::TransIgnore->new($opt_w);
77
78 my $cvs = Local::Cvsinfo->new();
79 $cvs->options(
80 recursive => 1,
81 matchfile => [ $config{'wmlpat'} ],
82 skipdir => [ "template" ],
83 );
84 $cvs->readinfo("$config{'wmldir'}/english");
85 foreach (@{$transignore->global()}) {
86 $cvs->removefile("$config{'wmldir'}/english/$_");
87 }
88
89 my $altcvs = Local::Cvsinfo->new();
90 $altcvs->options(
91 recursive => 1,
92 matchfile => [ $config{'wmlpat'} ],
93 skipdir => [ "template" ],
94 );
95
96 $max_versions = 5;
97 $min_versions = 1;
98
99
100 $date = strftime "%a %b %e %H:%M:%S %Y %z", localtime;
101
102 my %original;
103 my %transversion;
104 my %version;
105 my %files;
106 my %sizes;
107
108 print "Loading the coordination status databases\n" if ($config{verbose});
109 my %status_db = ();
110 opendir (DATADIR, "$opt_w/english/international/l10n/data")
111 or die "Cannot open directory $opt_w/english/international/l10n/data: $!\n";
112 foreach (readdir (DATADIR)) {
113 # Only check the status files
114 next unless ($_ =~ m/^status\.(.*)$/);
115 my $l = $1;
116 next if (!defined $LanguageList{uc $l});
117 if (-r "$opt_w/english/international/l10n/data/status.$l") {
118 $status_db{$LanguageList{uc $l}} = Debian::L10n::Db->new();
119 $status_db{$LanguageList{uc $l}}->read("$opt_w/english/international/l10n/data/status.$l", 0);
120 }
121 }
122 closedir (DATADIR);
123
124 sub linklist {
125 my ($file, $lang) = @_;
126 my $add = "";
127 if ($status_db{$lang}->has_package('www.debian.org')
128 and $status_db{$lang}->has_status('www.debian.org')) {
129 foreach my $statusline (@{$status_db{$lang}->status('www.debian.org')}) {
130 my ($type, $statfile, $date, $status, $translator, $list, $url, $bug_nb) = @{$statusline};
131 if ($file eq $statfile) {
132 $date =~ s/\s*\+0000$//;
133 $list =~ /^(\d\d\d\d)-(\d\d)-(\d\d\d\d\d)$/;
134 $add = "<a href=\"https://lists.debian.org/debian-l10n-$lang/$1/debian-l10n-$lang-$1$2/msg$3.html\">$status</a>";
135 $add = "<td>$add</td><td>$translator</td><td>$date</td>";
136 }
137 }
138 }
139 $add = '<td></td><td></td><td></td>' if (!length $add);
140 return $add;
141 }
142
143 # Count wml files in given directory
144 #
145 sub getwmlfiles
146 {
147 my $lang = shift;
148 my $dir = "$config{'wmldir'}/$lang";
149 my $cutfrom = length ($config{'wmldir'})+length($lang)+2;
150 my $count = 0;
151 my $size = 0;
152 my $is_english = ($lang eq "english")?1:0;
153 my ( $file, $v );
154 my @listfiles;
155
156 print "$lang " if ($config{verbose});
157 if (! -d "$dir") {
158 print "$0: can't find $dir! Skipping ...\n";
159 return;
160 }
161 if ($is_english) {
162 @listfiles = @{$cvs->files()};
163 } else {
164 $altcvs->reset();
165 $altcvs->readinfo($dir);
166 @listfiles = @{$altcvs->files()};
167 }
168 foreach my $f (@listfiles) {
169 $file = substr ($f, $cutfrom);
170 next if $transignore->is_global($file);
171 $files{$file} = 1;
172 $wmlfiles{$lang} .= " " . $file;
173 my $transcheck = Webwml::TransCheck->new("$dir/$file");
174 if ($transcheck->revision()) {
175 $transversion{"$lang/$file"} = $transcheck->revision();
176 $original{"$lang/$file"} ||= $transcheck->original();
177 }
178 if ($is_english) {
179 $version{"$lang/$file"} = $cvs->revision($f);
180 } else {
181 $version{"$lang/$file"} = $altcvs->revision($f);
182 if (!$transcheck->revision()) {
183 $transcheckenglish = Webwml::TransCheck->new("english/$file");
184 if (!$transcheckenglish->revision() and (-e "english/$file")) {
185 $transversion{"$lang/$file"} = "1.1";
186 $original{"$lang/$file"} = "english";
187 } else {
188 $original{"english/$file"} = $lang;
189 $transversion{"english/$file"} ||= "1.1";
190 }
191 }
192 }
193 if ($transcheck->maintainer()) {
194 $maintainer{"$lang/$file"} = $transcheck->maintainer();
195 }
196 $count++;
197 $sizes{$file} = (stat "".($original{"english/$file"}||"english")."/".$file)[7];
198 $size += $sizes{$file};
199 }
200 $wmlfiles{$lang} .= " ";
201 $wml{$lang} = $count;
202 $wml_s{$lang} = $size;
203 }
204
205 sub get_color
206 {
207 my $percent = shift;
208
209 if ($percent < 50) {
210 return sprintf ("#FF%02x00", (255/50) * $percent);
211 } else {
212 return sprintf ("#%02xFF00", (255/50) * (100 - $percent));
213 }
214 }
215
216 sub check_translation
217 {
218 my ($translation, $version, $file) = @_;
219 my ( @version_numbers, $major_number, $last_number );
220 my ( @translation_numbers, $major_translated_number, $last_translated_number );
221
222 if ( $version && $translation ) {
223 @version_numbers = split /\./,$version;
224 $major_number = $version_numbers[0];
225 $last_number = pop @version_numbers;
226 die "Invalid CVS revision for $file: $version\n"
227 unless ($major_number =~ /\d+/ && $last_number =~ /\d+/);
228
229 @translation_numbers = split /\./,$translation;
230 $major_translated_number = $translation_numbers[0];
231 $last_translated_number = pop @translation_numbers;
232 die "Invalid translation revision for $file: $translation\n"
233 unless ($major_translated_number =~ /\d+/ && $last_translated_number =~ /\d+/);
234
235 # Here we compare the original version with the translated one and print
236 # a note for the user if their first or last numbers are too far apart
237 # From translation-check.wml
238
239 if ( $major_number != $major_translated_number ) {
240 return '<gettext domain="stats">This translation is too out of date</gettext>';
241 } elsif ( $last_number - $last_translated_number < 0 ) {
242 return '<gettext domain="stats">Wrong translation version</gettext>';
243 } elsif ( $last_number - $last_translated_number >= $max_versions ) {
244 return '<gettext domain="stats">This translation is too out of date</gettext>';
245 } elsif ( $last_number - $last_translated_number >= $min_versions ) {
246 return '<gettext domain="stats">The original is newer than this translation</gettext>';
247 }
248 } elsif ( !$version && $translation) {
249 return '<gettext domain="stats">The original no longer exists</gettext>';
250 }
251 return "";
252 }
253
254 print "Collecting data in: " if ($config{'verbose'});
255 if ($opt_l) {
256 getwmlfiles ($opt_l);
257 getwmlfiles ('english');
258 } else {
259 foreach $lang (keys %langs) {
260 getwmlfiles ($lang);
261 }
262 }
263 print "\n" if ($config{'verbose'});
264
265 my @search_in;
266 if ($opt_l) {
267 @search_in = ( 'english', $opt_l );
268 } else {
269 @search_in = sort keys %langs;
270 }
271
272 # Compute stats about gettext files
273 print "Computing statistics in gettext files... " if ($config{'verbose'});
274 my ( %po_translated, %po_fuzzy, %po_untranslated, %po_total );
275 my ( %percent_po_t, %percent_po_u, %percent_po_f );
276 foreach $lang (@search_in) {
277 next if $lang eq 'english';
278 $po_translated{"total"}{$lang} = $po_fuzzy{"total"}{$lang} = $po_untranslated{"total"}{$lang} = 0;
279 $percent_po_t{'total'}{$lang} = 0;
280 $percent_po_f{'total'}{$lang} = 0;
281 $percent_po_u{'total'}{$lang} = 100;
282 if (! -d "$opt_w/$lang/po") {
283 print "$0: can't find $opt_w/$lang/po! Skipping ...\n";
284 next;
285 }
286 my @status = qx,LC_ALL=C make -C $opt_w/$lang/po stats 2>&1,;
287 foreach $line (@status) {
288 chomp $line;
289 next if($line =~ /make: (Enter|Leav)ing directory/);
290 ($domain = $line) =~ s/\..*//;
291 $po_translated{$domain}{$lang} = ($line =~ /(\d+) translated/ ? $1 : "0");
292 $po_fuzzy{$domain}{$lang} = ($line =~ /(\d+) fuzzy/ ? $1 : "0");
293 $po_untranslated{$domain}{$lang} = ($line =~ /(\d+) untranslated/ ? $1 : "0");
294
295 $po_total{$domain} = $po_translated{$domain}{$lang} + $po_fuzzy{$domain}{$lang} + $po_untranslated{$domain}{$lang};
296
297 $po_translated{"total"}{$lang} += $po_translated{$domain}{$lang};
298 $po_fuzzy{"total"}{$lang} += $po_fuzzy{$domain}{$lang};
299 $po_untranslated{"total"}{$lang} += $po_untranslated{$domain}{$lang};
300
301 if ($po_total{$domain} > 0) {
302 $percent_po_t{$domain}{$lang} = int ($po_translated{$domain}{$lang}/$po_total{$domain} * 100 + .5);
303 $percent_po_f{$domain}{$lang} = int ($po_fuzzy{$domain}{$lang}/$po_total{$domain} * 100 + .5);
304 $percent_po_u{$domain}{$lang} = int ($po_untranslated{$domain}{$lang}/$po_total{$domain} * 100 + .5);
305 } else {
306 $percent_po_t{$domain}{$lang} = 0;
307 $percent_po_f{$domain}{$lang} = 0;
308 $percent_po_u{$domain}{$lang} = 0; # or 100 if po/ doesn't exist
309 }
310 }
311 $po_total{"total"} = $po_translated{"total"}{$lang} + $po_fuzzy{"total"}{$lang} + $po_untranslated{"total"}{$lang};
312
313 if ($po_total{'total'} > 0) {
314 $percent_po_t{'total'}{$lang} = int ($po_translated{'total'}{$lang}/$po_total{'total'} * 100 + .5);
315 $percent_po_f{'total'}{$lang} = int ($po_fuzzy{'total'}{$lang}/$po_total{'total'} * 100 + .5);
316 $percent_po_u{'total'}{$lang} = int ($po_untranslated{'total'}{$lang}/$po_total{'total'} * 100 + .5);
317 }
318 }
319 print "done.\n" if ($config{'verbose'});
320
321 # =============== Create HTML files ===============
322 mkdir ($config{'htmldir'}, 02775) if (! -d $config{'htmldir'});
323
324 # Read website hit statistics, if available
325 my %hits;
326 my $hits_hostname;
327 my $hits_datetime;
328 my $file_sorter = sub($$) { $_[0] cmp $_[1] };
329 if ($config{'hit_file'} and $config{'hit_file'} =~ m{^(f|ht)tps?://} and ! $dde_available) {
330 warn "Disabling fetching of hit data.\n";
331 $config{'hit_file'} = undef;
332 }
333 if ($config{'hit_file'}) {
334 if ($config{'hit_file'} =~ m{^(f|ht)tps?://}) {
335 printf("Retrieving hit data from [%s].\n", $config{'hit_file'}) if ($config{'verbose'});
336 my $json = LWP::Simple::get($config{'hit_file'});
337 if ($json) {
338 my $perl = JSON::from_json($json, {utf8 => 1});
339 my %metadata = %{$perl->{'m'}};
340 $hits_hostname = $metadata{'hostname'} || undef;
341 $hits_datetime = defined $metadata{'Last-Modified'} ? strftime "%Y-%m-%d %T GMT", gmtime $metadata{'Last-Modified'} : undef;
342 foreach my $e (@{$perl->{'r'}}) {
343 my ($count, $url) = @$e;
344 last if $count < 3; # URLS with 2 or 1 hits are most likely mistakes; let's not waste RAM on them
345 $hits{substr($url, 1)} = $count;
346 }
347 } else {
348 warn "Retrieving hit data failed.\n";
349 }
350 } else {
351 $hits_hostname = hostfqdn;
352 $hits_datetime = strftime "%Y-%m-%d %T %Z", localtime;
353 open(HITS, $config{'hit_file'}) or die sprintf("Opening hit file [%s] failed: $!", $config{'hit_file'});
354 printf "Reading hit file [%s]\n", $config{'hit_file'} if ($config{'verbose'});
355 foreach my $hit_line (<HITS>) {
356 chomp $hit_line;
357 $hit_line =~ /^\s*(\d+)\s+(.*)/ or warn sprintf("unrecognized hit file [%s] line [%s]", $config{'hit_file'}, $hit_line);
358 my ($count, $url) = ($1, $2);
359 last if $count < 3; # URLS with 2 or 1 hits are most likely mistakes; let's not waste RAM on them
360 $hits{substr($url, 1)} = $count;
361 }
362 close(HITS) or die sprintf("Closing hit file [%s] failed: $!", $config{'hit_file'});
363 }
364 if (%hits) {
365 $file_sorter = sub($$) {
366 my ($a, $b) = @_;
367 $a =~ s/\.wml$//o;
368 $b =~ s/\.wml$//o;
369 $hits{$b} <=> $hits{$a}
370 };
371 } else {
372 print "Tables will be sorted alphabetically.\n" if ($config{'verbose'});
373 }
374 } else {
375 print "No hit file specified. Tables will be sorted alphabetically.\n" if ($config{'verbose'});
376 }
377
378 my @filenames = sort $file_sorter keys %files;
379 my $nfiles = scalar @filenames;
380 $nsize += $sizes{$_} foreach (@filenames);
381
382 my $firstdifftype;
383 my $seconddifftype;
384 if ($config{'difftype'} eq 'u') {
385 $firstdifftype = 'u';
386 $seconddifftype = 'h';
387 } else {
388 $firstdifftype = 'h';
389 $seconddifftype = 'u';
390 }
391
392 sub alioth_cvs_file_url {
393 my ($path) = @_;
394
395 return
396 sprintf( 'http://anonscm.debian.org/viewvc/webwml/webwml/%s', $path );
397 }
398
399 sub alioth_cvs_log_url {
400 my ($path) = @_;
401
402 return alioth_cvs_file_url($path);
403 }
404
405 sub alioth_cvs_diff_url {
406 my ( $path, $r1, $r2, $diff_format ) = @_;
407
408 return alioth_cvs_file_url($path)
409 . sprintf( '?r1=%s;r2=%s;diff_format=%s', $r1, $r2, $diff_format );
410 }
411
412 sub alioth_cvs_view_url {
413 my ($path) = @_;
414
415 return alioth_cvs_file_url($path) . '?view=markup';
416 }
417
418 sub alioth_cvs_raw_url {
419 my ($path) = @_;
420
421 return alioth_cvs_file_url($path) . '?view=co';
422 }
423
424 print "Creating files: " if ($config{'verbose'});
425 foreach $lang (@search_in) {
426 my @processed_langs = ($langs{$lang});
427 @processed_langs = ("zh-cn", "zh-tw") if $langs{$lang} eq "zh";
428 foreach $l (@processed_langs) {
429 print "$l.wml " if ($config{'verbose'});
430 $t_body = $u_body = $ui_body = $un_body = $uu_body = $o_body = "";
431 $translated{$lang} = $outdated{$lang} = $untranslated{$lang} = 0;
432
433 # get stats about files
434 foreach $file (@filenames) {
435 next if ($file eq "");
436 (my $base = $file) =~ s/\.wml$//;
437 my $hits = exists $hits{$base} ? $hits{$base}.' <gettext domain="stats">hits</gettext>' : '<gettext domain="stats">hit count N/A</gettext>';
438 my $todo = '<td></td><td></td><td></td>';
439 $todo = linklist($file, $lang) if defined $status_db{$lang};
440 # Translated pages or already WIP in translation list
441 if ((index ($wmlfiles{$lang}, " $file ") >= 0) or (($todo ne '<td></td><td></td><td></td>') and ($transversion{"$lang/$file"} ne $version{"$orig/$file"}))) {
442 $translated{$lang}++;
443 $translated_s{$lang} += $sizes{$file};
444 $orig = $original{"$lang/$file"} || "english";
445 # Outdated translations
446 $msg = check_translation ($transversion{"$lang/$file"}, $version{"$orig/$file"}, "$lang/$file");
447 if (length ($msg) or (($todo ne '<td></td><td></td><td></td>') and ($transversion{"$lang/$file"} ne $version{"$orig/$file"}))) {
448 $o_body .= "<tr>";
449 if (($file !~ /\.wml$/)
450 || ($file eq "devel/wnpp/wnpp.wml")) {
451 $o_body .= sprintf "<td>%s</td>", $file;
452 } else {
453 $o_body .= sprintf "<td><a title=\"%s\" href=\"$opt_b/%s\">%s</a></td>", $hits, $base, $base;
454 }
455 my $stattd = sprintf '<td style=\'font-family: monospace\' title=\'<gettext domain="stats">Click to fetch diffstat data</gettext>\' onClick="setDiffstat(\'%s\', \'%s\', \'%s\', this)">+/-</td>', $file, $transversion{"$lang/$file"}, $version{"$orig/$file"};
456 my $statspan = sprintf '(<span style=\'font-family: monospace\' title=\'<gettext domain="stats">Click to fetch diffstat data</gettext>\' onClick="setDiffstat(\'%s\', \'%s\', \'%s\', this)">+/-</span>)', $file, $transversion{"$lang/$file"}, $version{"$orig/$file"};
457 if (!defined $status_db{$lang}) {
458 $o_body .= sprintf "<td>%s</td>", $msg;
459 $o_body .= $stattd;
460 }
461 if ($msg eq '<gettext domain="stats">Wrong translation version</gettext>' || $msg eq '<gettext domain="stats">The original no longer exists</gettext>') {
462 if (defined $status_db{$lang}) {
463 $o_body .= sprintf "<td>%d (%.2f&nbsp;&permil;)</td>", $sizes{$file}, $sizes{$file}/$nsize * 1000;
464 } else {
465 $o_body .= "<td></td><td></td>";
466 }
467 } else {
468 if (defined $status_db{$lang}) {
469 if ($transversion{"$lang/$file"} ne ''){
470 $o_body .= sprintf '<td><a title=\'<gettext domain="stats">Unified diff</gettext>\' href="%s">%s&nbsp;→&nbsp;%s</a> ',
471 alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, 'u' ),
472 $transversion{"$lang/$file"}, $version{"$orig/$file"};
473 $o_body .= sprintf '<a title=\'<gettext domain="stats">Colored diff</gettext>\' href="%s">%s&nbsp;→&nbsp;%s</a> ',
474 alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, 'h' ),
475 $transversion{"$lang/$file"}, $version{"$orig/$file"};
476 $o_body .= "$statspan</td>";
477 } else {
478 $o_body .= sprintf "<td>%d (%.2f&nbsp;&permil;)</td>", $sizes{$file}, $sizes{$file}/$nsize * 1000;
479 }
480 } else {
481 $o_body .= sprintf "<td><a href=\"%s\">%s\&nbsp;->\&nbsp;%s</a></td>",
482 alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, $firstdifftype ),
483 $transversion{"$lang/$file"}, $version{"$orig/$file"};
484 $o_body .= sprintf "<td><a href=\"%s\">%s\&nbsp;->\&nbsp;%s</a></td>",
485 alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, $seconddifftype ),
486 $transversion{"$lang/$file"}, $version{"$orig/$file"};
487 }
488 }
489 $o_body .= sprintf "<td><a title=\"%s\" href=\"%s#rev%s\">[L]</a></td>", $msg, alioth_cvs_log_url("$orig/$file"), $version{"$orig/$file"};
490 $o_body .= sprintf "<td><a href=\"%s\">[V]</a>\&nbsp;", alioth_cvs_view_url("$lang/$file");
491 $o_body .= sprintf "<a href=\"%s\">[F]</a></td>", alioth_cvs_raw_url("$lang/$file");
492 $o_body .= sprintf "<td align=center>%s</td>", $maintainer{"$lang/$file"} || "";
493 $o_body .= $todo if (defined $status_db{$lang});
494 $o_body .= "</tr>\n";
495 $outdated{$lang}++;
496 $outdated_s{$lang} += $sizes{$file};
497 # Up-to-date translations
498 } else {
499 if (($file !~ /\.wml$/)
500 || ($file eq "devel/wnpp/wnpp.wml")) {
501 $t_body .= sprintf "<li>%s</li>\n", $file;
502 } else {
503 $t_body .= sprintf "<li><a title=\"%s\" href=\"$opt_b/%s.%s.html\">%s</a></li>\n", $hits, $base, $l, $base;
504 }
505 }
506 }
507 # Untranslated pages
508 else {
509 my $u_tmp;
510 if (($file !~ /\.wml$/)
511 || ($file eq "devel/wnpp/wnpp.wml")) {
512 $u_tmp = sprintf "<tr><td>%s</td><td>&nbsp;</td></tr>\n", $file;
513 } else {
514 $u_tmp = sprintf "<tr><td><a title=\"%s\" href=\"$opt_b/%s\">%s&nbsp;&nbsp;(%s)</a></td><td align=\"right\">%d</td><td>(%.2f&nbsp;&permil;)</td></tr>\n", $hits, $base, $base, $version{"$orig/$file"}, $sizes{$file}, $sizes{$file}/$nsize * 1000;
515 }
516 if (($file =~ /international\//) &&
517 (($file !~ /international\/index.wml$/) ||
518 ($file !~ /international\/l10n\//))) {
519 $ui_body .=$u_tmp;
520 } elsif ((($file =~ /(News|events|security|vote)\/[0-9]{4}\//) &&
521 ($file !~ /index.wml$/)) ||
522 ($file =~ /(News\/weekly\/[0-9]{4}\/|security\/undated)/)) {
523 $un_body .= $u_tmp;
524 } elsif (($file =~ /(consultants|users\/(com|edu|gov|org))\//) &&
525 ($file !~ /index.wml$/)) {
526 $uu_body .=$u_tmp;
527 } else {
528 $u_body .= $u_tmp;
529 }
530 $untranslated{$lang}++;
531 $untranslated_s{$lang} += $sizes{$file};
532 }
533 }
534
535
536 # this is where we discard the files that the translation directory contains
537 # but which don't exist in the English directory
538 # print "extra files: ".$wml{$lang}-$translated{$lang}."\n";
539 $wml{$lang} = $translated{$lang};
540 $wml_s{$lang} = $translated_s{$lang};
541 $translated{$lang} = $translated{$lang} - $outdated{$lang};
542 $translated_s{$lang} = $translated_s{$lang} - $outdated_s{$lang};
543
544 if ($nfiles > 0) {
545 $percent_a{$lang} = $wml{$lang}/$nfiles * 100;
546 } else {
547 $percent_a{$lang} = 0;
548 }
549 if ($nsize > 0) {
550 $percent_as{$lang} = $wml_s{$lang}/$nsize * 100;
551 } else {
552 $percent_as{$lang} = 0;
553 }
554 if ($wml{$lang} > 0) {
555 $percent_t{$lang} = $translated{$lang}/$wml{$lang} * 100;
556 } else {
557 $percent_t{$lang} = 0;
558 }
559 if ($wml_s{$lang} > 0) {
560 $percent_ts{$lang} = $translated_s{$lang}/$wml_s{$lang} * 100;
561 } else {
562 $percent_ts{$lang} = 0;
563 }
564 $percent_o{$lang} = 100 - $percent_t{$lang};
565 $percent_os{$lang} = 100 - $percent_ts{$lang};
566 $percent_u{$lang} = 100 - $percent_a{$lang};
567 $percent_us{$lang} = 100 - $percent_as{$lang};
568
569 if (open (HTML, ">$config{'htmldir'}/$l.wml")) {
570 printf HTML "#use wml::debian::template title=\"<:=\$trans{\$CUR_ISO_LANG}{%s}:>\"\n", $lang;
571 print HTML "#use wml::debian::toc\n";
572 print HTML "<script src=\"diffstat.js\" type=\"text/javascript\"></script>\n\n";
573 $color = get_color ($percent_a{$lang});
574
575 printf HTML '<table summary="<gettext domain="stats">Translation summary for</gettext> <:=$trans{$CUR_ISO_LANG}{'.$lang.'} :>" style="background-color: %s; width: 100%; font-weight: bold; margin: 0; text-align: center;">'."\n", $color;
576 print HTML "<colgroup span=\"4\" width=\"25%\"></colgroup>\n";
577
578 print HTML '<tr><th><gettext domain="stats">Translated</gettext></th><th><gettext domain="stats">Up to date</gettext></th><th><gettext domain="stats">Outdated</gettext></th><th><gettext domain="stats">Not translated</gettext></th></tr>'."\n<tr>\n";
579 printf HTML '<td>%d <gettext domain="stats">files</gettext> (%.1f%%)</td>', $wml{$lang}, $percent_a{$lang};
580 printf HTML '<td>%d <gettext domain="stats">files</gettext> (%.1f%%)</td>', $translated{$lang}, $percent_t{$lang};
581 printf HTML '<td>%d <gettext domain="stats">files</gettext> (%.1f%%)</td>', $outdated{$lang}, $percent_o{$lang};
582 printf HTML '<td>%d <gettext domain="stats">files</gettext> (%.1f%%)</td>', $untranslated{$lang}, $percent_u{$lang};
583 print HTML "</tr>\n";
584 print HTML "<tr>\n";
585 printf HTML '<td>%d <gettext domain="stats">bytes</gettext> (%.1f%%)</td>', $wml_s{$lang}, $percent_as{$lang};
586 printf HTML '<td>%d <gettext domain="stats">bytes</gettext> (%.1f%%)</td>', $translated_s{$lang}, $percent_ts{$lang};
587 printf HTML '<td>%d <gettext domain="stats">bytes</gettext> (%.1f%%)</td>', $outdated_s{$lang}, $percent_os{$lang};
588 printf HTML '<td>%d <gettext domain="stats">bytes</gettext> (%.1f%%)</td>', $nsize-$wml_s{$lang}, $percent_us{$lang};
589 print HTML "</tr>\n";
590 print HTML "</table>\n";
591
592 # Make the table of content
593 print HTML "<toc-display/>\n";
594 if (%hits) {
595 print HTML '<p><gettext domain="stats">Note: the lists of pages are sorted by popularity. Hover over the page name to see the number of hits.</gettext>';
596 if (defined $hits_hostname and defined $hits_datetime) {
597 printf HTML ' <stats_hit_source "%s" "%s">', $hits_hostname, $hits_datetime;
598 }
599 print HTML "</p>\n";
600 }
601
602 # outputs the content
603 if ($o_body) {
604 print HTML '<toc-add-entry name="outdated"><gettext domain="stats">Outdated translations</gettext></toc-add-entry>'."\n";
605 print HTML "<table summary=\"Outdated translations\" border=0 cellpadding=1 cellspacing=1>\n";
606 print HTML '<tr><th><gettext domain="stats">File</gettext></th>'."\n";
607 if (defined $status_db{$lang}) {
608 print HTML '<th><gettext domain="stats">Diff</gettext></th>';
609 } else {
610 print HTML '<th><gettext domain="stats">Comment</gettext></th>'."\n";
611 print HTML '<th><gettext domain="stats">Diffstat</gettext></th>'."\n";
612 if ($opt_d eq "u") { print HTML '<th><gettext domain="stats">Unified diff</gettext></th><th><gettext domain="stats">Colored diff</gettext></th>'; }
613 elsif ($opt_d eq "h") { print HTML '<th><gettext domain="stats">Colored diff</gettext></th><th><gettext domain="stats">Unified diff</gettext></th>'; }
614 else { print HTML '<th><gettext domain="stats">Diff</gettext></th>'; }
615 }
616 print HTML '<th><gettext domain="stats">Log</gettext></th>';
617 print HTML '<th><gettext domain="stats">Translation</gettext></th>';
618 print HTML '<th><gettext domain="stats">Maintainer</gettext></th>';
619 if (defined $status_db{$lang}) {
620 print HTML '<th><gettext domain="stats">Status</gettext></th>';
621 print HTML '<th><gettext domain="stats">Translator</gettext></th>';
622 print HTML '<th><gettext domain="stats">Date</gettext></th>';
623 }
624 print HTML "</tr>\n";
625 print HTML $o_body;
626 print HTML "</table>\n";
627 }
628 if ($u_body) {
629 print HTML '<toc-add-entry name="untranslated"><gettext domain="stats">General pages not translated</gettext></toc-add-entry>'."\n";
630 print HTML '<table summary="<gettext domain="stats">Untranslated general pages</gettext>">'."\n";
631 print HTML $u_body;
632 print HTML "</table>\n";
633 }
634 if ($un_body) {
635 print HTML '<toc-add-entry name="untranslated-news"><gettext domain="stats">News items not translated</gettext></toc-add-entry>'."\n";
636 print HTML '<table summary="<gettext domain="stats">Untranslated news items</gettext>">'."\n";
637 print HTML $un_body;
638 print HTML "</table>\n";
639 }
640 if ($uu_body) {
641 print HTML '<toc-add-entry name="untranslated-user"><gettext domain="stats">Consultant/user pages not translated</gettext></toc-add-entry>'."\n";
642 print HTML '<table summary="<gettext domain="stats">Untranslated consultant/user pages</gettext>">'."\n";
643 print HTML $uu_body;
644 print HTML "</table>\n";
645 }
646 if ($ui_body) {
647 print HTML '<toc-add-entry name="untranslated-l10n"><gettext domain="stats">International pages not translated</gettext></toc-add-entry>'."\n";
648 print HTML '<table summary="<gettext domain="stats">Untranslated international pages</gettext>">'."\n";
649 print HTML $ui_body;
650 print HTML "</table>\n";
651 }
652 if ($t_body) {
653 print HTML '<toc-add-entry name="uptodate"><gettext domain="stats">Translated pages (up-to-date)</gettext></toc-add-entry>'."\n";
654 print HTML "<ul class=\"discless\">\n";
655 print HTML $t_body;
656 print HTML "</ul>\n";
657 }
658 # outputs the gettext stats
659 if ($lang ne 'english') {
660 print HTML '<toc-add-entry name="gettext"><gettext domain="stats">Translated templates (PO files)</gettext></toc-add-entry>'."\n";
661 print HTML '<table summary="<gettext domain="stats">PO Translation Statistics</gettext>" width="100%">'."\n";
662 print HTML '<tr><th><gettext domain="stats">File</gettext></th>'."\n";
663 print HTML '<th><gettext domain="stats">Up to date</gettext></th>'."\n";
664 print HTML '<th><gettext domain="stats">Fuzzy</gettext></th>'."\n";
665 print HTML '<th><gettext domain="stats">Untranslated</gettext></th>'."\n";
666 print HTML '<th><gettext domain="stats">Total</gettext></th></tr>'."\n";
667 foreach my $domain (sort keys %po_total) {
668 next if $domain eq 'total';
669 print HTML "<tr>";
670
671 $color_t = get_color ($percent_po_t{$domain}{$lang});
672 $color_f = get_color (100 - $percent_po_f{$domain}{$lang});
673 $color_u = get_color (100 - $percent_po_u{$domain}{$lang});
674
675 print HTML "<td>$domain.$langs{$lang}.po</td>";
676 printf HTML "<td style=\"background-color: %s\" align=right>%d (%s%%)</td>", $color_t, $po_translated{$domain}{$lang}, $percent_po_t{$domain}{$lang};
677 printf HTML "<td style=\"background-color: %s\" align=right>%d (%s%%)</td>", $color_f, $po_fuzzy{$domain}{$lang}, $percent_po_f{$domain}{$lang};
678 printf HTML "<td style=\"background-color: %s\" align=right>%d (%s%%)</td>", $color_u, $po_untranslated{$domain}{$lang}, $percent_po_u{$domain}{$lang};
679 printf HTML "<td align=right>%d</td>", $po_total{$domain};
680 print HTML "</tr>\n";
681 }
682 print HTML "<tr><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td></tr>\n";
683 print HTML '<tr><th><gettext domain="stats">Total:</gettext></th>';
684 $color_t = get_color ($percent_po_t{'total'}{$lang});
685 $color_f = get_color (100 - $percent_po_f{'total'}{$lang});
686 $color_u = get_color (100 - $percent_po_u{'total'}{$lang});
687 printf HTML "<td style=\"background-color: %s\" align=right>%d (%d%%)</td>", $color_t, $po_translated{'total'}{$lang}, $percent_po_t{'total'}{$lang};
688 printf HTML "<td style=\"background-color: %s\" align=right>%d (%d%%)</td>", $color_f, $po_fuzzy{'total'}{$lang}, $percent_po_f{'total'}{$lang};
689 printf HTML "<td style=\"background-color: %s\" align=right>%d (%d%%)</td>", $color_u, $po_untranslated{'total'}{$lang}, $percent_po_u{'total'}{$lang};
690 printf HTML "<td align=right>%d</td>", $po_total{'total'};
691 print HTML "</tr>\n";
692 print HTML "</table>\n";
693 }
694
695 print HTML
696 '<address><gettext domain="stats">Created with</gettext> <a href="'
697 . alioth_cvs_view_url('stattrans.pl')
698 . '">webwml-stattrans</a></address>' . "\n";
699 close (HTML);
700 } else {
701 print "Can't open $config{'htmldir'}/$l.wml\n";
702 }
703 }
704 }
705 print "\n" if ($config{'verbose'});
706
707 # =============== Creating index.html ===============
708 print "Creating index.wml... " if ($config{'verbose'});
709
710 open (HTMLI, ">$config{'htmldir'}/index.wml")
711 || die "Can't open $config{'htmldir'}/index.wml";
712
713 print HTMLI "#use wml::debian::stats_tags\n";
714 printf HTMLI "#use wml::debian::template title=\"%s\"\n\n", $config{'title'};
715 print HTMLI '<h2><gettext domain="stats">Translated web pages</gettext></h2>'."\n";
716 printf HTMLI "<p><stats_pages %d></p>\n",($wml{'english'}+$untranslated{'english'});
717
718 print HTMLI '<table summary="<gettext domain="stats">Translation Statistics by Page Count</gettext>" class="stattrans">'."\n";
719 print HTMLI "<colgroup width=\"20%\">\n";
720 print HTMLI "<col>\n";
721 print HTMLI "</colgroup>";
722 print HTMLI "<colgroup width=\"10%\">\n";
723 print HTMLI "<col width=\"10%\">\n";
724 print HTMLI "<col width=\"10%\">\n";
725 print HTMLI "<col width=\"10%\">\n";
726 print HTMLI "<col width=\"10%\">\n";
727 print HTMLI "<col width=\"10%\">\n";
728 print HTMLI "<col width=\"10%\">\n";
729 print HTMLI "<col width=\"10%\">\n";
730 print HTMLI "<col width=\"10%\">\n";
731 print HTMLI "</colgroup>";
732 print HTMLI "<thead>";
733 print HTMLI '<tr><th><gettext domain="stats">Language</gettext></th>'."\n";
734 print HTMLI '<th colspan="2"><gettext domain="stats">Translations</gettext></th>'."\n";
735 print HTMLI '<th colspan="2"><gettext domain="stats">Up to date</gettext></th>'."\n";
736 print HTMLI '<th colspan="2"><gettext domain="stats">Outdated</gettext></th>'."\n";
737 print HTMLI '<th colspan="2"><gettext domain="stats">Not translated</gettext></th></tr>'."\n";
738 print HTMLI "</thead>";
739 print HTMLI "<tbody>";
740 foreach $lang (@search_in) {
741 my @processed_langs = ($langs{$lang});
742 @processed_langs = ("zh-cn", "zh-tw") if $langs{$lang} eq "zh";
743 foreach $l (@processed_langs) {
744 $color_a = get_color ($percent_a{$lang});
745 $color_t = get_color ($percent_t{$lang});
746 $color_o = get_color (100 - $percent_o{$lang});
747 $color_u = get_color (100 - $percent_u{$lang});
748
749 print HTMLI "<tr>";
750 printf HTMLI "<th><a href=\"%s\"><:=\$trans{\$CUR_ISO_LANG}{%s} :></a> (%s)</th>", $l, $lang, $l;
751 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_a, $wml{$lang}, $percent_a{$lang};
752 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_t, $translated{$lang}, $percent_t{$lang};
753 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_o, $outdated{$lang}, $percent_o{$lang};
754 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_u, $untranslated{$lang}, $percent_u{$lang};
755 print HTMLI "</tr>\n";
756 }
757 }
758 print HTMLI "</tbody>";
759 print HTMLI "</table>\n";
760
761 print HTMLI '<h2><gettext domain="stats">Translated web pages (by size)</gettext></h2>'."\n";
762 printf HTMLI "<p><stats_bytes %d></p>\n",($wml_s{'english'}+$untranslated_s{'english'});
763
764 print HTMLI '<table summary="<gettext domain="stats">Translation Statistics by Page Size</gettext>" class="stattrans">'."\n";
765 print HTMLI "<colgroup span=\"1\">\n";
766 print HTMLI "<col width=\"20%\">\n";
767 print HTMLI "</colgroup>";
768 print HTMLI "<colgroup span=\"8\">\n";
769 print HTMLI "<col width=\"13%\">\n";
770 print HTMLI "<col width=\"7%\">\n";
771 print HTMLI "<col width=\"13%\">\n";
772 print HTMLI "<col width=\"7%\">\n";
773 print HTMLI "<col width=\"13%\">\n";
774 print HTMLI "<col width=\"7%\">\n";
775 print HTMLI "<col width=\"13%\">\n";
776 print HTMLI "<col width=\"7%\">\n";
777 print HTMLI "</colgroup>";
778 print HTMLI "<thead>";
779 print HTMLI '<tr><th><gettext domain="stats">Language</gettext></th>'."\n";
780 print HTMLI '<th colspan="2"><gettext domain="stats">Translations</gettext></th>'."\n";
781 print HTMLI '<th colspan="2"><gettext domain="stats">Up to date</gettext></th>'."\n";
782 print HTMLI '<th colspan="2"><gettext domain="stats">Outdated</gettext></th>'."\n";
783 print HTMLI '<th colspan="2"><gettext domain="stats">Not translated</gettext></th></tr>'."\n";
784 print HTMLI "</thead>";
785 print HTMLI "<tbody>";
786
787 foreach $lang (@search_in) {
788 my @processed_langs = ($langs{$lang});
789 @processed_langs = ("zh-cn", "zh-tw") if $langs{$lang} eq "zh";
790 foreach $l (@processed_langs) {
791 $color_a = get_color ($percent_a{$lang});
792 $color_t = get_color ($percent_t{$lang});
793 $color_o = get_color (100 - $percent_o{$lang});
794 $color_u = get_color (100 - $percent_u{$lang});
795
796 print HTMLI "<tr>";
797 printf HTMLI "<th><a href=\"%s\"><:=\$trans{\$CUR_ISO_LANG}{%s} :></a> (%s)</th>", $l, $lang, $l;
798 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_a, $wml_s{$lang}, $percent_as{$lang};
799 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_t, $translated_s{$lang}, $percent_ts{$lang};
800 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_o, $outdated_s{$lang}, $percent_os{$lang};
801 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%.1f%%)</td>", $color_u, $wml_s{"english"}+$untranslated_s{'english'}-$wml_s{$lang}, $percent_us{$lang};
802 print HTMLI "</tr>\n";
803 }
804 }
805 print HTMLI "</tbody>";
806 print HTMLI "</table>\n";
807
808 print HTMLI '<h2><gettext domain="stats">Translated templates (PO files)</gettext></h2>'."\n";
809 printf HTMLI "<p><stats_strings %d></p>\n",$po_total{'total'};
810
811 print HTMLI '<table summary="<gettext domain="stats">PO Translation Statistics</gettext>"class="stattrans">'."\n";
812 print HTMLI "<colgroup span=\"1\"width=\"28%\">\n";
813 print HTMLI "</colgroup>";
814 print HTMLI "<colgroup span=\"6\" width=\"12%\">\n";
815 print HTMLI "<col width=\"12%\">\n";
816 print HTMLI "<col width=\"12%\">\n";
817 print HTMLI "<col width=\"12%\">\n";
818 print HTMLI "<col width=\"12%\">\n";
819 print HTMLI "<col width=\"12%\">\n";
820 print HTMLI "<col width=\"12%\">\n";
821 print HTMLI "</colgroup>";
822 print HTMLI "<thead>";
823 print HTMLI '<tr><th><gettext domain="stats">Language</gettext></th>'."\n";
824 print HTMLI '<th colspan="2"><gettext domain="stats">Up to date</gettext></th>'."\n";
825 print HTMLI '<th colspan="2"><gettext domain="stats">Fuzzy</gettext></th>'."\n";
826 print HTMLI '<th colspan="2"><gettext domain="stats">Not translated</gettext></th></tr>'."\n";
827 print HTMLI "</thead>";
828 print HTMLI "<tbody>";
829 foreach $lang (@search_in) {
830 next if $lang eq 'english';
831 my @processed_langs = ($langs{$lang});
832 @processed_langs = ("zh-cn", "zh-tw") if $langs{$lang} eq "zh";
833 foreach $l (@processed_langs) {
834 print HTMLI "<tr>";
835 printf HTMLI "<th><a href=\"%s#gettext\"><:=\$trans{\$CUR_ISO_LANG}{%s} :></a> (%s)</th>", $l, $lang, $l;
836 $color_t = get_color ($percent_po_t{'total'}{$lang});
837 $color_f = get_color (100 - $percent_po_f{'total'}{$lang});
838 $color_u = get_color (100 - $percent_po_u{'total'}{$lang});
839 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%d%%)</td>", $color_t, $po_translated{'total'}{$lang}, $percent_po_t{'total'}{$lang};
840 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%d%%)</td>", $color_f, $po_fuzzy{'total'}{$lang}, $percent_po_f{'total'}{$lang};
841 printf HTMLI "<td style=\"background-color: %s\">%d</td><td>(%d%%)</td>", $color_u, $po_untranslated{'total'}{$lang}, $percent_po_u{'total'}{$lang};
842 print HTMLI "</tr>\n";
843 }
844 }
845
846 print HTMLI "</tbody>";
847 print HTMLI "</table>\n";
848
849 print HTMLI
850 '<address><gettext domain="stats">Created with</gettext> <a href="'
851 . alioth_cvs_view_url('stattrans.pl')
852 . '">webwml-stattrans</a></address>' . "\n";
853 close (HTMLI);
854
855 print "done.\n" if ($config{'verbose'});
856
857 # Note:
858 # Translated pages on ll.html may be higher than in index.html.
859 # This is due to the fact that some english pages were removed.
860
861 # printf "%s\n", join ("\n", keys %version);
862 # printf "%s - %s\n", $version{'german/devel/index'}, $version{'english/devel/index'};

  ViewVC Help
Powered by ViewVC 1.1.5