import of rt 3.0.4
[freeside.git] / rt / sbin / extract-message-catalog
diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog
new file mode 100644 (file)
index 0000000..af7b2c7
--- /dev/null
@@ -0,0 +1,246 @@
+#!/usr/bin/perl -w 
+# BEGIN LICENSE BLOCK
+# 
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# 
+# (Except where explictly superceded by other copyright notices)
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+# 
+# 
+# END LICENSE BLOCK
+
+# Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org>
+
+use strict;
+
+use File::Find;
+use File::Copy;
+use Regexp::Common;
+use Carp;
+
+use vars qw($DEBUG $FILECAT);
+
+$DEBUG = 1;
+
+@ARGV = <lib/RT/I18N/*.po> unless @ARGV;
+
+$FILECAT = {};
+
+# extract all strings and stuff them into $FILECAT
+File::Find::find( { wanted => \&extract_strings_from_code, follow => 0 }, '.' );
+
+# ensure proper escaping and [_1] => %1 transformation
+foreach my $str ( sort keys %{$FILECAT} ) {
+    my $entry = $FILECAT->{$str};
+    my $oldstr = $str;
+
+    $str =~ s/\\/\\\\/g;
+    $str =~ s/\"/\\"/g;
+    $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
+    $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
+    $str =~ s/~([\[\]])/$1/g;
+
+    delete $FILECAT->{$oldstr};
+    $FILECAT->{$str} = $entry;
+}
+
+# update all language dictionaries
+foreach my $dict (@ARGV) {
+    $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
+
+    my $lang = $dict;
+    $lang =~ s|.*/||;
+    $lang =~ s|\.po$||;
+
+    update($lang, $dict);
+}
+
+
+# {{{ pull strings out of the code.
+
+sub extract_strings_from_code {
+    my $file = $_;
+
+    local $/;
+    return if ( -d $_ );
+    return if ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local' );
+    return if ( /\.po$|\.bak$|~|,D|,B$|extract-message-catalog$/ );
+    return if ( /^[\.#]/ );
+    return if ( -f "$_.in" );
+
+    print "Looking at $File::Find::name\n";
+    my $filename = $File::Find::name;
+    $filename =~ s'^\./'';
+    $filename =~ s'\.in$'';
+
+    unless (open _, $file) {
+        print "Cannot open $file for reading ($!), skipping.\n";
+        return;
+    }
+
+    $_ = <_>;
+
+    # Mason filter: <&|/l>...</&>
+    my $line = 1;
+    while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
+        my ( $vars, $str ) = ( $1, $2 );
+        $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
+        $str =~ s/\\'/\'/g;
+        #print "STR IS $str\n";
+        push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
+    }
+
+    # Localization function: loc(...)
+    $line = 1;
+    pos($_) = 0;
+    while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
+        my $match = $1;
+        $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
+
+        my ( $vars, $str );
+        if ( $match =~
+                /\(\s*($RE{delimited}{-delim=>q{'"}}{-keep})(.*?)\s*\)$/ ) {
+
+            $str = substr( $1, 1, -1 );       # $str comes before $vars now
+            $vars = $9;
+        }
+        else {
+            next;
+        }
+
+        $vars =~ s/[\n\r]//g;
+        $str  =~ s/\\'/\'/g;
+
+        push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
+    }
+
+    # Comment-based mark: "..." # loc
+    $line = 1;
+    pos($_) = 0;
+    while (m/\G.*?($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc\s*$/smg) {
+       my $str = substr($1, 1, -1);
+       $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
+       $str  =~ s/\\'/\'/g;
+       push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
+    }
+
+    # Comment-based pair mark: "..." => "..." # loc_pair
+    $line = 1;
+    pos($_) = 0;
+    while (m/\G.*?(\w+)\s*=>\s*($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc_pair\s*$/smg) {
+       my $key = $1;
+       my $val = substr($2, 1, -1);
+       $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
+       $key  =~ s/\\'/\'/g;
+       $val  =~ s/\\'/\'/g;
+       push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
+       push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
+    }
+
+    close (_);
+}
+# }}} extract from strings
+
+sub update {
+    my $lang = shift;
+    my $file = shift;
+    my ( %Lexicon, %Header);
+    my $out = '';
+
+    unless (!-e $file or -w $file) {
+       warn "Can't write to $lang, skipping...\n";
+       return;
+    }
+
+    print "Updating $lang...\n";
+
+    my @lines;
+    @lines = (<LEXICON>) if open (LEXICON, $file);
+    @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
+    while (@lines) {
+        my $msghdr = "";
+        $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^msgid/ );
+        my $msgid  = shift @lines;
+        my $msgstr = "";
+        $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(msgstr|")/ );
+
+        last unless $msgid;
+
+        chomp $msgid;
+        chomp $msgstr;
+        $msgid  =~ s/^msgid "(.*)"$/$1/    or warn $msgid;
+        $msgstr =~ s/^msgstr "(.*)"$/$1/ms or warn $msgstr;
+
+        $Lexicon{$msgid} = $msgstr;
+        $Header{$msgid}  = $msghdr;
+    }
+
+    my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
+
+    foreach my $str ( sort keys %{$FILECAT} ) {
+        $Lexicon{$str} ||= '';;
+    }
+    foreach ( sort keys %Lexicon ) {
+        my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
+        my $nospace = $_;
+        $nospace =~ s/ +$//;
+
+        if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
+            $Lexicon{$_} =
+              $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
+        }
+
+        next if !length( $Lexicon{$_} ) and $is_english;
+
+        my %seen;
+        $out .= $Header{$_} if exists $Header{$_};
+        if ( $f && $f !~ /^\s+$/ ) {
+
+            $out .= "#: $f\n";
+        }
+        elsif ($_) {
+            $out .= "#: NOT FOUND IN SOURCE\n";
+        }
+        foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
+            my ( $file, $line, $var ) = @{$entry};
+            $var =~ s/^\s*,\s*//;
+            $var =~ s/\s*$//;
+            $out .= "#. ($var)\n" unless $seen{$var}++;
+        }
+        $out .= "msgid \"$_\"\nmsgstr \"$Lexicon{$_}\"\n\n";
+    }
+
+    open PO, ">$file" or die $!;
+    print PO $out;
+    close PO;
+
+    return 1;
+}
+
+sub escape {
+    my $text = shift;
+    $text =~ s/\b_(\d+)/%$1/;
+    return $text;
+}
+
+__END__
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4: