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-2005 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., 675 Mass Ave, Cambridge, MA 02139, USA.
  27 #
  28 #
  29 # CONTRIBUTION SUBMISSION POLICY:
  30 #
  31 # (The following paragraph is not intended to limit the rights granted
  32 # to you to modify and distribute this software under the terms of
  33 # the GNU General Public License and is only of importance to you if
  34 # you choose to contribute your changes and enhancements to the
  35 # community by submitting them to Best Practical Solutions, LLC.)
  36 #
  37 # By intentionally submitting any modifications, corrections or
  38 # derivatives to this work, or any other work intended for use with
  39 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  40 # you are the copyright holder for those contributions and you grant
  41 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  42 # royalty-free, perpetual, license to use, copy, create derivative
  43 # works based on those contributions, and sublicense and distribute
  44 # those contributions and any derivatives thereof.
  45 #
  46 # END BPS TAGGED BLOCK }}}
  47 # Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org>
  48
  49 use strict;
  50
  51 use File::Find;
  52 use File::Copy;
  53 use Regexp::Common;
  54 use Carp;
  55
  56 use vars qw($DEBUG $FILECAT);
  57
  58 $DEBUG = 1;
  59
  60 @ARGV = <lib/RT/I18N/*.po> unless @ARGV;
  61
  62 $FILECAT = {};
  63
  64 # extract all strings and stuff them into $FILECAT
  65 File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, '.' );
  66
  67 # ensure proper escaping and [_1] => %1 transformation
  68 foreach my $str ( sort keys %{$FILECAT} ) {
  69     my $entry = $FILECAT->{$str};
  70     my $oldstr = $str;
  71
  72     $str =~ s/\\/\\\\/g;
  73     $str =~ s/\"/\\"/g;
  74     $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
  75     $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
  76     $str =~ s/~([\[\]])/$1/g;
  77
  78     delete $FILECAT->{$oldstr};
  79     $FILECAT->{$str} = $entry;
  80 }
  81
  82 # update all language dictionaries
  83 foreach my $dict (@ARGV) {
  84     $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
  85
  86     my $lang = $dict;
  87     $lang =~ s|.*/||;
  88     $lang =~ s|\.po$||;
  89
  90     update($lang, $dict);
  91 }
  92
  93
  94 # {{{ pull strings out of the code.
  95
  96 sub extract_strings_from_code {
  97     my $file = $_;
  98
  99     local $/;
 100     return if ( -d $_ );
 101     return if ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local|\.svn' );
 102     return if ( /\.po$|\.bak$|~|,D|,B$|extract-message-catalog$/ );
 103     return if ( /^[\.#]/ );
 104     return if ( -f "$_.in" );
 105
 106     print "Looking at $File::Find::name\n";
 107     my $filename = $File::Find::name;
 108     $filename =~ s'^\./'';
 109     $filename =~ s'\.in$'';
 110
 111     unless (open _, $file) {
 112         print "Cannot open $file for reading ($!), skipping.\n";
 113         return;
 114     }
 115
 116     $_ = <_>;
 117
 118     # Mason filter: <&|/l>...</&>
 119     my $line = 1;
 120     while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
 121         my ( $vars, $str ) = ( $1, $2 );
 122         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 123         $str =~ s/\\'/\'/g;
 124         #print "STR IS $str\n";
 125         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 126     }
 127
 128     # Localization function: loc(...)
 129     $line = 1;
 130     pos($_) = 0;
 131     while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
 132         my $match = $1;
 133         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 134
 135         my ( $vars, $str );
 136         if ( $match =~
 137                 /\(\s*($RE{delimited}{-delim=>q{'"}}{-keep})(.*?)\s*\)$/ ) {
 138
 139             $str = substr( $1, 1, -1 );       # $str comes before $vars now
 140             $vars = $9;
 141         }
 142         else {
 143             next;
 144         }
 145
 146         $vars =~ s/[\n\r]//g;
 147         $str  =~ s/\\'/\'/g;
 148
 149         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 150     }
 151
 152     # Comment-based mark: "..." # loc
 153     $line = 1;
 154     pos($_) = 0;
 155     while (m/\G.*?($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc\s*$/smg) {
 156         my $str = substr($1, 1, -1);
 157         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 158         $str  =~ s/\\'/\'/g;
 159         push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
 160     }
 161
 162     # Comment-based pair mark: "..." => "..." # loc_pair
 163     $line = 1;
 164     pos($_) = 0;
 165     while (m/\G.*?(\w+)\s*=>\s*($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc_pair\s*$/smg) {
 166         my $key = $1;
 167         my $val = substr($2, 1, -1);
 168         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 169         $key  =~ s/\\'/\'/g;
 170         $val  =~ s/\\'/\'/g;
 171         push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
 172         push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
 173     }
 174
 175     close (_);
 176 }
 177 # }}} extract from strings
 178
 179 sub update {
 180     my $lang = shift;
 181     my $file = shift;
 182     my ( %Lexicon, %Header);
 183     my $out = '';
 184
 185     unless (!-e $file or -w $file) {
 186         warn "Can't write to $lang, skipping...\n";
 187         return;
 188     }
 189
 190     print "Updating $lang...\n";
 191
 192     my @lines;
 193     @lines = (<LEXICON>) if open (LEXICON, $file);
 194     @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
 195     while (@lines) {
 196         my $msghdr = "";
 197         $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^msgid/ );
 198
 199         my $msgid  = shift @lines;
 200         my $msgstr = "";
 201         $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(msgstr|")/ );
 202
 203         last unless $msgid;
 204
 205         chomp $msgid;
 206         chomp $msgstr;
 207         $msgid  =~ s/^msgid "(.*)"\s*?$/$1/ms    or warn "$msgid in $file";
 208         $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr  in $file";
 209
 210         $Lexicon{$msgid} = $msgstr;
 211         $Header{$msgid}  = $msghdr;
 212     }
 213
 214     my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
 215
 216     foreach my $str ( sort keys %{$FILECAT} ) {
 217         $Lexicon{$str} ||= '';;
 218     }
 219     foreach ( sort keys %Lexicon ) {
 220         my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
 221         my $nospace = $_;
 222         $nospace =~ s/ +$//;
 223
 224         if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
 225             $Lexicon{$_} =
 226               $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
 227         }
 228
 229         next if !length( $Lexicon{$_} ) and $is_english;
 230
 231         my %seen;
 232         $out .= $Header{$_} if exists $Header{$_};
 233
 234
 235
 236         next if (!$f && $_ && !$Lexicon{$_});
 237         if ( $f && $f !~ /^\s+$/ ) {
 238
 239             $out .= "#: $f\n";
 240         }
 241         elsif ($_) {
 242             $out .= "#: NOT FOUND IN SOURCE\n";
 243         }
 244         foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
 245             my ( $file, $line, $var ) = @{$entry};
 246             $var =~ s/^\s*,\s*//;
 247             $var =~ s/\s*$//;
 248             $out .= "#. ($var)\n" unless $seen{$var}++;
 249         }
 250         $out .= "msgid \"$_\"\nmsgstr \"$Lexicon{$_}\"\n\n";
 251     }
 252
 253     open PO, ">$file" or die $!;
 254     print PO $out;
 255     close PO;
 256
 257     return 1;
 258 }
 259
 260 sub escape {
 261     my $text = shift;
 262     $text =~ s/\b_(\d+)/%$1/;
 263     return $text;
 264 }
 265
 266 __END__
 267 # Local variables:
 268 # c-indentation-style: bsd
 269 # c-basic-offset: 4
 270 # indent-tabs-mode: nil
 271 # End:
 272 # vim: expandtab shiftwidth=4: