grim/guifications2

Remove the i18n support scripts
draft
2021-05-17, Gary Kramlich
20ceb5ca0ff7
Parents 388e9f347275
Children 2b38bf87e69a
Remove the i18n support scripts
4 files changed, 0 insertions(+), 638 deletions(-)
  • +0 -380
    po/check_po.pl
  • +0 -47
    po/siteupdate.sh
  • +0 -100
    po/stats.pl
  • +0 -111
    po/xmlstats.pl
    • --- a/po/check_po.pl Mon May 17 22:21:17 2021 -0500
    +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
    @@ -1,380 +0,0 @@
    -#!/usr/bin/perl -w
    -#
    -# check_po.pl - check po file translations for likely errors
    -#
    -# Written by David W. Pfitzner dwp@mso.anu.edu.au
    -# This script is hereby placed in the Public Domain.
    -#
    -# Various checks on po file translations:
    -# - printf-style format strings;
    -# - differences in trailing newlines;
    -# - empty (non-fuzzy) msgid;
    -# - likely whitespace errors on joining multi-line entries
    -# Ignores all fuzzy entries.
    -#
    -# Options:
    -# -x Don't do standard checks above (eg, just check one of below).
    -# -n Check newlines within strings; ie, that have equal numbers
    -# of newlines in msgstr and msgid. (Optional because this may
    -# happen legitimately.)
    -# -w Check leading whitespace. Sometimes whitespace is simply
    -# spacing (eg, for widget labels etc), or punctuation differences,
    -# so this may be ok.
    -# -W Check trailing whitespace. See -w above.
    -# -p Check trailing punctuation.
    -# -c Check capitalization of first non-whitespace character
    -# (only if [a-zA-Z]).
    -# -e Check on empty (c.q. new) msgstr
    -#
    -# Reads stdin (or filename args, via <>), writes any problems to stdout.
    -#
    -# Modified by Davide Pagnin nightmare@freeciv.it to support plural forms
    -#
    -# Version: 0.41 (2002-06-06)
    -
    -use strict;
    -use vars qw($opt_c $opt_n $opt_p $opt_w $opt_W $opt_x $opt_e);
    -use Getopt::Std;
    -
    -getopts('cnpwWxe');
    -
    -# Globals, for current po entry:
    -#
    -# Note that msgid and msgstr have newlines represented by the
    -# two characters '\' and 'n' (and similarly for other escapes).
    -
    -my @amsgid; # lines exactly as in input
    -my @amsgstr;
    -my $entryline; # lineno where entry starts
    -my $msgid; # lines joined by ""
    -my $msgstr;
    -my $is_fuzzy;
    -my $is_cformat;
    -my $state; # From constant values below.
    -my $did_print; # Whether we have printed this entry, to
    - # print only once for multiple problems.
    -
    -use constant S_LOOKING_START => 0; # looking for start of entry
    -use constant S_DOING_MSGID => 1; # doing msgid part
    -use constant S_DOING_MSGSTR => 2; # doing msgstr part
    -
    -# Initialize or reinitalize globals to prepare for new entry:
    -sub new_entry {
    - @amsgid = ();
    - @amsgstr = ();
    - $msgid = undef;
    - $msgstr = undef;
    - $entryline = 0;
    - $is_fuzzy = 0;
    - $is_cformat = 0;
    - $did_print = 0;
    - $state = S_LOOKING_START;
    -}
    -
    -# Nicely print either a "msgid" or "msgstr" (name is one of these)
    -# with given array of data.
    -sub print_one {
    - my $name = shift;
    - print " $name \"", join("\"\n \"", @_), "\"\n";
    -}
    -
    -# Print a problem (args like print()), preceeded by entry unless
    -# we have already printed that: label, and msgid and msgstr.
    -#
    -sub print_problem {
    - unless ($did_print) {
    - print "ENTRY:", ($ARGV eq "-" ? "" : " ($ARGV, line $entryline)"), "\n";
    - print_one("msgid", @amsgid);
    - print_one("msgstr", @amsgstr);
    - $did_print = 1;
    - }
    - print "*** ", @_;
    -}
    -
    -# Check final newline: probably, translations should end in a newline
    -# if and only if the original string does.
    -# (See also check_trailing_whitespace and check_num_newlines below.)
    -#
    -sub check_trailing_newlines {
    - if ($opt_x) { return; }
    -
    - my ($ichar, $schar);
    -
    - $ichar = (length($msgid)>=2) ? substr($msgid, -2, 2) : "";
    - $schar = (length($msgstr)>=2) ? substr($msgstr, -2, 2) : "";
    -
    - if ($ichar eq "\\n" && $schar ne "\\n") {
    - print_problem "Missing trailing newline\n";
    - }
    - if ($ichar ne "\\n" && $schar eq "\\n") {
    - print_problem "Extra trailing newline\n";
    - }
    -
    -}
    -
    -# Check leading whitespace. In general, any leading whitespace should
    -# be the same in msgstr and msgid -- but not always.
    -#
    -sub check_leading_whitespace {
    - unless ($opt_w) { return; }
    -
    - my ($id, $str);
    -
    - if ($msgid =~ m/^(\s+)/) {
    - $id = $1;
    - } else {
    - $id = "";
    - }
    - if ($msgstr =~ m/^(\s+)/) {
    - $str = $1;
    - } else {
    - $str = "";
    - }
    - if ($id ne $str) {
    - print_problem "Different leading whitespace\n";
    - }
    -}
    -
    -# Check trailing whitespace. In general, any trailing whitespace should
    -# be the same in msgstr and msgid -- but not always.
    -#
    -sub check_trailing_whitespace {
    - unless ($opt_W) { return; }
    -
    - my ($id, $str);
    -
    - if ($msgid =~ m/((?:\s|\\n)+)$/) {
    - $id = $1;
    - } else {
    - $id = "";
    - }
    - if ($msgstr =~ m/((?:\s|\\n)+)$/) {
    - $str = $1;
    - } else {
    - $str = "";
    - }
    - if ($id ne $str) {
    - print_problem "Different trailing whitespace\n";
    - }
    -}
    -
    -# Check equal numbers of newlines. In general ... etc.
    -#
    -sub check_num_newlines {
    - unless ($opt_n) { return; }
    -
    - my $num_i = ($msgid =~ m(\\n)g);
    - my $num_s = ($msgstr =~ m(\\n)g);
    -
    - if ($num_i != $num_s) {
    - print_problem "Mismatch in newline count\n";
    - }
    -
    -}
    -
    -# Check capitalization of first non-whitespace character (for [a-zA-Z]
    -# only). In general ... etc.
    -#
    -sub check_leading_capitalization {
    - unless ($opt_c) { return; }
    -
    - my ($id, $str);
    -
    - if ($msgid =~ m/^\s*([a-zA-Z])/) {
    - $id = $1;
    - }
    - if ($msgstr =~ m/^\s*([a-zA-Z])/) {
    - $str = $1;
    - }
    - if (defined($id) && defined($str)) {
    - if (($id =~ /^[a-z]$/ && $str =~ /^[A-Z]$/) ||
    - ($id =~ /^[A-Z]$/ && $str =~ /^[a-z]$/)) {
    - print_problem "Different leading capitalization\n";
    - }
    - }
    -}
    -
    -# Check trailing 'punctuation' characters (ignoring trailing whitespace).
    -# In general .. etc.
    -#
    -sub check_trailing_punctuation {
    - unless ($opt_p) { return; }
    -
    - my ($id, $str);
    -
    - # Might want more characters:
    - if ($msgid =~ m/([\\\.\/\,\!\?\"\'\:\;])+(?:\s|\\n)*$/) {
    - $id = $1;
    - } else {
    - $id = "";
    - }
    - if ($msgstr =~ m/([\\\.\/\,\!\?\"\'\:\;])+(?:\s|\\n)*$/) {
    - $str = $1;
    - } else {
    - $str = "";
    - }
    - ##print "$id $str\n";
    - if ($id ne $str) {
    - print_problem "Different trailing punctuation\n";
    - }
    -}
    -
    -# Check that multiline strings have whitespace separation, since
    -# otherwise, eg:
    -# msgstr "this is a multiline"
    -# "string"
    -# expands to:
    -# "this is a multilinestring"
    -#
    -sub check_whitespace_joins {
    - if ($opt_x) { return; }
    -
    - my $ok = 1;
    - my $i = 0;
    -
    - foreach my $aref (\@amsgid, \@amsgstr) {
    - my $prev = undef;
    - LINE:
    - foreach my $line (@$aref) {
    - if (defined($prev)
    - && length($prev)
    - && $prev !~ /\s$/
    - && $prev !~ /\\n$/
    - && $line !~ /^\s/
    - && $line !~ /^\\n/)
    - {
    - $ok = 0;
    - last LINE;
    - }
    - $prev = $line;
    - }
    - if (!$ok) {
    - print_problem("Possible non-whitespace line-join problem in ",
    - ($i==0 ? "msgid" : "msgstr"), " \n");
    - }
    - $i++;
    - }
    -}
    -
    -# Check printf-style format entries.
    -# Non-trivial, because translation strings may use format specifiers
    -# out of order, or skip some specifiers etc. Also gettext marks
    -# anything with '%' as cformat, though not all are.
    -#
    -sub check_cformat {
    - unless ($is_cformat) { return; }
    - if ($opt_x) { return; }
    -
    - my (@iform, @sform);
    - @iform = ($msgid =~ m/\%[0-9\.\$]*[a-z]/g);
    - @sform = ($msgstr =~ m/\%[0-9\.\$]*[a-z]/g);
    -
    - ##print join("::", @iform), "\n";
    - ##print join("::", @sform), "\n";
    -
    - my $js; # index in sform
    - my $j; # index into iform
    - SFORM:
    - for ($js=0; $js < @sform; $js++) {
    - my $sf = $sform[$js];
    - my $sf_orig = $sf;
    - if ($sf =~ s/^\%([0-9]+)\$(.*[a-z])$/\%$2/) {
    - $j = $1-1;
    - } else {
    - $j = $js;
    - }
    - if ($j > $#iform) {
    - print_problem("Format number mismatch for $sf_orig [msgstr:",
    - ($js+1), "]\n");
    - next SFORM;
    - }
    - my $if = $iform[$j];
    - if ($sf ne $if) {
    - print_problem("Format mismatch: $sf_orig [msgstr:", ($js+1), "]",
    - " vs $if [msgid:", ($j+1), "]\n");
    - }
    - }
    -}
    -
    -# Run all individual checks on current entry, reporting any problems.
    -sub check_entry {
    - if ($is_fuzzy) {
    - return;
    - }
    - $msgid = join("", @amsgid);
    - $msgstr = join("", @amsgstr);
    -
    - unless ($opt_x) {
    - if (length($msgid)==0) {
    - print_problem "Zero length msgid\n";
    - }
    - }
    - if (length($msgstr)==0) {
    - unless ($opt_e) { return; }
    - print_problem "Untranslated msgid\n";
    - }
    - check_cformat;
    - check_whitespace_joins;
    - check_num_newlines;
    - check_leading_whitespace;
    - check_trailing_newlines;
    - check_trailing_whitespace;
    - check_leading_capitalization;
    - check_trailing_punctuation;
    -}
    -
    -new_entry;
    -
    -LINE:
    -while(<>) {
    - if ( m(^\s*$) ) {
    - if ($state==S_DOING_MSGSTR) {
    - check_entry;
    - new_entry;
    - }
    - next LINE;
    - }
    - if ( m(^\#, fuzzy) ) {
    - $is_fuzzy = 1;
    - }
    - if ( m(^\#, .*c-format) ) {
    - # .* is because can have fuzzy, c-format
    - $is_cformat = 1;
    - }
    - if ( m(^\#) ) {
    - next LINE;
    - }
    - if ( m(^msgid \"(.*)\"$) ) {
    - $entryline = $.;
    - @amsgid = ($1);
    - $state = S_DOING_MSGID;
    - next LINE;
    - }
    - if ( m(^msgid_plural \"(.*)\"$) ) {
    - $entryline = $.;
    - @amsgid = ($1);
    - $state = S_DOING_MSGID;
    - next LINE;
    - }
    - if ( m(^msgstr \"(.*)\"$) ) {
    - @amsgstr = ($1);
    - $state = S_DOING_MSGSTR;
    - next LINE;
    - }
    - if ( m(^msgstr\[[0-2]\] \"(.*)\"$) ) {
    - @amsgstr = ($1);
    - $state = S_DOING_MSGSTR;
    - next LINE;
    - }
    - if ( m(^\"(.*)\"$) ) {
    - if ($state==S_DOING_MSGID) {
    - push @amsgid, $1;
    - } elsif($state==S_DOING_MSGSTR) {
    - push @amsgstr, $1;
    - } else {
    - die "Looking at string $_ in bad state $state,";
    - }
    - next LINE;
    - }
    - die "Unexpected at $.: ", $_;
    -}
    --- a/po/siteupdate.sh Mon May 17 22:21:17 2021 -0500
    +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
    @@ -1,47 +0,0 @@
    -#!/bin/sh
    -
    -# guifications i18n stats update utility.
    -# (C) 2004 The Guifications Team
    -#
    -# Author(s):
    -# Gary Kramlich
    -# Stu Tomlinson
    -
    -# This script assumes one of two things. One being that your sourceforge name
    -# is the same username as your shell username, or that you have added a host
    -# block to your ~/.ssh/config containing your username for sourceforge. Please
    -# make sure you meet these requirements before saying it doesn't work.
    -
    -# This is the dir we're copying index.html, *.po and *.pot to, make sure that
    -# these files (or the directory they're in) are group writable.
    -SF_DIR="/home/groups/g/gu/guifications/htdocs/Guifications/i18n/"
    -
    -# Set this to the desired file name for the output to be saved to
    -OUT_FILE="stats.xml"
    -
    -# Set this to your project timezone if you want to be consistent
    -TZ="CST6CDT"
    -export TZ
    -
    -# Make sure we've got any updates first, otherwise things might be wrong
    -cvs -q update -dP
    -
    -# Save the existing .po's to reduce conflicts
    -rm -rf .posave
    -mkdir -p .posave
    -cp -a *.po .posave/
    -
    -# Lets do this now...
    -
    -./update.pl --pot
    -for pofile in *.po ; do
    - ./update.pl ${pofile%.po}
    -done
    -./xmlstats.pl > $OUT_FILE
    -
    -tar zcf - $OUT_FILE *.po *.pot | ssh shell.sf.net "cd $SF_DIR ; tar zxvf - ; chmod 664 *.po *.pot $OUT_FILE"
    -rm $OUT_FILE
    -
    -# Restore saved .po's
    -mv -f .posave/* .
    -rm -rf .posave
    --- a/po/stats.pl Mon May 17 22:21:17 2021 -0500
    +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
    @@ -1,100 +0,0 @@
    -#!/usr/bin/perl
    -
    -# Copyright 2003 Nathan Walp <faceprint@faceprint.com>
    -#
    -# Parts Copyright 2004 Gary Kramlich <grim@reaperworld.com>
    -# Parts Copyright 2004 Stu Tomlinson <stu@nosnilmot.com>
    -#
    -# This program is free software; you can redistribute it and/or modify
    -# it under the terms of the GNU General Public License as published by
    -# the Free Software Foundation; either version 2 of the License, or
    -# (at your option) any later version.
    -#
    -# This program is distributed in the hope that it will be useful,
    -# but WITHOUT ANY WARRANTY; without even the implied warranty of
    -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    -# GNU General Public License for more details.
    -#
    -# You should have received a copy of the GNU General Public License
    -# along with this program; if not, write to the Free Software
    -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA
    -#
    -
    -use Locale::Language;
    -
    -$PACKAGE = "guifications";
    -
    -$lang{en_CA} = "English (Canadian)";
    -$lang{en_GB} = "English (British)";
    -$lang{en_AU} = "English (Australian)";
    -$lang{pt_BR} = "Portuguese (Brazilian)";
    -$lang{'sr@Latn'} = "Serbian (Latin)";
    -$lang{sv_SE} = "Swedish (Sweden)";
    -$lang{zh_CN} = "Chinese (Simplified)";
    -$lang{zh_TW} = "Chinese (Traditional)";
    -
    -opendir(DIR, ".") || die "can't open directory: $!";
    -@pos = grep { /\.po$/ && -f } readdir(DIR);
    -foreach (@pos) { s/\.po$//; };
    -closedir DIR;
    -
    -@pos = sort @pos;
    -
    -$now = `date`;
    -
    -system("../intltool-update --pot > /dev/null");
    -
    -$_ = `msgfmt --statistics $PACKAGE.pot -o /dev/null 2>&1`;
    -
    -die "unable to get total: $!" unless (/(\d+) untranslated messages/);
    -
    -$total = $1;
    -
    -print "<html>\n";
    -print "<head><title>Guifications i18n statistics</title></head>\n";
    -print "<body>\n";
    -print "<table cellspacing='0' cellpadding='0' border='0' bgcolor='#888888' width='100%' class='i18n'><tr><td><table cellspacing='1' cellpadding='2' border='0' width='100%'>\n";
    -
    -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>&nbsp;</th></tr>\n";
    -
    -foreach $index (0 .. $#pos) {
    - $trans = $fuzz = $untrans = 0;
    - $po = $pos[$index];
    - print STDERR "$po..." if($ARGV[0] eq '-v');
    - system("msgmerge $po.po $PACKAGE.pot -o $po.new 2>/dev/null");
    - $_ = `msgfmt --statistics $po.new -o /dev/null 2>&1`;
    - chomp;
    - if(/(\d+) translated message/) { $trans = $1; }
    - if(/(\d+) fuzzy translation/) { $fuzz = $1; }
    - if(/(\d+) untranslated message/) { $untrans = $1; }
    - $transp = 100 * $trans / $total;
    - $fuzzp = 100 * $fuzz / $total;
    - $untransp = 100 * $untrans / $total;
    - if($index % 2) {
    - $class = " class='even'";
    - $color = " bgcolor='#e0e0e0'";
    - } else {
    - $class = " class='odd'";
    - $color = " bgcolor='#d0e0ff'";
    - }
    - $name = "";
    - $name = $lang{$po};
    - $name = code2language($po) unless $name ne "";
    - $name = "???" unless $name ne "";
    - printf "<tr$color><td$class>%s (<a href=\"%s.po\">%s.po</a>)</td><td$class>%d</td><td$class>%0.2f</td><td$class>%d</td><td$class>%0.2f</td><td$class>%d</td><td$class>%0.2f</td><td$class>",
    - $name, $po, $po, $trans, $transp, $fuzz, $fuzzp, $untrans, $untransp;
    - printf "<img src='bar_g.gif' height='15' width='%0.0f' alt='green'/>", $transp*2
    - unless $transp*2 < 0.5;
    - printf "<img src='bar_b.gif' height='15' width='%0.0f' alt='blue'/>", $fuzzp*2
    - unless $fuzzp*2 < 0.5;
    - printf "<img src='bar_r.gif' height='15' width='%0.0f' alt='red'/>", $untransp*2
    - unless $untransp*2 < 0.5;
    - print "</tr>\n";
    - unlink("$po.new");
    - print STDERR "done ($untrans untranslated strings).\n" if($ARGV[0] eq '-v');
    -}
    -print "</table></td></tr></table>\n";
    -print "Latest $PACKAGE.pot generated $now: <a href='$PACKAGE.pot'>$PACKAGE.pot</a><br />\n";
    -print "</body>\n";
    -print "</html>\n";
    -
    --- a/po/xmlstats.pl Mon May 17 22:21:17 2021 -0500
    +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
    @@ -1,111 +0,0 @@
    -#!/usr/bin/perl
    -
    -# xmlstats.pl - Generates translation stats in xml
    -# Copyright 2005 Gary Kramlich <grim@reaperworld.com>
    -#
    -# Based on stats.pl from Guifications cvs
    -#
    -# Copyright 2003 Nathan Walp <faceprint@faceprint.com>
    -#
    -# Parts Copyright 2004 Gary Kramlich <grim@reaperworld.com>
    -# Parts Copyright 2004 Stu Tomlinson <stu@nosnilmot.com>
    -#
    -# This program is free software; you can redistribute it and/or modify
    -# it under the terms of the GNU General Public License as published by
    -# the Free Software Foundation; either version 2 of the License, or
    -# (at your option) any later version.
    -#
    -# This program is distributed in the hope that it will be useful,
    -# but WITHOUT ANY WARRANTY; without even the implied warranty of
    -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    -# GNU General Public License for more details.
    -#
    -# You should have received a copy of the GNU General Public License
    -# along with this program; if not, write to the Free Software
    -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA
    -#
    -
    -use Locale::Language;
    -
    -$PACKAGE = "guifications";
    -
    -$start = time;
    -
    -$lang{en_CA} = "English (Canadian)";
    -$lang{en_GB} = "English (British)";
    -$lang{en_AU} = "English (Australian)";
    -$lang{pt_BR} = "Portuguese (Brazilian)";
    -$lang{'sr@Latn'} = "Serbian (Latin)";
    -$lang{sv_SE} = "Swedish (Sweden)";
    -$lang{zh_CN} = "Chinese (Simplified)";
    -$lang{zh_TW} = "Chinese (Traditional)";
    -
    -opendir(DIR, ".") || die "can't open directory: $!";
    -@pos = grep { /\.po$/ && -f } readdir(DIR);
    -foreach (@pos) { s/\.po$//; };
    -closedir DIR;
    -
    -@pos = sort @pos;
    -
    -$now = `date`;
    -
    -system("../intltool-update --pot > /dev/null");
    -
    -$_ = `msgfmt --statistics $PACKAGE.pot -o /dev/null 2>&1`;
    -
    -die "unable to get total: $!" unless (/(\d+) untranslated messages/);
    -
    -$total = $1;
    -
    -print "<?xml version=\"1.0\"?>\n";
    -print "<l10n:package name='$PACKAGE' pot='$PACKAGE.pot' strings='$total'>\n";
    -
    -foreach $index (0 .. $#pos) {
    - $trans = $fuzz = $untrans = 0;
    - $po = $pos[$index];
    - print STDERR "$po..." if($ARGV[0] eq '-v');
    - system("msgmerge $po.po $PACKAGE.pot -o $po.new 2>/dev/null");
    - $_ = `msgfmt --statistics $po.new -o /dev/null 2>&1`;
    - chomp;
    - if(/(\d+) translated message/) { $trans = $1; }
    - if(/(\d+) fuzzy translation/) { $fuzz = $1; }
    - if(/(\d+) untranslated message/) { $untrans = $1; }
    -
    - $name = "";
    - $name = $lang{$po};
    - $name = code2language($po) unless $name ne "";
    - $name = "???" unless $name ne "";
    -
    - print "\t<l10n:lang name='$name' code='$po'";
    -
    - if($trans > 0) {
    - printf " translated='%d'", $trans;
    - }
    -
    - if($fuzz > 0) {
    - printf " fuzzy='%d'", $fuzz;
    - }
    -
    - if($untrans > 0) {
    - printf " untranslated='%d'", $untrans;
    - }
    -
    - print "/>\n";
    -
    - unlink("$po.new");
    - print STDERR "done ($untrans untranslated strings).\n" if($ARGV[0] eq '-v');
    -}
    -
    -# Get the GMT offset.
    -# We multiple by negative one to represent the offset correctly.
    -# For example: GMT-5;
    -# at 5pm in GMT-5 it's 10pm in GMT
    -# so 10 - 5 becomes positive 5 which could be interpreted as GMT+5
    -($ls, $lm, $lh) = localtime();
    -($gs, $gm, $gh) = gmtime();
    -$gmtoff = ($gh - $lh) * -1;
    -
    -$now = time;
    -$elapsed = $now - $start;
    -print "\t<l10n:generated at='$now' in='$elapsed' gmt='$gmtoff'/>\n";
    -print "</l10n:package>\n";