|
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 |
- |