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-2007 Best Practical Solutions, LLC
   7 #                                          <jesse@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/copyleft/gpl.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 @ARGV = <lib/RT/I18N/*.po> unless @ARGV;
  63
  64 $FILECAT = {};
  65
  66 # extract all strings and stuff them into $FILECAT
  67 File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, '.' );
  68
  69 # ensure proper escaping and [_1] => %1 transformation
  70 foreach my $str ( sort keys %{$FILECAT} ) {
  71     my $entry = $FILECAT->{$str};
  72     my $oldstr = $str;
  73
  74     $str =~ s/\\/\\\\/g;
  75     $str =~ s/\"/\\"/g;
  76     $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
  77     $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
  78     $str =~ s/~([\[\]])/$1/g;
  79
  80     delete $FILECAT->{$oldstr};
  81     $FILECAT->{$str} = $entry;
  82 }
  83
  84 # update all language dictionaries
  85 foreach my $dict (@ARGV) {
  86     $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
  87
  88     my $lang = $dict;
  89     $lang =~ s|.*/||;
  90     $lang =~ s|\.po$||;
  91
  92     update($lang, $dict);
  93 }
  94
  95
  96 # {{{ pull strings out of the code.
  97
  98 sub extract_strings_from_code {
  99     my $file = $_;
 100
 101     local $/;
 102     return if ( -d $_ );
 103     return if ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local|\.svn' );
 104     return if ( /\.po$|\.bak$|~|,D|,B$|extract-message-catalog$/ );
 105     return if ( /^[\.#]/ );
 106     return if ( -f "$_.in" );
 107
 108     print "Looking at $File::Find::name\n";
 109     my $filename = $File::Find::name;
 110     $filename =~ s'^\./'';
 111     $filename =~ s'\.in$'';
 112
 113     unless (open _, $file) {
 114         print "Cannot open $file for reading ($!), skipping.\n";
 115         return;
 116     }
 117
 118     $_ = <_>;
 119
 120     # Mason filter: <&|/l>...</&>
 121     my $line = 1;
 122     while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
 123         my ( $vars, $str ) = ( $1, $2 );
 124         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 125         $str =~ s/\\'/\'/g;
 126         #print "STR IS $str\n";
 127         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 128     }
 129
 130     # Localization function: loc(...)
 131     $line = 1;
 132     pos($_) = 0;
 133     while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
 134         my $match = $1;
 135         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 136
 137         my ( $vars, $str );
 138         if ( $match =~
 139                 /\(\s*($RE{delimited}{-delim=>q{'"}}{-keep})(.*?)\s*\)$/ ) {
 140
 141             $str = substr( $1, 1, -1 );       # $str comes before $vars now
 142             $vars = $9;
 143         }
 144         else {
 145             next;
 146         }
 147
 148         $vars =~ s/[\n\r]//g;
 149         $str  =~ s/\\'/\'/g;
 150
 151         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 152     }
 153
 154     # Comment-based mark: "..." # loc
 155     $line = 1;
 156     pos($_) = 0;
 157     while (m/\G.*?($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc\s*$/smg) {
 158         my $str = substr($1, 1, -1);
 159         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 160         $str  =~ s/\\'/\'/g;
 161         push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
 162     }
 163
 164     # Comment-based pair mark: "..." => "..." # loc_pair
 165     $line = 1;
 166     pos($_) = 0;
 167     while (m/\G.*?(\w+)\s*=>\s*($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc_pair\s*$/smg) {
 168         my $key = $1;
 169         my $val = substr($2, 1, -1);
 170         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 171         $key  =~ s/\\'/\'/g;
 172         $val  =~ s/\\'/\'/g;
 173         push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
 174         push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
 175     }
 176
 177     close (_);
 178 }
 179 # }}} extract from strings
 180
 181 sub update {
 182     my $lang = shift;
 183     my $file = shift;
 184     my ( %Lexicon, %Header);
 185     my $out = '';
 186
 187     unless (!-e $file or -w $file) {
 188         warn "Can't write to $lang, skipping...\n";
 189         return;
 190     }
 191
 192     print "Updating $lang...\n";
 193
 194     my @lines;
 195     @lines = (<LEXICON>) if open (LEXICON, $file);
 196     @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
 197     while (@lines) {
 198         my $msghdr = "";
 199         $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^msgid/ );
 200
 201         my $msgid  = shift @lines;
 202         my $msgstr = "";
 203         $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(msgstr|")/ );
 204
 205         last unless $msgid;
 206
 207         chomp $msgid;
 208         chomp $msgstr;
 209         $msgid  =~ s/^msgid "(.*)"\s*?$/$1/ms    or warn "$msgid in $file";
 210         $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr  in $file";
 211
 212         $Lexicon{$msgid} = $msgstr;
 213         $Header{$msgid}  = $msghdr;
 214     }
 215
 216     my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
 217
 218     foreach my $str ( sort keys %{$FILECAT} ) {
 219         $Lexicon{$str} ||= '';;
 220     }
 221     foreach ( sort keys %Lexicon ) {
 222         my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
 223         my $nospace = $_;
 224         $nospace =~ s/ +$//;
 225
 226         if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
 227             $Lexicon{$_} =
 228               $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
 229         }
 230
 231         next if !length( $Lexicon{$_} ) and $is_english;
 232
 233         my %seen;
 234         $out .= $Header{$_} if exists $Header{$_};
 235
 236
 237
 238         next if (!$f && $_ && !$Lexicon{$_});
 239         if ( $f && $f !~ /^\s+$/ ) {
 240
 241             $out .= "#: $f\n";
 242         }
 243         elsif ($_) {
 244             $out .= "#: NOT FOUND IN SOURCE\n";
 245         }
 246         foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
 247             my ( $file, $line, $var ) = @{$entry};
 248             $var =~ s/^\s*,\s*//;
 249             $var =~ s/\s*$//;
 250             $out .= "#. ($var)\n" unless $seen{$var}++;
 251         }
 252         $out .= "msgid \"$_\"\nmsgstr \"$Lexicon{$_}\"\n\n";
 253     }
 254
 255     open PO, ">$file" or die $!;
 256     print PO $out;
 257     close PO;
 258
 259     return 1;
 260 }
 261
 262 sub escape {
 263     my $text = shift;
 264     $text =~ s/\b_(\d+)/%$1/;
 265     return $text;
 266 }
 267
 268 __END__
 269 # Local variables:
 270 # c-indentation-style: bsd
 271 # c-basic-offset: 4
 272 # indent-tabs-mode: nil
 273 # End:
 274 # vim: expandtab shiftwidth=4: