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