#!/usr/bin/perl

use warnings;
use strict;

use utf8;
use open qw(:std :utf8);


my $DEBUG=0;
use Getopt::Std;
sub usage()
{
	print <<endusage;
usage: $0 [OPTIONS] template_file file.po [output file]

OPTIONS:
    -h          - this helpscreen

    -o tag      - the open tag (default: '<gt>')
    -c tag      - the close tag (default: '</gt>')
    
    -s          - collapse spaces
    -e          - erase endspaces
    -b          - erase beginspaces

    -d          - debug level for messages

PS: script works in utf-8 charset
endusage
    exit;
}

sub parse_po($$)
{
    my @lines=split /\n/, shift;
    my $skip_empty=shift;
    my %blocks;

    my @tmp;
    my $no=0;
    for (@lines, undef)
    {
        if (!defined($_) or /^\s*$/)
        {
    	    $no++;
        	if (grep /^\s*#\s*,\s*fuzzy\s*$/, @tmp)
        	{
        		print STDERR "Fuzzy part #$no was skipped\n" if $DEBUG;
        	}
        	else
        	{
        		if (grep !/^\s*#/, @tmp)
        		{
        		    $blocks{$no}=[ grep !/^\s*#/, @tmp ];
        		}
        		else
        		{
        			print STDERR "Empty part #$no was skipped\n" if $DEBUG;
        		}
        	}
        	@tmp=();
        	next;
        }
        push @tmp, $_;
    }

    my %tr;
    for my $bno(keys %blocks)
    {
    	my @blk=@{$blocks{$bno}};
    	my $line=join "\n", @blk;

    	my ($msg_id, $msg_tr)=$line =~ /^msgid (.*?)^msgstr (.*)/sm;

        for my $w ($msg_id, $msg_tr)
        {
            $w = join '',
                    map {
                    	s/"$//;
                    	s/^"//;
                	    s/\\r/\r/g;
                	    s/\\n/\n/g;
                	    s/\\"/"/g;
                	    s/\\\\/\\/g;
                	    $_
                    }   
                    grep /"$/, 
                    grep /^"/, 
                    map { s/\s+$//; s/^\s+//; $_ }
                    split /\n/, $w;
        }

        if ($skip_empty and $msg_tr=~/^\s*$/s)
        {
        	print STDERR "Empty translations-part #$no was skipped\n" if $DEBUG;
        }
        else
        {
            $tr{$msg_id}=$msg_tr;
        }
    }
    return %tr;
}

getopts('dhsebo:c:', \my %opts) or usage;
usage if $opts{h};
$DEBUG=$opts{d};
my ($template, $po, $output_name)=@ARGV;
my ($open_tag, $close_tag)=($opts{o}||'<gt>', $opts{c}||'</gt>');
my $output;

usage unless defined $template;
usage unless defined $po;


die "File '$template' not found!\n" unless -f $template;
die "File '$po' not found!\n" unless -f $po;


open my $th, '<', $template or die "Can not open file '$template': $!\n";
open my $poh, '<', $po or die "Can not open file '$po': $!\n";

my ($podata, $tdata); { local $/; $podata=<$poh>; $tdata=<$th>; }

unless (defined $output_name)
{
	$output=\*STDOUT;
}
else
{
	open $output, '>', $output_name
	    or die "Can not open file '$output': $!\n";
}

my %pod=parse_po $podata, 1;

my $no=0;
while($tdata=~/$open_tag(.*?)$close_tag/s)
{
	$no++;
	my $tag=$1;
    $tag =~ s/\s+/ /gs if $opts{s};
    $tag =~ s/^\s+//mg if $opts{b};
    $tag =~ s/\s+$//mg if $opts{e};

    if (exists $pod{$tag})
    {
        printf STDERR "Part #%d was translated\n", $no if $DEBUG;
        $tag=$pod{$tag};
    }
    else
    {
        printf STDERR "Part #%d was translated\n", $no if $DEBUG;
    }

    $tdata =~ s/$open_tag(.*?)$close_tag/$tag/s;
}

print $output $tdata;