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) = ($msgid, $msgstr);
 173       $msgid1 =~ s/\|.$//;
 174       if ($msgstr =~ /^(.*)\|(.+)$/) {
 175         my ($msg, $shortcut) = ($1, $2);
 176         # Check for unicode char
 177         my $u = decode('utf-8', $shortcut);
 178         if (length($u) == 1) {
 179           $msgstr1 = $msg;
 180         }
 181       }
 182       if (($msgid1 =~ / $/) != ($msgstr1 =~ / $/)) {
 183         print "Line $linenum: Missing or unexpected space:\n  '$msgid' => '$msgstr'\n"
 184           unless $only_total;
 185         ++$bad{"Bad spaces"};
 186         $warn++;
 187       }
 188     }
 189
 190     if ($check_qt) {
 191       # Check for "&" shortcuts
 192       if ( ( $msgid =~ m/&[^ &]/ ) != ( $msgstr =~ m/&[^ &]/ ) ) {
 193         print "Line $linenum: Missing or unexpected Qt shortcut:\n  '$msgid' => '$msgstr'\n"
 194           unless $only_total;
 195         ++$bad{"Bad Qt shortcuts"};
 196         $warn++;
 197       }
 198     }
 199
 200     if ($check_menu) {
 201       # Check for "|..." shortcuts (space shortcut allowed)
 202       # Shortcut is either 1 char (ascii in msgid) or utf8 char (in msgstr)
 203       my ($s1, $s2) = (0,0);
 204       $s1 = 1 if ($msgid =~ /\|(.)$/);
 205       if ($msgstr =~ /.*\|(.+)$/) {
 206         my $chars = $1;
 207         my $u = decode('utf-8', $chars);
 208         $s2 = 1 if (length($u) == 1);
 209       }
 210       if($s1 != $s2) {
 211         print "Line $linenum: Missing or unexpected menu shortcut:\n  '$msgid' => '$msgstr'\n"
 212           unless $only_total;
 213         ++$bad{"Bad menu shortcuts"};
 214         $warn++;
 215       }
 216     }
 217
 218     next unless $check_trans;
 219
 220     # we now collect these translations in a hash.
 221     # this will allow us to check below if we have translated
 222     # anything more than one way.
 223     my $msgid_clean  = lc($msgid_trans);
 224     my $msgstr_clean = mylc($msgstr);
 225
 226     $msgid_clean  =~ s/(.*)\|.*?$/$1/;  # strip menu shortcuts
 227     $msgstr_clean =~ s/(.*)\|.*?$/$1/;
 228     $msgid_clean  =~ s/&([^ ])/$1/;     # strip Qt shortcuts
 229     $msgstr_clean =~ s/&([^ ])/$1/;
 230
 231     # this is a hash of hashes. the keys of the outer hash are
 232     # cleaned versions of ORIGINAL strings. the keys of the inner hash
 233     # are the cleaned versions of their TRANSLATIONS. The value for the
 234     # inner hash is an array of the orignal string and translation.
 235     $trans{$msgid_clean}{$msgstr_clean} = [ $msgid_trans, $msgstr, $linenum ];
 236   }
 237
 238   if ($check_trans) {
 239     foreach $msgid ( keys %trans ) {
 240       # so $ref is a reference to the inner hash.
 241       my $ref = $trans{$msgid};
 242       # @msgstrkeys is an array of the keys of that inner hash.
 243       my @msgstrkeys = keys %$ref;
 244
 245       # do we have more than one such key?
 246       if ( $#msgstrkeys > 0 ) {
 247         if (!$only_total) {
 248           print "Different translations for '$msgid':\n";
 249           foreach $msgstr ( @msgstrkeys ) {
 250             print "Line $ref->{$msgstr}[2]: '" .
 251               $ref->{$msgstr}[0] . "' => '" .
 252               $ref->{$msgstr}[1] . "'\n";
 253           }
 254         }
 255         ++$bad{"Inconsistent translations"};
 256         $warn++;
 257       }
 258     }
 259   }
 260   if (!$silent_mode) {
 261     if ($warn) {
 262       while (my ($k, $v) = each %bad) { print "$k: $v\n"; }
 263       if (scalar(keys %bad) > 1) {
 264         print "Total warnings: $warn\n";
 265       }
 266     } else {
 267       print "No warnings!\n";
 268     }
 269     print "\n";
 270   }
 271   $total_warn += $warn;
 272 }
 273
 274 exit ($total_warn > 0);
 275
 276 # Use lowercase also for non-ascii chars
 277 sub mylc($)
 278 {
 279   my ($msg) = @_;
 280   return(encode('utf-8',lc(decode('utf-8', $msg))));
 281 }
 282
 283 sub replaceSynopsis($)
 284 {
 285   my ($string) = @_;
 286
 287   return ($string) if ($string !~ /^(.*)\.\.\.(.*)$/);
 288   my ($before, $after) = ($1, $2);
 289   return $string if (($before =~ /\.$/) || ($after =~ /^\./));
 290   return("$before…$after");
 291 }