rt/sbin/extract-message-catalog

   1 #!/usr/bin/perl -w
   2 # BEGIN LICENSE BLOCK
   3 #
   4 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   5 #
   6 # (Except where explictly superceded by other copyright notices)
   7 #
   8 # This work is made available to you under the terms of Version 2 of
   9 # the GNU General Public License. A copy of that license should have
  10 # been provided with this software, but in any event can be snarfed
  11 # from www.gnu.org.
  12 #
  13 # This work is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # Unless otherwise specified, all modifications, corrections or
  19 # extensions to this work which alter its source code become the
  20 # property of Best Practical Solutions, LLC when submitted for
  21 # inclusion in the work.
  22 #
  23 #
  24 # END LICENSE BLOCK
  25
  26 # Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org>
  27
  28 use strict;
  29
  30 use File::Find;
  31 use File::Copy;
  32 use Regexp::Common;
  33 use Carp;
  34
  35 use vars qw($DEBUG $FILECAT);
  36
  37 $DEBUG = 1;
  38
  39 @ARGV = <lib/RT/I18N/*.po> unless @ARGV;
  40
  41 $FILECAT = {};
  42
  43 # extract all strings and stuff them into $FILECAT
  44 File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, '.' );
  45
  46 # ensure proper escaping and [_1] => %1 transformation
  47 foreach my $str ( sort keys %{$FILECAT} ) {
  48     my $entry = $FILECAT->{$str};
  49     my $oldstr = $str;
  50
  51     $str =~ s/\\/\\\\/g;
  52     $str =~ s/\"/\\"/g;
  53     $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
  54     $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
  55     $str =~ s/~([\[\]])/$1/g;
  56
  57     delete $FILECAT->{$oldstr};
  58     $FILECAT->{$str} = $entry;
  59 }
  60
  61 # update all language dictionaries
  62 foreach my $dict (@ARGV) {
  63     $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
  64
  65     my $lang = $dict;
  66     $lang =~ s|.*/||;
  67     $lang =~ s|\.po$||;
  68
  69     update($lang, $dict);
  70 }
  71
  72
  73 # {{{ pull strings out of the code.
  74
  75 sub extract_strings_from_code {
  76     my $file = $_;
  77
  78     local $/;
  79     return if ( -d $_ );
  80     return if ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local' );
  81     return if ( /\.po$|\.bak$|~|,D|,B$|extract-message-catalog$/ );
  82     return if ( /^[\.#]/ );
  83     return if ( -f "$_.in" );
  84
  85     print "Looking at $File::Find::name\n";
  86     my $filename = $File::Find::name;
  87     $filename =~ s'^\./'';
  88     $filename =~ s'\.in$'';
  89
  90     unless (open _, $file) {
  91         print "Cannot open $file for reading ($!), skipping.\n";
  92         return;
  93     }
  94
  95     $_ = <_>;
  96
  97     # Mason filter: <&|/l>...</&>
  98     my $line = 1;
  99     while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
 100         my ( $vars, $str ) = ( $1, $2 );
 101         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 102         $str =~ s/\\'/\'/g;
 103         #print "STR IS $str\n";
 104         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 105     }
 106
 107     # Localization function: loc(...)
 108     $line = 1;
 109     pos($_) = 0;
 110     while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
 111         my $match = $1;
 112         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 113
 114         my ( $vars, $str );
 115         if ( $match =~
 116                 /\(\s*($RE{delimited}{-delim=>q{'"}}{-keep})(.*?)\s*\)$/ ) {
 117
 118             $str = substr( $1, 1, -1 );       # $str comes before $vars now
 119             $vars = $9;
 120         }
 121         else {
 122             next;
 123         }
 124
 125         $vars =~ s/[\n\r]//g;
 126         $str  =~ s/\\'/\'/g;
 127
 128         push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
 129     }
 130
 131     # Comment-based mark: "..." # loc
 132     $line = 1;
 133     pos($_) = 0;
 134     while (m/\G.*?($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc\s*$/smg) {
 135         my $str = substr($1, 1, -1);
 136         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 137         $str  =~ s/\\'/\'/g;
 138         push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
 139     }
 140
 141     # Comment-based pair mark: "..." => "..." # loc_pair
 142     $line = 1;
 143     pos($_) = 0;
 144     while (m/\G.*?(\w+)\s*=>\s*($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc_pair\s*$/smg) {
 145         my $key = $1;
 146         my $val = substr($2, 1, -1);
 147         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
 148         $key  =~ s/\\'/\'/g;
 149         $val  =~ s/\\'/\'/g;
 150         push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
 151         push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
 152     }
 153
 154     close (_);
 155 }
 156 # }}} extract from strings
 157
 158 sub update {
 159     my $lang = shift;
 160     my $file = shift;
 161     my ( %Lexicon, %Header);
 162     my $out = '';
 163
 164     unless (!-e $file or -w $file) {
 165         warn "Can't write to $lang, skipping...\n";
 166         return;
 167     }
 168
 169     print "Updating $lang...\n";
 170
 171     my @lines;
 172     @lines = (<LEXICON>) if open (LEXICON, $file);
 173     @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
 174     while (@lines) {
 175         my $msghdr = "";
 176         $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^msgid/ );
 177         my $msgid  = shift @lines;
 178         my $msgstr = "";
 179         $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(msgstr|")/ );
 180
 181         last unless $msgid;
 182
 183         chomp $msgid;
 184         chomp $msgstr;
 185         $msgid  =~ s/^msgid "(.*)"$/$1/    or warn $msgid;
 186         $msgstr =~ s/^msgstr "(.*)"$/$1/ms or warn $msgstr;
 187
 188         $Lexicon{$msgid} = $msgstr;
 189         $Header{$msgid}  = $msghdr;
 190     }
 191
 192     my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
 193
 194     foreach my $str ( sort keys %{$FILECAT} ) {
 195         $Lexicon{$str} ||= '';;
 196     }
 197     foreach ( sort keys %Lexicon ) {
 198         my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
 199         my $nospace = $_;
 200         $nospace =~ s/ +$//;
 201
 202         if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
 203             $Lexicon{$_} =
 204               $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
 205         }
 206
 207         next if !length( $Lexicon{$_} ) and $is_english;
 208
 209         my %seen;
 210         $out .= $Header{$_} if exists $Header{$_};
 211         if ( $f && $f !~ /^\s+$/ ) {
 212
 213             $out .= "#: $f\n";
 214         }
 215         elsif ($_) {
 216             $out .= "#: NOT FOUND IN SOURCE\n";
 217         }
 218         foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
 219             my ( $file, $line, $var ) = @{$entry};
 220             $var =~ s/^\s*,\s*//;
 221             $var =~ s/\s*$//;
 222             $out .= "#. ($var)\n" unless $seen{$var}++;
 223         }
 224         $out .= "msgid \"$_\"\nmsgstr \"$Lexicon{$_}\"\n\n";
 225     }
 226
 227     open PO, ">$file" or die $!;
 228     print PO $out;
 229     close PO;
 230
 231     return 1;
 232 }
 233
 234 sub escape {
 235     my $text = shift;
 236     $text =~ s/\b_(\d+)/%$1/;
 237     return $text;
 238 }
 239
 240 __END__
 241 # Local variables:
 242 # c-indentation-style: bsd
 243 # c-basic-offset: 4
 244 # indent-tabs-mode: nil
 245 # End:
 246 # vim: expandtab shiftwidth=4: