#!/usr/bin/env perl
# MiF. 2006. _L strings extractor.

our $modules;
BEGIN
{
	$modules = __FILE__;
	$modules = '.' if ($modules !~ /\//);
	$modules =~ s/\/[^\/]*$//gos;
	eval "use lib qw($modules/..);";
}

use strict;
use lib qw(..);
use localization::localization;

print _L("\nUncle MiF. 2006. Localization extractor version %#\n\n","1.1.0 (20060912)");
if (scalar(@ARGV)<2)
{
	print _L("Usage: %# <outputFile> <filesList>\n",$0);
	print _L("Example: %# en *.p[lm]\n\n",$0);
	exit(1);
}

my ($target,@files) = @ARGV;
if (-f $target)
{
	print _L("Target file already exists: %#\nPlease remove it and try again.\n",$target);
	exit(2);
}

my $file;
foreach $file (@files)
{
	if ($file eq $target)
	{
		print _L("File in list equal to target: %#\n",$target);
		exit(3);
	}
}

print "Output file: $target\n";
print "Processing files...\n";
for $file (@files)
{
	print _L("Parsing file: %#\n",$file);
	parseFileToTarget($file,$target);
}

sub parseFileToTarget
{
	my ($file, $target) = @_;
 local (*F,*T);
	my $ok = 1;
	open(F,"<$file") or $ok = 0;
	if ($ok)
	{
		open(T,">>$target") or $ok = 0;
		if ($ok)
		{
			local $/ = undef;
			my $content = <F>;
			my %loc;
			while ($content =~ /[^\w\d]_L\s*\(\s*(['"])(.*?[^\\])\1.*?\)/gos)
			{
				my ($str,$spl) = ($2,$1); 
				$loc{$str} = $spl;
				print _L("Warning: line %# contains \$-variables and can not be right localized\n", $spl . $str . $spl) if (($spl eq '"') && ($str =~ /[^\\]\$/os || $str =~ /^\$/os));
			}
			my $cnt = 0;
			foreach my $lstr (keys %loc)
			{
				my $val = $loc{$lstr} . $lstr . $loc{$lstr};
				print T $val . " = " . $val . ";\n";
				$cnt++;
			}
			print _L('%# lines extracted',$cnt) . "\n";
			close(T);
		}
		close(F);
	}

}

print _L("Done\n\n");

