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