tools/claws.i18n.status.pl

   1 #!/usr/bin/perl
   2 #
   3 # claws.i18n.stats.pl - Generate statistics for Claws Mail po directory.
   4 #
   5 # Copyright (C) 2003-2020 by Ricardo Mones <ricardo@mones.org>,
   6 #                            Paul Mangan <paul@claws-mail.org>
   7 # This program is released under the GNU General Public License.
   8 #
   9 use warnings;
  10 use strict;
  11 use File::Which;
  12
  13 # constants -----------------------------------------------------------------
  14 my %lang = (
  15         'bg.po' => {
  16                 'out' => 0, 'name' => 'Bulgarian',
  17                 'last' => 'Yasen Pramatarov <yasen@lindeas.com>',
  18         },
  19         'ca.po' => {
  20                 'out' => 1, 'name' => 'Catalan',
  21                 'last' => 'David Medina <opensusecatala@gmail.com>',
  22         },
  23         'cs.po' => {
  24                 'out' => 1, 'name' => 'Czech',
  25                 'last' => 'David Vachulka <david@konstrukce-cad.com>',
  26         },
  27         'da.po' => {
  28                 'out' => 1, 'name' => 'Danish',
  29                 'last' => 'Erik P. Olsen <epodata@gmail.com>',
  30         },
  31         'de.po' => {
  32                 'out' => 1, 'name' => 'German',
  33                 'last' => 'Simon Legner <simon.legner@gmail.com>',
  34         },
  35         'el_GR.po' => {
  36                 'out' => 1, 'name' => 'Greek',
  37                 'last' => 'Haris Karachristianidis <hariskar@cryptolab.net>',
  38         },
  39         'en_GB.po' => {
  40                 'out' => 1, 'name' => 'British English', 'lazy' => 1,
  41                 'last' => 'Paul Mangan <paul@claws-mail.org>',
  42         },
  43         'eo.po' => {
  44                 'out' => 0, 'name' => 'Esperanto',
  45                 'last' => 'Sian Mountbatten <poenikatu@fastmail.co.uk>',
  46         },
  47         'es.po' => {
  48                 'out' => 1, 'name' => 'Spanish',
  49                 'last' => 'Ricardo Mones <ricardo@mones.org>',
  50         },
  51         'fi.po' => {
  52                 'out' => 1, 'name' => 'Finnish',
  53                 'last' => 'Flammie Pirinen <flammie@iki.fi>',
  54         },
  55         'fr.po' => {
  56                 'out' => 1, 'name' => 'French',
  57                 'last' => 'Tristan Chabredier <wwp@claws-mail.org>',
  58         },
  59         'he.po' => {
  60                 'out' => 0, 'name' => 'Hebrew',
  61                 'last' => 'Isratine Citizen <genghiskhan@gmx.ca>',
  62         },
  63         'hu.po' => {
  64                 'out' => 1, 'name' => 'Hungarian',
  65                 'last' => 'P&aacute;der Rezs&#337; <rezso@rezso.net>',
  66         },
  67         'id_ID.po' => {
  68                 'out' => 1, 'name' => 'Indonesian',
  69                 'last' => 'MSulchan Darmawan <bleketux@gmail.com>',
  70         },
  71         'it.po' => {
  72                 'out' => 1, 'name' => 'Italian',
  73                 'last' => 'Luigi Votta <luigi.vtt@gmail.com>',
  74         },
  75         'ja.po' => {
  76                 'out' => 1, 'name' => 'Japanese',
  77                 'last' => 'UTUMI Hirosi <utuhiro78@yahoo.co.jp>',
  78         },
  79         'lt.po' => {
  80                 'out' => 0, 'name' => 'Lithuanian',
  81                 'last' => 'Mindaugas Baranauskas <embar@super.lt>',
  82         },
  83         'nb.po' => {
  84                 'out' => 1, 'name' => 'Norwegian Bokm&aring;l',
  85                 'last' => 'Petter Adsen <petter@synth.no>',
  86         },
  87         'nl.po' => {
  88                 'out' => 1, 'name' => 'Dutch',
  89                 'last' => 'Marcel Pol <mpol@gmx.net>',
  90         },
  91         'pl.po' => {
  92                 'out' => 1, 'name' => 'Polish',
  93                 'last' => 'Jakub Jankiewicz <jcubic@jcubic.pl>',
  94         },
  95         'pt_BR.po' => {
  96                 'out' => 1, 'name' => 'Brazilian Portuguese',
  97                 'last' => 'Frederico Goncalves Guimaraes <fggdebian@yahoo.com.br>',
  98         },
  99         'pt_PT.po' => {
 100                 'out' => 1, 'name' => 'Portuguese',
 101                 'last' => 'Pedro Albuquerque <palbuquerque73@gmail.com>',
 102         },
 103         'ro.po' => {
 104                 'out' => 1, 'name' => 'Romanian',
 105                 'last' => 'Cristian Secar&#259; <liste@secarica.ro>',
 106         },
 107         'ru.po' => {
 108                 'out' => 1, 'name' => 'Russian',
 109                 'last' => 'Mikhail Kurinnoi <viewizard@viewizard.com>',
 110         },
 111         'sk.po' => {
 112                 'out' => 1, 'name' => 'Slovak',
 113                 'last' => 'Slavko <slavino@slavino.sk>',
 114         },
 115         'sv.po' => {
 116                 'out' => 1, 'name' => 'Swedish',
 117                 'last' => 'Andreas Rönnquist <gusnan@openmailbox.org>',
 118         },
 119         'tr.po' => {
 120                 'out' => 1, 'name' => 'Turkish',
 121                 'last' => 'Numan Demirdöğen <if.gnu.linux@gmail.com>',
 122         },
 123         'uk.po' => {
 124                 'out' => 0, 'name' => 'Ukrainian',
 125                 'last' => 'YUP <yupadmin@gmail.com>',
 126         },
 127         'zh_CN.po' => {
 128                 'out' => 0, 'name' => 'Simplified Chinese',
 129                 'last' => 'Rob <rbnwmk@gmail.com>',
 130         },
 131         'zh_TW.po' => {
 132                 'out' => 1, 'name' => 'Traditional Chinese',
 133                 'last' => 'Mark Chang <mark.cyj@gmail.com>',
 134         },
 135 );
 136
 137 my %barcolornorm = (
 138         default => 'white',
 139         partially => 'lightblue',
 140         completed => 'blue',
 141 );
 142
 143 my %barcoloraged = (
 144         default => 'white',
 145         partially => 'lightgrey',       # ligth red '#FFA0A0',
 146         completed => 'grey',            # darker red '#FF7070',
 147 );
 148
 149 my %barcolorcheat = (   # remarks translations with revision dates in the future
 150         default => 'white',
 151         partially => 'yellow',
 152         completed => 'red',
 153 );
 154
 155 my ($barwidth, $barheight) = (500, 12); # pixels
 156
 157 my $transolddays = 120; # days to consider a translation is old, so probably unmaintained.
 158 my $transoldmonths = $transolddays / 30;
 159 my $transneedthresold = 0.75; # percent/100
 160
 161 my ($msgfmt, $date, $grep, $cut) = map {
 162   my $bin = which($_); die "missing '$_' binary" unless defined $bin; $bin
 163 } qw(msgfmt date grep cut);
 164
 165 my $averageitem = {'name' => 'Project average', 'out' => 1, 'last' => ''};
 166 my $contactaddress = 'translations@thewildbeast.co.uk';
 167
 168 # code begins here ----------------------------------------------------------
 169 sub get_current_date {
 170         my $utc = qx{$date --utc};
 171         chop $utc;
 172         $utc =~ /(\S+)(\s+)(\S+)(\s+)(\S+)(\s+)(\S+)(\D+)(\d+)/;
 173         return "$5-$3-$9 at $7"."$8";
 174 }
 175
 176 sub get_trans_age {
 177         my ($y, $m, $d) = @_;
 178         return ($y * 365) + ($m * 31) + $d;
 179 }
 180
 181 my (undef, undef, undef, $mday, $mon, $year, undef, undef) = gmtime(time);
 182 $year += 1900;
 183 $mon++;
 184 my $cage = get_trans_age($year, $mon, $mday); # get current "age"
 185
 186 # drawing a language status row
 187 sub print_lang {
 188         my ($langmap, $trans, $fuzzy, $untrans, $tage, $oddeven) = @_;
 189         return if not $langmap->{'out'};
 190         my $lang = $langmap->{'name'};
 191         my $person = $langmap->{'last'};
 192         my $total = $trans + $fuzzy + $untrans;
 193         if ($tage == 0) { $tage = $cage; } # hack for average translation
 194         # print STDERR $cage, " ",  $tage, "\n";
 195         my ($barcolor, $pname, $pemail);
 196         if (($cage - $tage) < 0) {
 197                 $barcolor = \%barcolorcheat;
 198         } else {
 199                 $barcolor = (($cage - $tage) > $transolddays)? \%barcoloraged : \%barcolornorm ;
 200         }
 201         $_ = $person;
 202         if (/(.+)\s+\<(.+)\>/) {
 203                 $pname = $1; $pemail = $2;
 204         } else {
 205                 $pname = $pemail = $contactaddress;
 206         }
 207         print '<tr', ($oddeven? ' bgcolor=#EFEFEF': ''), ">\n<td>\n";
 208         if ($lang eq $averageitem->{'name'}) {
 209                 print "<b>$lang</b>";
 210         } else {
 211                 print "<a href=\"mailto:%22$pname%22%20<$pemail>\">$lang</a>";
 212         }
 213         print "</td>\n";
 214         print "<td>\n<table style='border: solid 1px black; width: $barwidth'",
 215                 " border='0' cellspacing='0' cellpadding='0'><tr>\n";
 216         my $barlen = ($trans / $total) * $barwidth;
 217         print "<td style='width:$barlen", "px; height:$barheight",
 218                 "px;' bgcolor=\"$$barcolor{completed}\"></td>\n";
 219         my $barlen2 = ($fuzzy / $total) * $barwidth;
 220         print "<td style='width:$barlen2", "px' bgcolor=\"$$barcolor{partially}\"></td>\n";
 221         my $barlen3 = $barwidth - $barlen2 - $barlen;
 222         print "<td style='width:$barlen3", "px' bgcolor=\"$$barcolor{default}\"></td>\n";
 223         print "</tr>\n</table>\n</td>\n\n<td style='text-align: right'>",
 224                 int(($trans / $total) * 10000) / 100,  "%</td>\n";
 225         my $transtatus = (($trans / $total) < $transneedthresold)
 226                 ? '<font size="+1" color="red"> * </font>': '';
 227         print "<td>$transtatus</td>\n</tr>\n";
 228 }
 229
 230 sub tens {
 231         my ($i) = @_;
 232         return (($i > 9)? "$i" : "0$i");
 233 }
 234
 235 my $datetimenow = get_current_date();
 236
 237 # get project version from changelog (project dependent code :-/ )
 238 my $genversion = 'Unknown';
 239 my $changelog = '../Changelog';
 240 if (-s $changelog) {
 241         my $head = which('head');
 242         if (defined $head) {
 243                 $_ = qx{$head -1 $changelog};
 244                 if (/\S+\s+\S+\s+(\S+)/) { $genversion = $1; }
 245         }
 246 } else {
 247         my $git = which('git');
 248         if (defined $git) {
 249                 $_ = qx{$git describe --abbrev=0};
 250                 if (/(\d+\.\d+\.\d)/) { $genversion = $1; }
 251         }
 252 }
 253
 254 # start
 255 print qq ~<div class=indent>
 256           <b>Translation Status (on $datetimenow for $genversion)</b>
 257           <div class=indent>
 258                 <table cellspacing=0 cellpadding=2>~;
 259
 260 # table header
 261 print qq ~<tr bgcolor=#cccccc>
 262           <th align=left>Language</th>
 263           <th>Translated|Fuzzy|Untranslated</th>
 264           <th>Percent</th>
 265           <th></th>
 266           </tr>~;
 267
 268 # get files
 269 my @pofiles;
 270 opendir(PODIR, ".") || die("Error: can't open current directory\n");
 271 push(@pofiles,(readdir(PODIR)));
 272 closedir(PODIR);
 273
 274 my @sorted_pofiles = sort(@pofiles);
 275 # iterate them
 276 my ($alang, $atran, $afuzz, $auntr, $oddeven) = (0, 0, 0, 0, 0);
 277 foreach my $pofile (@sorted_pofiles) {
 278         $_ = $pofile;
 279         if (/.+\.po$/ && defined($lang{$pofile}) ) {
 280                 print STDERR "Processing $_\n"; # be a little informative
 281                 ++$alang;
 282                 my ($transage, $tran, $fuzz, $untr) = (0, 0, 0, 0);
 283                 $_ = qx{$msgfmt -c --statistics -o /dev/null $pofile 2>&1};
 284                 if (/([0-9]+)\s+translated/) {
 285                         $tran = $1;
 286                 }
 287                 if (/([0-9]+)\s+fuzzy/) {
 288                         $fuzz = $1;
 289                 }
 290                 if (/([0-9]+)\s+untranslated/) {
 291                         $untr = $1;
 292                 }
 293                 # print STDERR "Translated [$tran] Fuzzy [$fuzz] Untranslated [$untr]\n";
 294                 $atran += $tran;
 295                 $afuzz += $fuzz;
 296                 $auntr += $untr;
 297                 if ($lang{$pofile}->{'lazy'}) {
 298                         $tran = $tran + $fuzz;
 299                         $untr = "0";
 300                         $fuzz = "0";
 301                         $transage = $cage;
 302                 } else {
 303                         $_ = qx{$grep 'PO-Revision-Date:' $pofile | $cut -f2 -d:};
 304                         if (/\s+(\d+)\-(\d+)\-(\d+)/) {
 305                                 $transage = get_trans_age($1, $2, $3);
 306                         }
 307                 }
 308                 print_lang($lang{$pofile}, $tran, $fuzz, $untr, $transage, $oddeven);
 309                 $oddeven = $oddeven? 0: 1;
 310         }
 311 }
 312
 313 # average results for the project
 314 print "<tr>\n<td colspan=3 height=8></td>\n<tr>";
 315 print_lang($averageitem, $atran, $afuzz, $auntr, 0, 0);
 316
 317 # table footer
 318 print "</table>\n";
 319 print qq ~</div>
 320           </div>~;
 321
 322 # done