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