#!/usr/bin/perl

use strict;
use utf8;
use Getopt::Long;
use Data::Dumper;
use Locale::PO;
use Locale::Memories;

our $VERSION = $Locale::Memories::VERSION;

my $locale_pattern = qr{[a-z][a-z](?:_[a-z][a-z][a-z]?)?};

sub load_po_data {
    my $path = shift;
    my @files;
    if (-d $path) {
	@files = (grep { m{\A.+[^a-z]${locale_pattern}\.po\z}i }
		  glob($path . '/*.po'));
    }
    elsif (-f $path) {
	@files = ($path);
    }
    else {
	die "Cannot recognize file type";
    }

    my %msg;
    for my $file (@files) {
	print $file, $/;
	$file =~ m{\A.+[^a-z](${locale_pattern})\.po\z};
	die "$file is not a recognized name" if !$1;
	my $locale = lc $1;
	my $aref = Locale::PO->load_file_asarray($file);
	if (@{$aref}) {
	    @{$aref} = grep { $_->{msgid} ne q[""] } @{$aref};
	    unshift @{$aref},
		Locale::PO->new(-msgid => '',
				-msgstr =>
				join q//, map { "$_\\n" }
				"Project-Id-Version: blah",
				"Report-Msgid-Bugs-To: http://blahblah",
				"POT-Creation-Date: xxxx-xx-xx xx:xx+xxxx",
				"PO-Revision-Date: xxxx-xx-xx xx:xx+xxxx",
				"Last-Translator: Your name <blah\@blah.com>",
				"Language-Team: ",
				"MIME-Version: 1.0",
				"Content-Type: text/plain; charset=UTF-8",
				"Content-Transfer-Encoding: 8bit");
	    for my $m (@{$aref}) {
		push @{$msg{$locale}}, $m;
	    }
	}
    }
    return %msg;
}

sub build_memories {
    my ($lm, @memory_dirs) = @_;
    for my $k (@memory_dirs) {
	if (!-d $k) {
	    warn "$k is not a directory";
	    next;
	}
	my %msg = load_po_data($k);
	local $Data::Dumper::Terse = 1;
	local $Data::Dumper::Indent = 0;
	for my $locale (keys %msg) {
	    for my $m (@{$msg{$locale}}) {
# 		print join q/ /, $locale, Dumper $m, $/;
 		$lm->index_msg($locale, $m->{msgid}, $m->{msgstr});
	    }
	}
    }
}

sub translate_po_data {
    my ($lm, $input_path, $output_dir) = @_;
    my @input_files;
    if (-d $input_path) {
	@input_files = (grep { m{\A.+[^a-z]${locale_pattern}\.po\z}i }
			glob($input_path . '/*.po'));
    }
    elsif (-f $input_path) {
	@input_files = ($input_path);
    }
    else {
	die "Cannot recognize file type";
    }

    if (-e $output_dir && !-d $output_dir) {
	die "$output_dir already exists and it is not a directory";
    }
    elsif (!-d $output_dir) {
	mkdir $output_dir or die $!;
    }

    for my $file (@input_files) {
	print $file, $/;
	$file =~ m{\A.+[^a-z](${locale_pattern})\.po\z};
	die "$file is not a recognized name" if !$1;
	my $locale = lc $1;
	my $aref = Locale::PO->load_file_asarray($file);
	if (@{$aref}) {
	    for my $m (@{$aref}) {
		my $msg_ref = $lm->translate_msg($locale, $m->{msgid});
		if ($msg_ref) {
		    $m->{msgstr} = $msg_ref->[1];
		    $m->{comment}
			.= "Translated from ($file): '$msg_ref->[0]'";
		}
	    }
	    my $output_file = $output_dir . '/' . $locale . '.po';
	    Locale::PO->save_file_fromarray($output_file, $aref);
	}
    }
}

sub main {
    my @memory_dirs;
    my ($input_path, $output_dir);

    exec 'perldoc', $0 if !@ARGV;

    GetOptions(q{memory|m=s@} => \@memory_dirs,
	       q{input|i=s} => \$input_path,
	       q{output_dir|o=s} => \$output_dir);
    die "Please specify translation memories" if !@memory_dirs;
    die "Please specify input path" if !$input_path;
    die "Please specify output dir" if !$output_dir;

    my $lm = Locale::Memories->new();
    build_memories($lm, @memory_dirs);
    translate_po_data($lm, $input_path, $output_dir);
}

main;

1;
__END__

=pod

=head1 NAME

pomagic - L10N Message Translator

=head1 SYNOPSIS

  % pomagic.pl -m directory of .po files [can be multiple values]
               -i an input .po file
                  or a directory which contains .po files
               -o the output directory

=head1 DESCRIPTION

This tool builds up translation memory index and translates messages into
localized versions.

                      pomagic.pl + Translation memories
   The untranslated -------------------------------------> The translated

PO file names must have locale code patterns, such as 'my_app_zh_tw.po'.

=head1 COPYRIGHT

Copyright (c) 2007 Yung-chung Lin. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=cut
