#!/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: