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 # This script performs some consistency checks on po files:
  11 #
  12 #   1. Uniform translation of messages that are identical except
  13 #      for capitalization, shortcuts, and shortcut notation.
  14 #   2. Usage of the following elements in both the original and
  15 #      the translated message (or no usage at all):
  16 #      shortcuts ("&" and "|..."), trailing space, trailing colon
  17 #
  18 # Invocation:
  19 #    pocheck.pl po_file po_file ...
  20
  21 use strict;
  22 use warnings;
  23
  24 my %trans;
  25
  26 foreach my $pofilename ( @ARGV )
  27 {
  28   print "Processing po file '$pofilename'...\n";
  29
  30   open( INPUT, "<$pofilename" )
  31     || die "Cannot read po file '$pofilename'";
  32   my @pofile = <INPUT>;
  33   close( INPUT );
  34
  35   undef( %trans );
  36   keys( %trans ) = 10000;
  37
  38   my $noOfLines = $#pofile;
  39
  40   my $warn = 0;
  41
  42   my $i = 0;
  43   my ($msgid, $msgstr, $more);
  44
  45   while ($i <= $noOfLines) {
  46     ( $msgid ) = ( $pofile[$i] =~ m/^msgid "(.*)"/ );
  47     $i++;
  48     next unless $msgid;
  49
  50     # some msgid's are more than one line long, so add those.
  51     while ( ( $more ) = $pofile[$i] =~ m/^"(.*)"/ ) {
  52       $msgid = $msgid . $more;
  53       $i++;
  54     }
  55
  56     # now look for the associated msgstr.
  57     until ( ( $msgstr ) = ( $pofile[$i] =~ m/^msgstr "(.*)"/ ) ) { $i++; };
  58     $i++;
  59     # again collect any extra lines.
  60     while ( ( $i <= $noOfLines ) &&
  61             ( ( $more ) = $pofile[$i] =~ m/^"(.*)"/ ) ) {
  62       $msgstr = $msgstr . $more;
  63       $i++;
  64     }
  65
  66     # nothing to do if one of them is empty.
  67     # (surely that is always $msgstr?)
  68     next if ($msgid eq "" or $msgstr eq "");
  69
  70     # Check for matching %1$s, etc.
  71     my @argstrs = ( $msgid =~ m/%(\d)\$s/g );
  72     if (@argstrs) {
  73       my $n = 0;
  74       foreach my $arg (@argstrs) { $n = $arg if $arg > $n; }
  75       if ($n <= 0) {
  76         print "Problem finding arguments in:\n    $msgid!\n";
  77         $warn++;
  78       } else {
  79         foreach my $i (1..$n) {
  80           my $arg = "%$i\\\$s";
  81           if ( $msgstr !~ m/$arg/ ) {
  82             print "Missing argument `$arg'\n  '$msgid' ==> '$msgstr'\n";
  83             $warn++;
  84           }
  85         }
  86       }
  87     }
  88
  89     # Check colon at the end of a message
  90     if ( ( $msgid =~ m/: *(\|.*)?$/ ) != ( $msgstr =~ m/: *(\|.*)?$/ ) ) {
  91       print( "Missing or unexpected colon:\n" );
  92       print( "  '$msgid' => '$msgstr'\n" );
  93       $warn++;
  94     }
  95
  96     # Check period at the end of a message; uncomment code if you are paranoid
  97     #if ( ( $msgid =~ m/\. *(\|.*)?$/ ) != ( $msgstr =~ m/\. *(\|.*)?$/ ) ) {
  98     #  print( "Missing or unexpected period:\n" );
  99     #  print( "  '$msgid' => '$msgstr'\n" );
 100     #  $warn++;
 101     #}
 102
 103     # Check space at the end of a message
 104     if ( ( $msgid =~ m/  *?(\|.*)?$/ ) != ( $msgstr =~ m/  *?(\|.*)?$/ ) ) {
 105       print( "Missing or unexpected space:\n" );
 106       print( "  '$msgid' => '$msgstr'\n" );
 107       $warn++;
 108     }
 109
 110     # Check for "&" shortcuts
 111     if ( ( $msgid =~ m/&[^ ]/ ) != ( $msgstr =~ m/&[^ ]/ ) ) {
 112       print( "Missing or unexpected Qt shortcut:\n" );
 113       print( "  '$msgid' => '$msgstr'\n" );
 114       $warn++;
 115     }
 116
 117     # Check for "|..." shortcuts
 118     if ( ( $msgid =~ m/\|[^ ]/ ) != ( $msgstr =~ m/\|[^ ]/ ) ) {
 119       print( "Missing or unexpected menu shortcut:\n" );
 120       print( "  '$msgid' => '$msgstr'\n" );
 121       $warn++;
 122     }
 123
 124     # we now collect these translations in a hash.
 125     # this will allow us to check below if we have translated
 126     # anything more than one way.
 127     my $msgid_clean  = lc($msgid);
 128     my $msgstr_clean = lc($msgstr);
 129
 130     $msgid_clean  =~ s/(.*)\|.*?$/$1/;  # strip menu shortcuts
 131     $msgstr_clean =~ s/(.*)\|.*?$/$1/;
 132     $msgid_clean  =~ s/&([^ ])/$1/;     # strip Qt shortcuts
 133     $msgstr_clean =~ s/&([^ ])/$1/;
 134
 135     # this is a hash of hashes. the keys of the outer hash are
 136     # cleaned versions of ORIGINAL strings. the keys of the inner hash
 137     # are the cleaned versions of their TRANSLATIONS. The value for the
 138     # inner hash is an array of the orignal string and translation.
 139     $trans{$msgid_clean}{$msgstr_clean} = [ $msgid, $msgstr ];
 140   }
 141
 142   foreach $msgid ( keys %trans ) {
 143     # so $ref is a reference to the inner hash.
 144     my $ref = $trans{$msgid};
 145     # @msgstrkeys is an array of the keys of that inner hash.
 146     my @msgstrkeys = keys %$ref;
 147
 148     # do we have more than one such key?
 149     if ( $#msgstrkeys > 0 ) {
 150       print( "Different translations for '$msgid':\n" );
 151       foreach $msgstr ( @msgstrkeys ) {
 152         print( "  '" . $trans{$msgid}{$msgstr}[0] . "' => '" . $trans{$msgid}{$msgstr}[1] . "'\n" );
 153       }
 154       $warn++;
 155     }
 156   }
 157
 158   print( "\nTotal number of warnings: $warn\n\n" );
 159 }