#!/usr/bin/perl
# 20080202

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program 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.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

use Getopt::Std;
use Net::HTTP;
use URI::Escape;

my $langs = "cz|en|ge|it|la|ru|sp";

sub Help
{
	my $out = \*STDERR;
	my $ret = 1;
	if(!$_[0])
	{
		$out = \*STDOUT;
		$ret = 0;
	}

	print $out "slovnik.cz CLI napsal David Watzke <slovnik\@watzke.cz> http://www.watzke.cz/cs/\n";
	print $out "Pouziti: slovnik [prepinace a retezec]\n";
	print $out "Chyba: $_[0]\n" if $_[0];
	print $out "Prepinace:\n";
	print $out "\t-f[$langs]\tvstupni jazyk, vychozi cz\n";
	print $out "\t-t[$langs]\tvystupni jazyk, vychozi cz\n";
	print $out "\t-r[5-50]\t\t\tpocet vysledku, vychozi 10\n";
	print $out "Poznamky:\n";
	print $out "\tBud vstupni nebo vystupni jazyk musi byt cestina (cz).\n";
	print $out "\tChyby hlaste na vyse uvedeny e-mail.\n";

	exit $ret;
}

my %opts;
getopt("f:t:r:-", \%opts);

$ARGV[0] or &Help("Nebyl zadan zadny retezec k prelozeni.");

$opts{f} or $opts{f} = "cz";
$opts{t} or $opts{t} = "cz";
$opts{f} ne $opts{t} or &Help("Vstupni a vystupni jazyk nesmi byt stejny.");
$opts{r} or $opts{r} = 10;

my $dict = $opts{t} eq "cz" ? "$opts{f}$opts{t}" : "$opts{t}$opts{f}";

if("$dict" =~ /^(?:$langs){2}$/)
{
	"$dict" =~ /(?:^cz|cz$)/ or &Help("Vstupni nebo vystupni jazyk musi byt cestina.");
} else {
	&Help("slovnik.cz nepodporuje preklad z '$opts{f}' do '$opts{t}'.");
};

#$opts{t} eq "cz" or $dict = "$opts{t}$opts{f}";
$opts{f} =~ s/cz/cz_d/;
$dict .= ".$opts{f}";

my $http = Net::HTTP->new(Host => "www.slovnik.cz") || die $@;
my $string = $ARGV[0]; shift;
$string .= " $_" foreach(@ARGV);
$string =~ s/ /%20/g;
$http->write_request(GET => "/bin/mld.fpl?vcb=$string&dictdir=$dict&lines=$opts{r}");
my($status, $mess, %headers) = $http->read_response_headers;
my $html;

while(1)
{
	my $buf;
	my $n = $http->read_entity_body($buf, 1024);
	defined $n or &Help("Chyba pri cteni HTML: $!");
	$n or last;
	$html .= $buf;
}

# ja vim, ja vim, ale s HTML::Parser jeste neumim...
foreach(grep /vcb_pair/, split(/\n/, $html))
{
	s/(?:<[^>]+>)//g;
	print "$_\n";
}