po/perl/msgaccel-check

   1 #! /usr/bin/perl
   2 # The copyright notice and license are in the POD at the bottom.
   3
   4 use strict;
   5 use warnings;
   6 use Locale::PO qw();
   7 use Getopt::Long qw(GetOptions :config bundling gnu_compat);
   8 use autouse 'Pod::Usage' => qw(pod2usage);
   9
  10 my $VERSION = "1.6";
  11
  12 sub show_version
  13 {
  14     print "msgaccel-check $VERSION\n";
  15     pod2usage({-verbose => 99, -sections => "COPYRIGHT AND LICENSE",
  16                -exitval => 0});
  17 }
  18
  19 # The character that precedes accelerators in strings.
  20 # Set with the --accelerator-tag=CHARACTER option.
  21 my $Opt_accelerator_tag;
  22
  23 # True if, for missing or fuzzy translations, the msgid string should
  24 # be checked instead of msgstr.  Set with the --msgid-fallback and
  25 # --no-msgid-fallback options.
  26 my $Opt_msgid_fallback = 1;
  27
  28 sub acceleration_arrays_eq ($$)
  29 {
  30     my($left, $right) = @_;
  31     ref($left) eq "ARRAY" or return 0;
  32     ref($right) eq "ARRAY" or return 0;
  33     @$left == @$right or return 0;
  34     $left->[$_] eq $right->[$_] or return 0
  35         foreach (0 .. $#$right);
  36     return 1;
  37 }
  38
  39 sub check_po_file ($)
  40 {
  41     # The name of the PO file to be checked.
  42     my($po_file_name) = @_;
  43
  44     # A nested hash that lists the accelerators and their uses.
  45     # $accelerators{$accelerator}{$ctxname}{ACCELERATIONS}[$i]{LINENO}
  46     # 1. In %accelerators, the keys are one-character strings,
  47     #    and the values are hash references.
  48     # 2. In %{$accelerators{$accelerator}}, the keys are names
  49     #    of contexts in which the accelerator is used, and the
  50     #    values are references to "crossing" hashes.
  51     # 3. %{$accelerators{$accelerator}{$ctxname}} is a "crossing" hash,
  52     #    so named because it describes how an accelerator and a context
  53     #    cross each other.  It has the following elements:
  54     #    (ACCELERATIONS => [see point 4 below],
  55     #     REPORTED => (1 if this is a conflict and has been reported),
  56     #     AVOID => (1 if this accelerator should not be suggested in this
  57     #               context))
  58     # 4. @{$accelerators{$accelerator}{$ctxname}{ACCELERATIONS}} is a list of
  59     #    references to "acceleration" hashes.  If the same acceleration occurs
  60     #    in multiple contexts, then the references are to the same hash.
  61     # 5. %{$accelerators{$accelerator}{ctxname}{ACCELERATIONS}[$i]} is an
  62     #    "acceleration" hash.  It has the following structure:
  63     #    (PO => (the Locale::PO object),
  64     #     CTXNAMES => [read-only list of names of contexts in which the
  65     #                  accelerator is used],
  66     #     ACCELERATOR => (a one-character string),
  67     #     LINENO => (line number in the PO file),
  68     #     STRING => (the msgid or msgstr string that defines the accelerator;
  69     #                unquoted as much as possible),
  70     #     EXPLAIN => (a string to be displayed if a conflict is found))
  71     my %accelerators;
  72
  73     # How many entries had checkable accelerators.
  74     my $checkable_count = 0;
  75
  76     # How many conflicts have been found so far.
  77     my $conflict_count = 0;
  78
  79     {
  80         my $pos = Locale::PO->load_file_asarray($po_file_name)
  81             or warn "$po_file_name: $!\n", return 2;
  82         foreach my $po (@$pos) {
  83             my $automatic = $po->automatic()
  84                 or next;
  85             my($ctxnames) = ($automatic =~ /^accelerator_context\(([^\)]*)\)/)
  86                 or next;
  87             my @ctxnames = split(/\s*,\s*/, $ctxnames);
  88             my @accelerations;
  89             my $msgid = $po->msgid();
  90             my $msgstr = $po->msgstr();
  91             if ($po->dequote($msgstr) ne "" && !$po->fuzzy()) {
  92                 if (my($accelerator) = ($msgstr =~ /\Q$Opt_accelerator_tag\E(.)/s)) {
  93                     push @accelerations, { PO => $po,
  94                                            CTXNAMES => \@ctxnames,
  95                                            ACCELERATOR => $accelerator,
  96                                            LINENO => $po->msgstr_begin_lineno(),
  97                                            STRING => $msgstr,
  98                                            EXPLAIN => "msgstr $msgstr" };
  99                 }
 100
 101                 # TODO: look for accelerators in plural forms?
 102             }
 103             elsif ($Opt_msgid_fallback && $po->dequote($msgid) ne "") {
 104                 if (my($accelerator) = ($msgid =~ /\Q$Opt_accelerator_tag\E(.)/s)) {
 105                     push @accelerations, { PO => $po,
 106                                            CTXNAMES => \@ctxnames,
 107                                            ACCELERATOR => $accelerator,
 108                                            LINENO => $po->msgid_begin_lineno(),
 109                                            STRING => $msgid,
 110                                            EXPLAIN => "msgid $msgid" };
 111                 }
 112             }
 113
 114             $checkable_count++ if @accelerations;
 115             foreach my $acceleration (@accelerations) {
 116                 my $accelerator = uc($acceleration->{ACCELERATOR});
 117                 foreach my $crossing (@{$accelerators{$accelerator}}{@ctxnames}) {
 118                     push @{$crossing->{ACCELERATIONS}}, $acceleration;
 119                     $crossing->{AVOID} = 1 if $acceleration->{EXPLAIN} =~ /^msgstr/;
 120                 }
 121             }
 122         }
 123     }
 124
 125     foreach my $accelerator (sort keys %accelerators) {
 126         my $ctxhash = $accelerators{$accelerator};
 127         foreach my $crossing (@{$ctxhash}{sort keys %$ctxhash}) {
 128             my $accelerations = $crossing->{ACCELERATIONS};
 129             if ($accelerations && @$accelerations > 1 && !$crossing->{REPORTED}) {
 130                 my @ctxnames_in_conflict;
 131                 foreach my $inner_ctxname (keys %$ctxhash) {
 132                     my $inner_crossing = $ctxhash->{$inner_ctxname};
 133                     if (acceleration_arrays_eq($inner_crossing->{ACCELERATIONS},
 134                                                $accelerations)) {
 135                         push @ctxnames_in_conflict, $inner_ctxname;
 136                         $inner_crossing->{REPORTED} = 1;
 137                     }
 138                 }
 139                 my $ctxnames_in_conflict = join(", ", map(qq("$_"), @ctxnames_in_conflict));
 140                 warn "$po_file_name: Accelerator conflict for \"$accelerator\" in $ctxnames_in_conflict:\n";
 141                 foreach my $acceleration (@$accelerations) {
 142                     my $lineno = $acceleration->{LINENO};
 143                     my $explain = $acceleration->{EXPLAIN};
 144
 145                     # Get a string of unique characters in the string,
 146                     # preferring characters that start a word.
 147                     # FIXME: should remove quotes and resolve \n etc.
 148                     my $displaystr = $acceleration->{STRING};
 149                     $displaystr =~ s/\Q$Opt_accelerator_tag\E//g;
 150                     my $suggestions = "";
 151                     foreach my $char ($displaystr =~ /\b(\w)/g,
 152                                       $displaystr =~ /(\w)/g) {
 153                         $suggestions .= $char unless $suggestions =~ /\Q$char\E/i;
 154                     }
 155
 156                     # But don't suggest unavailable characters.
 157                     SUGGESTION: foreach my $char (split(//, $suggestions)) {
 158                         foreach my $ctxname (@{$acceleration->{CTXNAMES}}) {
 159                             $suggestions =~ s/\Q$char\E//, next SUGGESTION
 160                                 if $accelerators{uc($char)}{$ctxname}{AVOID};
 161                         }
 162                     }
 163
 164                     warn "$po_file_name:$lineno: $explain\n";
 165                     if ($suggestions eq "") {
 166                         warn "$po_file_name:$lineno: no suggestions :-(\n";
 167                     }
 168                     else {
 169                         warn "$po_file_name:$lineno: suggestions: $suggestions\n";
 170                     }
 171                 } # foreach $acceleration in conflict
 172                 $conflict_count++;
 173             } # if found a conflict
 174         } # foreach context known for $accelerator
 175     } # foreach $accelerator
 176
 177     print "$po_file_name: "
 178         . ($checkable_count == 1 ? "Checked 1 entry" : "Checked $checkable_count entries")
 179         . ", "
 180         . ($conflict_count == 1 ? "found 1 accelerator conflict" : "found $conflict_count accelerator conflicts")
 181         . ".\n";
 182     return $conflict_count ? 1 : 0;
 183 }
 184
 185 GetOptions("accelerator-tag=s" => sub {
 186                my($option, $value) = @_;
 187                die "Cannot use multiple --accelerator-tag options\n"
 188                    if defined($Opt_accelerator_tag);
 189                die "--accelerator-tag requires a single-character argument\n"
 190                    if length($value) != 1;
 191                $Opt_accelerator_tag = $value;
 192            },
 193            "msgid-fallback!" => \$Opt_msgid_fallback,
 194            "help" => sub { pod2usage({-verbose => 1, -exitval => 0}) },
 195            "version" => \&show_version)
 196     or exit 2;
 197 $Opt_accelerator_tag = "~" unless defined $Opt_accelerator_tag;
 198 print(STDERR "$0: missing file operand\n"), exit 2 unless @ARGV;
 199
 200 my $max_error = 0;
 201 foreach my $po_file_name (@ARGV) {
 202     my $error = check_po_file($po_file_name);
 203     $max_error = $error if $error > $max_error;
 204 }
 205 exit $max_error;
 206
 207 __END__
 208
 209 =head1 NAME
 210
 211 msgaccel-check - Scan a PO file for conflicting accelerator keys.
 212
 213 =head1 SYNOPSIS
 214
 215 B<msgaccel-check> [I<option> ...] F<I<language>.po> [...]
 216
 217 =head1 DESCRIPTION
 218
 219 B<msgaccel-check> is part of a framework that detects conflicting
 220 accelerator keys in Gettext PO files.  A conflict is when two items in
 221 the same menu or two buttons in the same dialog box use the same
 222 accelerator key.
 223
 224 The PO file format does not normally include any information on which
 225 strings will be used in the same menu or dialog box.
 226 B<msgaccel-check> can only be used on PO files to which this
 227 information has been added with B<msgaccel-prepare> or merged with
 228 B<msgmerge>.
 229
 230 B<msgaccel-check> reads the F<I<language>.po> file named on the
 231 command line and reports any conflicts to standard error.  It also
 232 tries to suggest replacements for the conflicting accelerators.
 233
 234 B<msgaccel-check> does not access the source files to which
 235 F<I<language>.po> refers.  Thus, it does not matter if the line
 236 numbers in "#:" lines are out of date.
 237
 238 =head1 OPTIONS
 239
 240 =over
 241
 242 =item B<--accelerator-tag=>I<character>
 243
 244 Specify the character that marks accelerators in C<msgstr> strings.
 245 Whenever this character occurs in a C<msgstr>, B<msgaccel-check>
 246 treats the next character as an accelerator and checks that it is
 247 unique in each of the contexts in which the C<msgstr> is used.
 248
 249 Omitting the B<--accelerator-tag> option implies
 250 B<--accelerator-tag="~">.  The option must be given to each program
 251 separately because there is no standard way to save this information
 252 in the PO file.
 253
 254 =item B<--msgid-fallback>
 255
 256 =item B<--no-msgid-fallback>
 257
 258 Select how to check entries where the C<msgstr> is missing or fuzzy.
 259 The default is B<--msgid-fallback>, which makes B<msgaccel-check> use
 260 the C<msgid> instead, and report any conflicts between C<msgid> and
 261 C<msgstr> strings.  The alternative is B<--no-msgid-fallback>, which
 262 makes B<msgaccel-check> completely ignore such entries.
 263
 264 Regardless of these options, B<msgaccel-check> will suggest
 265 accelerators that would conflict with ones defined in C<msgid>
 266 strings.  Those strings will be eventually shadowed by C<msgstr>
 267 strings, so their accelerators should not affect which accelerators
 268 the translator chooses for C<msgstr> strings.
 269
 270 =back
 271
 272 =head1 ARGUMENTS
 273
 274 =over
 275
 276 =item F<I<language>.po> [...]
 277
 278 The PO files to be scanned for conflicts.  These files must include
 279 the "accelerator_context" comments added by B<msgaccel-prepare>.
 280 If the special comments are missing, no conflicts will be found.
 281
 282 =back
 283
 284 =head1 EXIT CODE
 285
 286 0 if no conflicts were found.
 287
 288 1 if some conflicts were found.
 289
 290 2 if the command line is invalid or a file cannot be read.
 291
 292 =head1 BUGS
 293
 294 =head2 Waiting for Locale::PO fixes
 295
 296 When B<msgaccel-check> includes C<msgstr> strings in warnings, it
 297 should transcode them from the charset of the PO file to the one
 298 specified by the user's locale.
 299
 300 =head1 AUTHOR
 301
 302 Kalle Olavi Niemitalo <kon@iki.fi>
 303
 304 =head1 COPYRIGHT AND LICENSE
 305
 306 Copyright (c) 2005-2006 Kalle Olavi Niemitalo.
 307
 308 Permission to use, copy, modify, and/or distribute this software for any
 309 purpose with or without fee is hereby granted, provided that the above
 310 copyright notice and this permission notice appear in all copies.
 311
 312 THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 313 WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 314 MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 315 ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 316 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 317 ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 318 OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 319
 320 =head1 SEE ALSO
 321
 322 L<msgaccel-prepare>, C<xgettext(1)>, C<msgmerge(1)>