#!/usr/bin/env perl
# (c) Uncle MiF, 2006. alexey@mitme.ru

require 5.8.0;
use strict;

my $esc = ' &"\'';

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

print "\n";
if (scalar(@ARGV) != 1 && scalar(@ARGV) != 2 && scalar(@ARGV) != 3 && scalar(@ARGV) != 4)
{
	my $verPath = $0; 
	$verPath =~ s/\/[^\/]*$//gos;
	$verPath .= '/version';
	$verPath =~ s/([$esc])/\\$1/gos;
	my $ver = `cat $verPath`;
	$ver =~ s/\s+$//gos;
	print _L("(c) MiF, MDict, Stardict/Freedict dictionaries unpacker version %#\n\n",$ver);
	print _L("Usage: %# <dictionaryName> [<dictionaryType>] [<outputDirectory>]\n",$0);
	print _L("\n<dictionaryName> - dictionary path and file name without extension\n");
	print _L("<dictionaryType> - optional - dictionary type (text or html) - text by default\n");
	print _L("<outputDirectory> - optional - output directory\n");
	print _L("\nExample: %# ~/Library/MDict/en-fr-simple\n",$0);
	print _L("(no .dict or .idx extension needed, however, en-fr-simple.dict and en-fr-simple.idx files must be present at specified location)\n\n");
	exit(1);
}

my $silent = $ARGV[3];
$silent ||= 0;
$silent = ($silent =~ /^silent$/i) ? 1 : 0;

my $fName = $ARGV[0];
$fName =~ s/\.dict$//i;
my $fType = (!defined $ARGV[1] || $ARGV[1] !~ /^\s*html\s*$/i) ? 'txt' : 'html';
print _L("Dictionary type: %#\n",$fType);
my $lastPathComponent = $fName;
$lastPathComponent =~ s/^.*\///gos;
if (!$lastPathComponent || $lastPathComponent =~ /^\.+$/)
{
	print _L("Can't parse properly dictionary path\n");
	exit(2);
}
print _L("Processing dictionary %# ( %# )\n",$lastPathComponent,$fName);
my ($DICT,$IDX,$EXT) = ($fName.".dict",$fName.".idx",$fName.".ext");
if (! -f $DICT || ! -f $IDX)
{
	print _L("%# or %# not found\n",$DICT,$IDX);
	exit(3);
}

my $DIR = defined $ARGV[2] ? $ARGV[2] : './Unpacked Dictionaries/';
$DIR .= '/' if ($DIR !~ /\/$/);
$DIR .= $lastPathComponent;
my $log = "$DIR/unpack.log";
print _L("Result (unpacked dictionary) will be placed at path '%#'\n",$DIR);
print _L("Logging to file '%#'\n",$log);
my $words = "$DIR/Words";
print _L("Words articles directory '%#'\n",$words);

my $tF = $fName;
$tF = "./$tF" if $tF !~ /^\//;
$tF =~ s/\/[^\/]*$//gos;
my @statF = stat($tF);
my @statD = stat($DIR);
if ($statF[0] == $statD[0] && $statF[1] == $statD[1])
{
	print _L("\nDictionary file '%#' in working directory '%#'.\nPlease move dictionary file from the directory and try again.\n",$fName,$DIR);
	exit(13);
}

if (-d $DIR)
{
	local $|=1;
	print _L("\nDirectory '%#' already exists. Remove now [N/yes]? ",$DIR);
	my $answer = <STDIN>;
	$answer =~ s/\s+$//gos;
	if ($answer !~ /^yes$/i)
	{
		print _L("User canceled (you must type YES to continue)...\n");
		exit(4);
	}
}

my $sDIR = $DIR;
$sDIR =~ s/([$esc])/\\$1/gos;
my $sWords = $words;
$sWords =~ s/([$esc])/\\$1/gos;
my $repl = "$DIR/Replacements";
my $sRepl = $repl;
$sRepl =~ s/([$esc])/\\$1/gos;
print _L("Rebuilding directories\n '%#'\n '%#'\n",$words,$repl);
system("rm -rf $sDIR 2>/dev/null; mkdir -p $sWords; mkdir -p $sRepl");

print _L("Processing dictionary...\n");
my ($ok,$offset,$word,$bt,$content,$len);
local * F;
local * DICT;
local * IDX;
local * LOG;
unless (open(DICT,"<$DICT"))
{
	print _L("Can't open dictionary %# for reading.\n",$DICT);
	exit(20);
}
unless (open(IDX,"<$IDX"))
{
	print _L("Can't open index for %# reading.\n",$IDX);
	exit(21);
}
unless (open(LOG,">$log"))
{
	print _L("Can't open log file '%#' for writing\n",$log);
	exit(22);
}
binmode(DICT);
binmode(IDX);
binmode(LOG);
undef $/;
my ($count,$rcnt) = (0,0);
my $rfile;
$bt = '';
my $oCh;
while (read(IDX,$bt,1))
{
	$oCh = unpack('C',$bt);
	$bt = pack('C',$oCh);
	if ($oCh == 0)
	{
		$word =~ s/^\s+//gos;
		$word =~ s/\s+$//gos;
		print LOG "$word\n";
		read(IDX,$offset,4); $offset = unpack('N',$offset);
		read(IDX,$len,4); $len = unpack('N',$len);
		seek(DICT,$offset,0);
		read(DICT,$content,$len);
		if (length($word))
		{
			$ok = 1;
			open(F,">$words/$word-$count.$fType") or $ok = 0;
			if (!$ok)
			{
				print _L("Can't write to file '%#' directly.\nTrying to make word '%#' replacement (alias).\n","$words/$word-$count",$word);
				$rfile = "_REPLACEMENT_$rcnt-$count.$fType";
				$ok = 1;
				open (F,">$words/$rfile") or $ok = 0;
				if ($ok)
				{
					local * RF;
					open(RF,">$repl/$rfile") or $ok = 0;
					if ($ok)
					{
						$rcnt++;
						print RF "$word";
						close(RF);
					}
					else
					{
						print _L("Can't write word alias for '%#' to file '%#'\n",$word,"$repl/$rfile");
					}
				}
			}
			if ($ok)
			{
				binmode(F);
				$content =~ s/\0/\n/gos;
				print F $content; close(F);
				$count++;
			}
			else
			{
				print _L("Can't open file '%#' and '%#' for writting.\n","$words/$word-$count","$words/$rfile");
			}
		}
		$content = $word = '';
		next;
	}
	$word .= $bt;
}

close(DICT); close(IDX);
close(LOG);
print _L("Total words processed: %#\n",$count);
print _L("Done\n");
if (-d $EXT)
{
	print _L("%# have extensions (multimedia content detected)\n",$lastPathComponent);
	print _L("Copying multimedia content to '%#/Extensions'\n",$DIR);
	$EXT =~ s/([$esc])/\\$1/gos;
 system("cp -r $EXT $sDIR/Extensions");
	print _L("Creating symlink __E__ to Extensions in Words folder\n");
	system("ln -s ../Extensions $sDIR/Words/__E__");
}
system("open $sDIR") unless ($silent);
