po/pocheck.pl

   1 #! /usr/bin/perl -w
   2 # -*- mode: perl; -*-
   3
   4 # file pocheck.pl
   5 #
   6 # This file is part of LyX, the document processor.
   7 # Licence details can be found in the file COPYING.
   8 #
   9 # author: Michael Gerz, michael.gerz@teststep.org
  10 #
  11
  12 use strict;
  13 use warnings;
  14 use Getopt::Std;
  15 use Encode qw(encode decode);
  16
  17 sub mylc($);
  18 sub replaceSynopsis($);
  19
  20 my $usage = <<EOT;
  21 pocheck.pl [-acmpqst] po_file [po_file] ...
  22
  23 This script performs some consistency checks on po files.
  24
  25 We check for everything listed here, unless one or more of these
  26 options is given, in which case we checks only for those requested.
  27 -a: Check arguments, like %1\$s
  28 -c: Check for colons at end
  29 -m: Check for menu shortcuts
  30 -p: Check for period at end
  31 -q: Check Qt shortcuts
  32 -s: Check for space at end
  33 -t: Check for uniform translation
  34 These options can be given with or without other options.
  35 -f: Ignore fuzzy translations
  36 -w: Only report summary total of errors
  37 -i: Silent mode, report only errors
  38 EOT
  39
  40 my %options;
  41 getopts(":hacfmpqstwi", \%options);
  42
  43 if (defined($options{h})) {
  44   print $usage;
  45   exit 0;
  46 }
  47
  48 my $only_total = defined($options{w});
  49 delete $options{w} if $only_total;
  50 my $ignore_fuzzy = defined($options{f});
  51 delete $options{f} if $ignore_fuzzy;
  52 my $silent_mode = defined($options{i});
  53 delete $options{i} if $silent_mode;
  54
  55 my $check_args = (!%options or defined($options{a}));
  56 my $check_colons = (!%options or defined($options{c}));
  57 my $check_spaces = (!%options or defined($options{s}));
  58 my $check_periods = (!%options or defined($options{p}));
  59 my $check_qt = (!%options or defined($options{q}));
  60 my $check_menu = (!%options or defined($options{m}));
  61 my $check_trans = (!%options or defined($options{t}));
  62
  63 my %trans;
  64
  65 my $total_warn = 0;
  66
  67 foreach my $pofilename ( @ARGV ) {
  68   my %bad;
  69   if (!$silent_mode) {
  70     print "Processing po file '$pofilename'...\n";
  71   }
  72
  73   open( INPUT, "<$pofilename" )
  74     || die "Cannot read po file '$pofilename'";
  75   my @pofile = <INPUT>;
  76   close( INPUT );
  77
  78   undef( %trans );
  79   keys( %trans ) = 10000;
  80
  81   my $noOfLines = $#pofile;
  82
  83   my $warn = 0;
  84
  85   my $i = 0;
  86   my ($msgid, $msgid_trans, $msgstr, $more);
  87
  88   while ($i <= $noOfLines) {
  89     my $linenum = $i;
  90     ( $msgid ) = ( $pofile[$i] =~ m/^msgid "(.*)"/ );
  91     $i++;
  92     next unless $msgid;
  93     if ($ignore_fuzzy) {
  94       my $previous = $pofile[$i - 2];
  95       next if $previous =~ m/#,.*fuzzy/;
  96     }
  97
  98     # some msgid's are more than one line long, so add those.
  99     while ( ( $more ) = $pofile[$i] =~ m/^"(.*)"/ ) {
 100       $msgid = $msgid . $more;
 101       $i++;
 102     }
 103
 104     # now look for the associated msgstr.
 105     until ( ( $msgstr ) = ( $pofile[$i] =~ m/^msgstr "(.*)"/ ) ) { $i++; };
 106     $i++;
 107     # again collect any extra lines.
 108     while ( ( $i <= $noOfLines ) &&
 109             ( ( $more ) = $pofile[$i] =~ m/^"(.*)"/ ) ) {
 110       $msgstr = $msgstr . $more;
 111       $i++;
 112     }
 113
 114     # nothing to do if one of them is empty.
 115     # (surely that is always $msgstr?)
 116     next if ($msgid eq "" or $msgstr eq "");
 117
 118     # discard [[...]] from the end of msgid, this is used only as hint to translation
 119     $msgid_trans = $msgid;      # used for uniform translation
 120     $msgid =~ s/\[\[.*\]\]$//;
 121
 122     # Check for matching %1$s, etc.
 123       if ($check_args) {
 124       my @argstrs = ( $msgid =~ m/%(\d)\$s/g );
 125       if (@argstrs) {
 126         my $n = 0;
 127         foreach my $arg (@argstrs) { $n = $arg if $arg > $n; }
 128         if ($n <= 0) {
 129           print "$pofilename, line $linenum: Problem finding arguments in:\n    $msgid!\n"
 130             unless $only_total;
 131           ++$bad{"Missing arguments"};
 132           $warn++;
 133         } else {
 134           foreach my $i (1..$n) {
 135             my $arg = "%$i\\\$s";
 136             if ( $msgstr !~ m/$arg/ ) {
 137               print "$pofilename, line $linenum: Missing argument `$arg'\n  '$msgid' ==> '$msgstr'\n"
 138                 unless $only_total;
 139               ++$bad{"Missing arguments"};
 140               $warn++;
 141             }
 142           }
 143         }
 144       }
 145     }
 146
 147     if ($check_colons) {
 148       # Check colon at the end of a message
 149       if ( ( $msgid =~ m/: *(\|.*)?$/ ) != ( $msgstr =~ m/: *(\|.*)?$/ ) ) {
 150         print "Line $linenum: Missing or unexpected colon:\n  '$msgid' => '$msgstr'\n"
 151           unless $only_total;
 152         ++$bad{"Bad colons"};
 153         $warn++;
 154       }
 155     }
 156
 157     if ($check_periods) {
 158       # Check period at the end of a message; uncomment code if you are paranoid
 159       # Convert '...' to '…' first
 160       $msgid = replaceSynopsis($msgid);
 161       $msgstr = replaceSynopsis($msgstr);
 162       if ( ( $msgid =~ m/\. *(\|.*)?$/ ) != ( $msgstr =~ m/\. *(\|.*)?$/ ) ) {
 163        print "Line $linenum: Missing or unexpected period:\n  '$msgid' => '$msgstr'\n"
 164         unless $only_total;
 165       ++$bad{"Bad periods"};
 166        $warn++;
 167       }
 168     }
 169
 170     if ($check_spaces) {
 171       # Check space at the end of a message (if not a shortcut)
 172       my ($msgid1, $msgstr1);
 173       ($msgid1 = $msgid) =~ s/\|.$//;
 174       ($msgstr1 = $msgstr) =~ s/\|.$//; # TODO: Shortcut may be utf-8 char
 175       if (($msgid1 =~ / $/) != ($msgstr1 =~ / $/)) {
 176         print "Line $linenum: Missing or unexpected space:\n  '$msgid' => '$msgstr'\n"
 177           unless $only_total;
 178         ++$bad{"Bad spaces"};
 179         $warn++;
 180       }
 181     }
 182
 183     if ($check_qt) {
 184       # Check for "&" shortcuts
 185       if ( ( $msgid =~ m/&[^ &]/ ) != ( $msgstr =~ m/&[^ &]/ ) ) {
 186         print "Line $linenum: Missing or unexpected Qt shortcut:\n  '$msgid' => '$msgstr'\n"
 187           unless $only_total;
 188         ++$bad{"Bad Qt shortcuts"};
 189         $warn++;
 190       }
 191     }
 192
 193     if ($check_menu) {
 194       # Check for "|..." shortcuts (space shortcut allowed)
 195       # Shortcut is either 1 char (ascii in msgid) or utf8 char (in msgstr)
 196       my ($s1, $s2) = (0,0);
 197       $s1 = 1 if ($msgid =~ /\|([^\|])$/);
 198       if ($msgstr =~ /\|([^\|]+)$/) {
 199         my $chars = $1;
 200         my $u = decode('utf-8', $chars);
 201         $s2 = 1 if (length($u) == 1);
 202       }
 203       if($s1 != $s2) {
 204         print "Line $linenum: Missing or unexpected menu shortcut:\n  '$msgid' => '$msgstr'\n"
 205           unless $only_total;
 206         ++$bad{"Bad menu shortcuts"};
 207         $warn++;
 208       }
 209     }
 210
 211     next unless $check_trans;
 212
 213     # we now collect these translations in a hash.
 214     # this will allow us to check below if we have translated
 215     # anything more than one way.
 216     my $msgid_clean  = lc($msgid_trans);
 217     my $msgstr_clean = mylc($msgstr);
 218
 219     $msgid_clean  =~ s/(.*)\|.*?$/$1/;  # strip menu shortcuts
 220     $msgstr_clean =~ s/(.*)\|.*?$/$1/;
 221     $msgid_clean  =~ s/&([^ ])/$1/;     # strip Qt shortcuts
 222     $msgstr_clean =~ s/&([^ ])/$1/;
 223
 224     # this is a hash of hashes. the keys of the outer hash are
 225     # cleaned versions of ORIGINAL strings. the keys of the inner hash
 226     # are the cleaned versions of their TRANSLATIONS. The value for the
 227     # inner hash is an array of the orignal string and translation.
 228     $trans{$msgid_clean}{$msgstr_clean} = [ $msgid_trans, $msgstr, $linenum ];
 229   }
 230
 231   if ($check_trans) {
 232     foreach $msgid ( keys %trans ) {
 233       # so $ref is a reference to the inner hash.
 234       my $ref = $trans{$msgid};
 235       # @msgstrkeys is an array of the keys of that inner hash.
 236       my @msgstrkeys = keys %$ref;
 237
 238       # do we have more than one such key?
 239       if ( $#msgstrkeys > 0 ) {
 240         if (!$only_total) {
 241           print "Different translations for '$msgid':\n";
 242           foreach $msgstr ( @msgstrkeys ) {
 243             print "Line $ref->{$msgstr}[2]: '" .
 244               $ref->{$msgstr}[0] . "' => '" .
 245               $ref->{$msgstr}[1] . "'\n";
 246           }
 247         }
 248         ++$bad{"Inconsistent translations"};
 249         $warn++;
 250       }
 251     }
 252   }
 253   if (!$silent_mode) {
 254     if ($warn) {
 255       while (my ($k, $v) = each %bad) { print "$k: $v\n"; }
 256       if (scalar(keys %bad) > 1) {
 257         print "Total warnings: $warn\n";
 258       }
 259     } else {
 260       print "No warnings!\n";
 261     }
 262     print "\n";
 263   }
 264   $total_warn += $warn;
 265 }
 266
 267 exit ($total_warn > 0);
 268
 269 # Use lowercase also for non-ascii chars
 270 sub mylc($)
 271 {
 272   my ($msg) = @_;
 273   return(encode('utf-8',lc(decode('utf-8', $msg))));
 274 }
 275
 276 sub replaceSynopsis($)
 277 {
 278   my ($string) = @_;
 279
 280   return ($string) if ($string !~ /^(.*)\.\.\.(.*)$/);
 281   my ($before, $after) = ($1, $2);
 282   return $string if (($before =~ /\.$/) || ($after =~ /^\./));
 283   return("$before…$after");
 284 }