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