po/pocheck.pl

   1 #! /usr/bin/perl -w
   2
   3 # file pocheck.pl
   4 #
   5 # This file is part of LyX, the document processor.
   6 # Licence details can be found in the file COPYING.
   7 #
   8 # author: Michael Gerz, michael.gerz@teststep.org
   9 #
  10
  11 use strict;
  12 use warnings;
  13 use Getopt::Std;
  14
  15 my $usage = <<EOT;
  16 pocheck.pl [-acmpqst] po_file [po_file] ...
  17
  18 This script performs some consistency checks on po files.
  19
  20 We check for everything listed here, unless one or more of these
  21 options is given, in which case we checks only for those requested.
  22 -a: Check arguments, like %1\$s
  23 -c: Check for colons at end
  24 -m: Check for menu shortcuts
  25 -p: Check for period at end
  26 -q: Check Qt shortcuts
  27 -s: Check for space at end
  28 -t: Check for uniform translation
  29 This option can be given with or without other options.
  30 -w: Only report summary total of errors
  31 EOT
  32
  33 my %options;
  34 getopts(":hacmpqstw", \%options);
  35
  36 if (defined($options{h})) {
  37   print $usage;
  38   exit 0;
  39 }
  40
  41 my $only_total = defined($options{w});
  42 delete $options{w} if $only_total;
  43
  44 my $check_args = (!%options or defined($options{a}));
  45 my $check_colons = (!%options or defined($options{c}));
  46 my $check_spaces = (!%options or defined($options{m}));
  47 my $check_periods = (!%options or defined($options{p}));
  48 my $check_qt = (!%options or defined($options{q}));
  49 my $check_menu = (!%options or defined($options{s}));
  50 my $check_trans = (!%options or defined($options{t}));
  51
  52 my %trans;
  53
  54 foreach my $pofilename ( @ARGV ) {
  55   my %bad;
  56   print "Processing po file '$pofilename'...\n";
  57
  58   open( INPUT, "<$pofilename" )
  59     || die "Cannot read po file '$pofilename'";
  60   my @pofile = <INPUT>;
  61   close( INPUT );
  62
  63   undef( %trans );
  64   keys( %trans ) = 10000;
  65
  66   my $noOfLines = $#pofile;
  67
  68   my $warn = 0;
  69
  70   my $i = 0;
  71   my ($msgid, $msgstr, $more);
  72
  73   while ($i <= $noOfLines) {
  74     my $linenum = $i;
  75     ( $msgid ) = ( $pofile[$i] =~ m/^msgid "(.*)"/ );
  76     $i++;
  77     next unless $msgid;
  78
  79     # some msgid's are more than one line long, so add those.
  80     while ( ( $more ) = $pofile[$i] =~ m/^"(.*)"/ ) {
  81       $msgid = $msgid . $more;
  82       $i++;
  83     }
  84
  85     # now look for the associated msgstr.
  86     until ( ( $msgstr ) = ( $pofile[$i] =~ m/^msgstr "(.*)"/ ) ) { $i++; };
  87     $i++;
  88     # again collect any extra lines.
  89     while ( ( $i <= $noOfLines ) &&
  90             ( ( $more ) = $pofile[$i] =~ m/^"(.*)"/ ) ) {
  91       $msgstr = $msgstr . $more;
  92       $i++;
  93     }
  94
  95     # nothing to do if one of them is empty.
  96     # (surely that is always $msgstr?)
  97     next if ($msgid eq "" or $msgstr eq "");
  98
  99     # Check for matching %1$s, etc.
 100       if ($check_args) {
 101       my @argstrs = ( $msgid =~ m/%(\d)\$s/g );
 102       if (@argstrs) {
 103         my $n = 0;
 104         foreach my $arg (@argstrs) { $n = $arg if $arg > $n; }
 105         if ($n <= 0) {
 106           print "Line $linenum: Problem finding arguments in:\n    $msgid!\n"
 107             unless $only_total;
 108           ++$bad{"Missing arguments"};
 109           $warn++;
 110         } else {
 111           foreach my $i (1..$n) {
 112             my $arg = "%$i\\\$s";
 113             if ( $msgstr !~ m/$arg/ ) {
 114               print "Line $linenum: Missing argument `$arg'\n  '$msgid' ==> '$msgstr'\n"
 115                 unless $only_total;
 116               ++$bad{"Missing arguments"};
 117               $warn++;
 118             }
 119           }
 120         }
 121       }
 122     }
 123
 124     if ($check_colons) {
 125       # Check colon at the end of a message
 126       if ( ( $msgid =~ m/: *(\|.*)?$/ ) != ( $msgstr =~ m/: *(\|.*)?$/ ) ) {
 127         print "Line $linenum: Missing or unexpected colon:\n  '$msgid' => '$msgstr'\n"
 128           unless $only_total;
 129         ++$bad{"Bad colons"};
 130         $warn++;
 131       }
 132     }
 133
 134     if ($check_periods) {
 135       # Check period at the end of a message; uncomment code if you are paranoid
 136       if ( ( $msgid =~ m/\. *(\|.*)?$/ ) != ( $msgstr =~ m/\. *(\|.*)?$/ ) ) {
 137        print "Line $linenum: Missing or unexpected period:\n  '$msgid' => '$msgstr'\n"
 138         unless $only_total;
 139       ++$bad{"Bad periods"};
 140        $warn++;
 141       }
 142     }
 143
 144     if ($check_spaces) {
 145       # Check space at the end of a message
 146       if ( ( $msgid =~ m/  *?(\|.*)?$/ ) != ( $msgstr =~ m/  *?(\|.*)?$/ ) ) {
 147         print "Line $linenum: Missing or unexpected space:\n  '$msgid' => '$msgstr'\n"
 148           unless $only_total;
 149         ++$bad{"Bad spaces"};
 150         $warn++;
 151       }
 152     }
 153
 154     if ($check_qt) {
 155       # Check for "&" shortcuts
 156       if ( ( $msgid =~ m/&[^ ]/ ) != ( $msgstr =~ m/&[^ ]/ ) ) {
 157         print "Line $linenum: Missing or unexpected Qt shortcut:\n  '$msgid' => '$msgstr'\n"
 158           unless $only_total;
 159         ++$bad{"Bad Qt shortcuts"};
 160         $warn++;
 161       }
 162     }
 163
 164     if ($check_menu) {
 165       # Check for "|..." shortcuts
 166       if ( ( $msgid =~ m/\|[^ ]/ ) != ( $msgstr =~ m/\|[^ ]/ ) ) {
 167         print "Line $linenum: Missing or unexpected menu shortcut:\n  '$msgid' => '$msgstr'\n"
 168           unless $only_total;
 169         ++$bad{"Bad menu shortcuts"};
 170         $warn++;
 171       }
 172     }
 173
 174     next unless $check_trans;
 175
 176     # we now collect these translations in a hash.
 177     # this will allow us to check below if we have translated
 178     # anything more than one way.
 179     my $msgid_clean  = lc($msgid);
 180     my $msgstr_clean = lc($msgstr);
 181
 182     $msgid_clean  =~ s/(.*)\|.*?$/$1/;  # strip menu shortcuts
 183     $msgstr_clean =~ s/(.*)\|.*?$/$1/;
 184     $msgid_clean  =~ s/&([^ ])/$1/;     # strip Qt shortcuts
 185     $msgstr_clean =~ s/&([^ ])/$1/;
 186
 187     # this is a hash of hashes. the keys of the outer hash are
 188     # cleaned versions of ORIGINAL strings. the keys of the inner hash
 189     # are the cleaned versions of their TRANSLATIONS. The value for the
 190     # inner hash is an array of the orignal string and translation.
 191     $trans{$msgid_clean}{$msgstr_clean} = [ $msgid, $msgstr, $linenum ];
 192   }
 193
 194   if ($check_trans) {
 195     foreach $msgid ( keys %trans ) {
 196       # so $ref is a reference to the inner hash.
 197       my $ref = $trans{$msgid};
 198       # @msgstrkeys is an array of the keys of that inner hash.
 199       my @msgstrkeys = keys %$ref;
 200
 201       # do we have more than one such key?
 202       if ( $#msgstrkeys > 0 ) {
 203         if (!$only_total) {
 204           print "Different translations for '$msgid':\n";
 205           foreach $msgstr ( @msgstrkeys ) {
 206             print "Line $ref->{$msgstr}[2]: '" .
 207               $ref->{$msgstr}[0] . "' => '" .
 208               $ref->{$msgstr}[1] . "'\n";
 209           }
 210         }
 211         ++$bad{"Inconsistent translations"};
 212         $warn++;
 213       }
 214     }
 215   }
 216
 217   print "\n";
 218   while (my ($k, $v) = each %bad) { print "$k: $v warnings\n"; }
 219   print "Total number of warnings: $warn\n\n";
 220 }