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