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