rt/devel/tools/rt-message-catalog

   1 #!/usr/bin/env perl
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
   7 #                                          <sales@bestpractical.com>
   8 #
   9 # (Except where explicitly superseded by other copyright notices)
  10 #
  11 #
  12 # LICENSE:
  13 #
  14 # This work is made available to you under the terms of Version 2 of
  15 # the GNU General Public License. A copy of that license should have
  16 # been provided with this software, but in any event can be snarfed
  17 # from www.gnu.org.
  18 #
  19 # This work is distributed in the hope that it will be useful, but
  20 # WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 # General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with this program; if not, write to the Free Software
  26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  27 # 02110-1301 or visit their web page on the internet at
  28 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  29 #
  30 #
  31 # CONTRIBUTION SUBMISSION POLICY:
  32 #
  33 # (The following paragraph is not intended to limit the rights granted
  34 # to you to modify and distribute this software under the terms of
  35 # the GNU General Public License and is only of importance to you if
  36 # you choose to contribute your changes and enhancements to the
  37 # community by submitting them to Best Practical Solutions, LLC.)
  38 #
  39 # By intentionally submitting any modifications, corrections or
  40 # derivatives to this work, or any other work intended for use with
  41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  42 # you are the copyright holder for those contributions and you grant
  43 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  44 # royalty-free, perpetual, license to use, copy, create derivative
  45 # works based on those contributions, and sublicense and distribute
  46 # those contributions and any derivatives thereof.
  47 #
  48 # END BPS TAGGED BLOCK }}}
  49 use strict;
  50 use warnings;
  51
  52 use Locale::PO;
  53 use Getopt::Long;
  54 use File::Temp 'tempdir';
  55
  56 use constant PO_DIR => 'share/po';
  57
  58 use constant BOUNDARY => 20;
  59
  60 sub usage {
  61     warn @_, "\n\n" if @_;
  62     warn <<'    USAGE';
  63 usages:
  64
  65     rt-message-catalog stats [po-directory]
  66     rt-message-catalog clean
  67     rt-message-catalog rosetta download-url
  68     rt-message-catalog extract [po-file ...]
  69
  70 stats: Print stats for each translation.
  71
  72 clean: Remove unused and identity translations
  73
  74 rosetta: Merge translations from Launchpad's Rosetta; Requires a
  75   Launchpad translations export url.
  76
  77 extract: Extract message catalogs from source code and report common errors.
  78
  79     If passed a specific translation file, only that file is updated.
  80     (Not recommended except for debugging.)
  81
  82     USAGE
  83     exit 1;
  84 }
  85
  86 my $command = shift;
  87 usage() unless $command;
  88 usage("Unknown command '$command'")
  89     unless main->can($command);
  90
  91 main->can($command)->( @ARGV );
  92
  93 exit;
  94
  95 sub stats {
  96     my $dir = shift || PO_DIR;
  97
  98     my $max = 0;
  99     my %res = ();
 100
 101     foreach my $po_file (<$dir/*.po>) {
 102         my $array = Locale::PO->load_file_asarray( $po_file, "utf-8" );
 103
 104         $res{$po_file} = 0;
 105
 106         my $size = 0;
 107         foreach my $entry ( splice @$array, 1 ) {
 108             next if $entry->obsolete;
 109             next if $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/;
 110             $size++;
 111             next unless length $entry->dequote( $entry->msgstr );
 112             $res{$po_file}++;
 113         }
 114         $max = $size if $max < $size;
 115     }
 116
 117     my $width = length($max);
 118     foreach my $po_file ( sort { $res{$b} <=> $res{$a} } keys %res ) {
 119         my $tr = $res{$po_file};
 120         my $perc = int($tr*1000/$max)/10;
 121         printf "%-20s %${width}d/%${width}d (%.1f%%)\n", "$po_file:", $tr, $max, $perc;
 122     }
 123 }
 124
 125 sub clean {
 126     my $dir = shift || PO_DIR;
 127
 128     foreach my $po_file (<$dir/*.po>) {
 129         my $array = Locale::PO->load_file_asarray( $po_file, "utf-8" );
 130         foreach my $entry ( splice @$array, 1 ) {
 131             # Replace identical translations with the empty string
 132             $entry->msgstr("") if $entry->msgstr eq $entry->msgid;
 133
 134             # Skip NOT FOUND IN SOURCE entries
 135             next if $entry->obsolete;
 136             next if $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/;
 137
 138             push @$array, $entry;
 139         }
 140         Locale::PO->save_file_fromarray($po_file, $array, "utf-8");
 141     }
 142 }
 143
 144 sub rosetta {
 145     my $url = shift or die 'must provide Rosetta download url or directory with new po files';
 146
 147     my $dir;
 148     if ( $url =~ m{^[a-z]+://} ) {
 149         $dir = tempdir();
 150         my ($fname) = $url =~ m{([^/]+)$};
 151
 152         print "Downloading $url\n";
 153         require LWP::Simple;
 154         LWP::Simple::getstore($url => "$dir/$fname");
 155
 156         print "Extracting $dir/$fname\n";
 157         require Archive::Extract;
 158         my $ae = Archive::Extract->new(archive => "$dir/$fname");
 159         my $ok = $ae->extract( to => $dir );
 160     }
 161     elsif ( -e $url && -d _ ) {
 162         $dir = $url;
 163     }
 164     else {
 165         die "Is not URL or directory: '$url'";
 166     }
 167
 168     my @files = ( <$dir/*/*/*.po>, <$dir/*/*.po>, <$dir/*.po> );
 169     unless ( @files ) {
 170         print STDERR "No files in $dir/rt/*.po and $dir/*.po\n";
 171         exit;
 172     }
 173
 174     for my $file ( @files ) {
 175         my ($lang) = $file =~ m/([\w_]+)\.po/;
 176         my $fn_orig = PO_DIR . "/$lang.po";
 177
 178         my $load_from = $fn_orig;
 179         $load_from = PO_DIR . "/rt.pot" unless -e $load_from;
 180         my $orig = Locale::PO->load_file_ashash( $fn_orig, "utf-8" );
 181
 182         print "$file -> $fn_orig\n";
 183
 184         my $rosetta = Locale::PO->load_file_asarray( $file, "utf-8" );
 185
 186         # We're merging in the current hash as fallbacks for the rosetta hash
 187         my $translated = 0;
 188         foreach my $entry ( splice @$rosetta, 1 ) {
 189             # Skip no longer in source entries
 190             next if $entry->obsolete;
 191             next if $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/;
 192
 193             # Update to what the old po file had, if we have nothing
 194             my $oldval = $orig->{$entry->msgid};
 195             if (not length $entry->dequote($entry->msgstr) and $oldval) {
 196                 $entry->msgstr($oldval->dequote($oldval->msgstr));
 197             }
 198
 199             # Replace identical translations with the empty string
 200             $entry->msgstr("") if $entry->msgstr eq $entry->msgid;
 201
 202             # Drop "fuzzy" information
 203             $entry->fuzzy_msgctxt(undef);
 204             $entry->fuzzy_msgid(undef);
 205             $entry->fuzzy_msgid_plural(undef);
 206
 207             $translated++ if length $entry->dequote($entry->msgstr);
 208             push @$rosetta, $entry;
 209         }
 210
 211         my $perc = int($translated/(@$rosetta - 1) * 100 + 0.5);
 212         if ( $perc < BOUNDARY and $lang !~ /^en(_[A-Z]{2})?$/) {
 213             unlink $fn_orig;
 214             next;
 215         }
 216
 217         Locale::PO->save_file_fromarray($fn_orig, $rosetta, "utf-8");
 218     }
 219     extract();
 220 }
 221
 222 sub extract {
 223     system($^X, 'devel/tools/extract-message-catalog', @_);
 224 }