rt/sbin/extract-message-catalog

   1 #!/usr/bin/perl -w
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2011 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 # Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org>
  50
  51 use strict;
  52
  53 use File::Find;
  54 use File::Copy;
  55 use Regexp::Common;
  56 use Carp;
  57
  58 use vars qw($DEBUG $FILECAT);
  59
  60 $DEBUG = 1;
  61
  62 # po dir is for extensions
  63 @ARGV = (<lib/RT/I18N/*.po>, <lib/RT/I18N/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV;
  64
  65 $FILECAT = {};
  66
  67 # extract all strings and stuff them into $FILECAT
  68 # scan html dir for extensions
  69 File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, qw(bin sbin lib share html etc) );
  70
  71 # remove msgid with $ in it.  XXX: perhaps give some warnings here
  72 $FILECAT = { map { $_ => $FILECAT->{$_} } grep { !m/\$/ } keys %$FILECAT };
  73
  74 # ensure proper escaping and [_1] => %1 transformation
  75 foreach my $str ( sort keys %{$FILECAT} ) {
  76     my $entry = $FILECAT->{$str};
  77     my $oldstr = $str;
  78
  79     $str =~ s/\\/\\\\/g;
  80     $str =~ s/\"/\\"/g;
  81     $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
  82     $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
  83     $str =~ s/~([\[\]])/$1/g;
  84
  85     delete $FILECAT->{$oldstr};
  86     $FILECAT->{$str} = $entry;
  87 }
  88
  89 # update all language dictionaries
  90 foreach my $dict (@ARGV) {
  91     $dict = "lib/RT/I18N/$dict.pot" if ( $dict eq 'rt' );
  92     $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
  93
  94     my $lang = $dict;
  95     $lang =~ s|.*/||;
  96     $lang =~ s|\.po$||;
  97     $lang =~ s|\.pot$||;
  98
  99     update($lang, $dict);
 100 }
 101
 102
 103 # {{{ pull strings out of the code.
 104
 105 sub extract_strings_from_code {
 106     my $file = $_;
 107
 108     local $/;
 109     return if ( -d $_ );
 110     return
 111       if ( $File::Find::dir =~
 112         qr!lib/blib|lib/t/autogen|var|m4|local|share/fonts! );
 113     return if ( /\.(?:pot|po|bak|gif|png|psd|jpe?g|svg|css|js)$/ );
 114     return if ( /~|,D|,B$|extract-message-catalog$|tweak-template-locstring$/ );
 115     return if ( /^[\.#]/ );
 116     return if ( -f "$_.in" );
 117
 118     print "Looking at $File::Find::name\n";
 119     my $filename = $File::Find::name;
 120     $filename =~ s'^\./'';
 121     $filename =~ s'\.in$'';
 122
 123     unless (open _, $file) {
 124         print "Cannot open $file for reading ($!), skipping.\n";
 125         return;
 126     }
 127
 128     my $re_space_wo_nl = qr{(?!\n)\s};
 129     my $re_loc_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc $re_space_wo_nl* $}mx;
 130     my $re_loc_qw_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_qw $re_space_wo_nl* $}mx;
 131     my $re_loc_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_pair $re_space_wo_nl* $}mx;
 132     my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}mx;
 133     my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
 134
 135     $_ = <_>;
 136
 137     # Mason filter: <&|/l>...</&>
 138     my $line = 1;
 139     while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
 140         my ( $vars, $str ) = ( $1, $2 );
 141         $vars =~ s/[\n\r]//g;
 142         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 143         $str =~ s/\\'/\'/g;
 144         #print "STR IS $str\n";
 145         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 146     }
 147
 148     # Localization function: loc(...)
 149     $line = 1;
 150     pos($_) = 0;
 151     while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
 152         my $match = $1;
 153         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 154
 155         my ( $vars, $str );
 156         if ( $match =~
 157                 /\(\s*($re_delim)(.*?)\s*\)$/so ) {
 158
 159             $str = substr( $1, 1, -1 );       # $str comes before $vars now
 160             $vars = $9;
 161         }
 162         else {
 163             next;
 164         }
 165
 166         $vars =~ s/[\n\r]//g;
 167         $str  =~ s/\\'/\'/g;
 168
 169         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 170     }
 171
 172     # Comment-based mark: "..." # loc
 173     $line = 1;
 174     pos($_) = 0;
 175     while (m/\G.*?($re_delim)[\}\)\],;]*$re_loc_suffix/smgo) {
 176         my $str = $1;
 177         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 178         unless ( defined $str ) {
 179             warn "Couldn't process loc at $filename:$line";
 180             next;
 181         }
 182         $str = substr($str, 1, -1);
 183         $str =~ s/\\'/\'/g;
 184         push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
 185     }
 186
 187     # Comment-based qw mark: "qw(...)" # loc_qw
 188     $line = 1;
 189     pos($_) = 0;
 190     while (m/\G.*?(?:(qw\([^)]+\))[\}\)\],;]*)?$re_loc_qw_suffix/smgo) {
 191         my $str = $1;
 192         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 193         unless ( defined $str ) {
 194             warn "Couldn't process loc_qw at $filename:$line";
 195             next;
 196         }
 197         foreach my $value (eval($str)) {
 198             push @{ $FILECAT->{$value} }, [ $filename, $line, '' ];
 199         }
 200     }
 201
 202     # Comment-based left pair mark: "..." => ... # loc_left_pair
 203     $line = 1;
 204     pos($_) = 0;
 205     while (m/\G.*?(?:(\w+)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix/smgo) {
 206         my $key = $1;
 207         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 208         unless ( defined $key ) {
 209             warn "Couldn't process loc_left_pair at $filename:$line";
 210             next;
 211         }
 212         $key  =~ s/\\'/\'/g;
 213         push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
 214     }
 215
 216     # Comment-based pair mark: "..." => "..." # loc_pair
 217     $line = 1;
 218     pos($_) = 0;
 219     while (m/\G.*?(?:(\w+)\s*=>\s*($re_delim)[\}\)\],;]*)?$re_loc_pair_suffix/smgo) {
 220         my $key = $1;
 221         my $val = $2;
 222         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 223         unless ( defined $key && defined $val ) {
 224             warn "Couldn't process loc_pair at $filename:$line";
 225             next;
 226         }
 227         $val = substr($val, 1, -1);
 228         $key  =~ s/\\'/\'/g;
 229         $val  =~ s/\\'/\'/g;
 230         push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
 231         push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
 232     }
 233
 234     close (_);
 235 }
 236 # }}} extract from strings
 237
 238 sub update {
 239     my $lang = shift;
 240     my $file = shift;
 241     my ( %Lexicon, %Header);
 242     my $out = '';
 243
 244     unless (!-e $file or -w $file) {
 245         warn "Can't write to $lang, skipping...\n";
 246         return;
 247     }
 248
 249     print "Updating $lang...\n";
 250
 251     my @lines;
 252     @lines = (<LEXICON>) if open (LEXICON, $file);
 253     @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
 254     while (@lines) {
 255         my $msghdr = "";
 256         $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^(#~ )?msgid/ );
 257
 258         my $msgid  = "";
 259
 260 # '#~ ' is the prefix of launchpad for msg that's not found the the source
 261 # we'll remove the prefix later so we can still show them with our own mark
 262
 263         $msgid .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgid|")/ );
 264         my $msgstr = "";
 265         $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgstr|")/ );
 266
 267         last unless $msgid;
 268
 269         chomp $msgid;
 270         chomp $msgstr;
 271
 272         $msgid  =~ s/^#~ //mg;
 273         $msgstr =~ s/^#~ //mg;
 274
 275         $msgid  =~ s/^msgid "(.*)"\s*?$/$1/m    or warn "$msgid in $file";
 276
 277         if ( $msgid eq '' ) {
 278             # null msgid, msgstr will have head info
 279             $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr  in $file";
 280         }
 281         else {
 282             $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/m or warn "$msgstr  in $file";
 283         }
 284
 285         if ( $msgid ne ''  ) {
 286             for my $msg ( \$msgid, \$msgstr ) {
 287                 if ( $$msg =~ /\n/ ) {
 288                     my @lines = split /\n/, $$msg;
 289                     $$msg =
 290                       shift @lines;   # first line don't need to handle any more
 291                     for (@lines) {
 292                         if (/^"(.*)"\s*$/) {
 293                             $$msg .= $1;
 294                         }
 295                     }
 296                 }
 297
 298                 # convert \\n back to \n
 299                 $$msg =~ s/(?!\\)\\n/\n/g;
 300             }
 301         }
 302
 303         $Lexicon{$msgid} = $msgstr;
 304         $Header{$msgid}  = $msghdr;
 305     }
 306
 307     my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
 308
 309     foreach my $str ( sort keys %{$FILECAT} ) {
 310         $Lexicon{$str} ||= '';
 311     }
 312     foreach ( sort keys %Lexicon ) {
 313         my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
 314         my $nospace = $_;
 315         $nospace =~ s/ +$//;
 316
 317         if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
 318             $Lexicon{$_} =
 319               $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
 320         }
 321
 322         next if !length( $Lexicon{$_} ) and $is_english;
 323
 324         my %seen;
 325         $out .= $Header{$_} if exists $Header{$_};
 326
 327
 328
 329         next if (!$f && $_ && !$Lexicon{$_});
 330         if ( $f && $f !~ /^\s+$/ ) {
 331
 332             $out .= "#: $f\n";
 333         }
 334         elsif ($_) {
 335             $out .= "#: NOT FOUND IN SOURCE\n";
 336         }
 337         foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
 338             my ( $file, $line, $var ) = @{$entry};
 339             $var =~ s/^\s*,\s*//;
 340             $var =~ s/\s*$//;
 341             $out .= "#. ($var)\n" unless $seen{$var}++;
 342         }
 343         $out .= 'msgid ' . fmt($_) . "msgstr \"$Lexicon{$_}\"\n\n";
 344     }
 345
 346     open PO, ">$file" or die "Couldn't open '$file' for writing: $!";
 347     print PO $out;
 348     close PO;
 349
 350     return 1;
 351 }
 352
 353 sub escape {
 354     my $text = shift;
 355     $text =~ s/\b_(\d+)/%$1/;
 356     return $text;
 357 }
 358
 359 sub fmt {
 360     my $str = shift;
 361     return "\"$str\"\n" unless $str =~ /\n/;
 362
 363     my $multi_line = ($str =~ /\n(?!\z)/);
 364     $str =~ s/\n/\\n"\n"/g;
 365
 366     if ($str =~ /\n"$/) {
 367         chop $str;
 368     }
 369     else {
 370         $str .= "\"\n";
 371     }
 372     return $multi_line ? qq(""\n"$str) : qq("$str);
 373 }
 374
 375
 376 __END__
 377 # Local variables:
 378 # c-indentation-style: bsd
 379 # c-basic-offset: 4
 380 # indent-tabs-mode: nil
 381 # End:
 382 # vim: expandtab shiftwidth=4: