Lines 1-124
Link Here
|
1 |
#!/usr/bin/perl |
|
|
2 |
|
3 |
# Copyright 2003-2004 Nathan Walp <faceprint@faceprint.com> |
4 |
# Adapted for Koha by Ambrose Li <acli@ada.dhs.org> |
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 Foundation, Inc., |
18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
19 |
# |
20 |
|
21 |
#use strict; |
22 |
#use warnings; FIXME - Bug 2505 |
23 |
|
24 |
my $PACKAGE="koha"; |
25 |
|
26 |
|
27 |
use Locale::Language; |
28 |
|
29 |
$lang{en_AU} = "English (Australian)"; |
30 |
$lang{en_CA} = "English (Canadian)"; |
31 |
$lang{en_GB} = "English (British)"; |
32 |
$lang{es_AR} = "Spanish (Argentinian)"; |
33 |
$lang{fr_FR} = "French"; # FIXME: should be just "fr" |
34 |
$lang{it_IT} = "Italian"; # FIXME: should be just "it" |
35 |
$lang{my_MM} = "Burmese (Myanmar)"; |
36 |
$lang{pl_PL} = "Polish"; # FIXME: should be just "pl" |
37 |
$lang{pt_BR} = "Portuguese (Brazilian)"; |
38 |
$lang{'sr@Latn'} = "Serbian (Latin)"; |
39 |
$lang{zh_CN} = "Chinese (Simplified)"; |
40 |
$lang{zh_TW} = "Chinese (Traditional)"; |
41 |
|
42 |
$ENV{LANG} = $ENV{LC_ALL} = 'C'; |
43 |
|
44 |
opendir(DIR, ".") || die "can't open directory: $!"; |
45 |
@pos = grep { /\.po$/ && -f } readdir(DIR); |
46 |
foreach (@pos) { s/\.po$//; }; |
47 |
closedir DIR; |
48 |
|
49 |
@pos = sort @pos; |
50 |
|
51 |
$now = `date`; |
52 |
|
53 |
system("./update.pl --pot > /dev/null"); |
54 |
|
55 |
print "<html>\n"; |
56 |
print "<head><title>$PACKAGE i18n statistics</title></head>\n"; |
57 |
print "<body>\n"; |
58 |
|
59 |
opendir(DIR, ".") || die "can't open directory: $!"; |
60 |
@templates = grep { /\.pot$/ && -f } readdir(DIR); |
61 |
foreach (@templates) { s/\.pot$//; }; |
62 |
closedir DIR; |
63 |
for my $PACKAGE (sort { |
64 |
my($theme1, $module1) = ($1, $2) if $a =~ /^(.*)_([^_]+)$/; |
65 |
my($theme2, $module2) = ($1, $2) if $b =~ /^(.*)_([^_]+)$/; |
66 |
return $module1 cmp $module2 || $theme1 cmp $theme2 |
67 |
} @templates) { |
68 |
my @pos_orig = @pos; |
69 |
my @pos = grep { /^${PACKAGE}_/ } @pos_orig; |
70 |
my($theme, $module) = ($1, $2) if $PACKAGE =~ /^(.*)_([^_]+)$/; |
71 |
|
72 |
$_ = `msgfmt --statistics $PACKAGE.pot -o /dev/null 2>&1`; |
73 |
|
74 |
die "unable to get total: $!" unless (/(\d+) untranslated messages/); |
75 |
|
76 |
$total = $1; |
77 |
|
78 |
print "<h1>Module $module, theme $theme</h1>\n"; |
79 |
print "<table cellspacing='0' cellpadding='0' border='0' bgcolor='#888888' width='100%'><tr><td><table cellspacing='1' cellpadding='2' border='0' width='100%'>\n"; |
80 |
|
81 |
print"<tr bgcolor='#e0e0e0'><th>language</th><th style='background: #339933;'>trans</th><th style='background: #339933;'>%</th><th style='background: #333399;'>fuzzy</th><th style='background: #333399;'>%</th><th style='background: #dd3333;'>untrans</th><th style='background: #dd3333;'>%</th><th> </th></tr>\n"; |
82 |
|
83 |
foreach $index (0 .. $#pos) { |
84 |
$trans = $fuzz = $untrans = 0; |
85 |
$po = $pos[$index]; |
86 |
next if $po =~ /_en_EN/; # Koha-specific |
87 |
print STDERR "$po..." if($ARGV[0] eq '-v'); |
88 |
system("msgmerge $po.po $PACKAGE.pot -o $po.new 2>/dev/null"); |
89 |
$_ = `msgfmt --statistics $po.new -o /dev/null 2>&1`; |
90 |
chomp; |
91 |
if(/(\d+) translated message/) { $trans = $1; } |
92 |
if(/(\d+) fuzzy translation/) { $fuzz = $1; } |
93 |
if(/(\d+) untranslated message/) { $untrans = $1; } |
94 |
$transp = 100 * $trans / $total; |
95 |
$fuzzp = 100 * $fuzz / $total; |
96 |
$untransp = 100 * $untrans / $total; |
97 |
if($index % 2) { |
98 |
$color = " bgcolor='#e0e0e0'"; |
99 |
} else { |
100 |
$color = " bgcolor='#d0e0ff'"; |
101 |
} |
102 |
my $lang = $1 if $po =~ /^${PACKAGE}_(.*)$/; # Koha-specific |
103 |
$name = ""; |
104 |
$name = $lang{$lang}; # NOTE |
105 |
$name = code2language($lang) unless $name ne ""; # NOTE |
106 |
$name = "???" unless $name ne ""; |
107 |
printf "<tr$color><td>%s(%s.po)</td><td>%d</td><td>%0.2f</td><td>%d</td><td>%0.2f</td><td>%d</td><td>%0.2f</td><td>", |
108 |
$name, $po, $trans, $transp, $fuzz, $fuzzp, $untrans, $untransp; |
109 |
printf "<img src='bar_g.gif' height='15' width='%0.0f' />", $transp*2 |
110 |
unless $transp*2 < 0.5; |
111 |
printf "<img src='bar_b.gif' height='15' width='%0.0f' />", $fuzzp*2 |
112 |
unless $fuzzp*2 < 0.5; |
113 |
printf "<img src='bar_r.gif' height='15' width='%0.0f' />", $untransp*2 |
114 |
unless $untransp*2 < 0.5; |
115 |
print "</tr>\n"; |
116 |
unlink("$po.new"); |
117 |
print STDERR "done ($untrans untranslated strings).\n" if($ARGV[0] eq '-v'); |
118 |
} |
119 |
print "</table></td></tr></table>\n"; |
120 |
print "Latest $PACKAGE.pot generated $now: <a href='$PACKAGE.pot'>$PACKAGE.pot</a><br />\n"; |
121 |
} |
122 |
print "</body>\n"; |
123 |
print "</html>\n"; |
124 |
|
125 |
- |