#!/usr/bin/perl-w
#
# Sposb zadajcy zapytanie i prezentujcy dane z www.lexfn.com
#
# Jest to darmowe oprogramowanie; moesz je rozpowszechnia i/lub
# modyfikowa tak, jak samego Perla.
#
# autor: rik - ora@rikrose.net
#

######################
# obsuga            #
######################

use strict;
use Getopt::Std qw(getopts);
use LWP::Simple qw(get);
use URI::Escape qw(uri_escape uri_unescape);
use HTML::TokeParser;

sub usage (  ) { print "
uycie: lexfn [opcje] sowo1 [sowo2]
options available:
 -s Synonim        -a Antonim        -b Rok urodzenia
 -t Pokazuje       -r Rymy           -d Rok mierci
 -g Uoglnia       -l Wymowa jak...  -T Bio pokazuje
 -S Precyzuje      -A Anagram        -k Znany te jako
 -c Obejmuje       -o Zawd
 -p Cz...       -n Narodowo

 opcja -x oznacza wszystkie

sowo1 jest obowizkowe, czasem potrzebne bdzie sowo2\n\n"
}

######################
# analiza            #
######################

# pobierz argumenty, wstaw je do tablicy %args pozostawiajc pojedyncze
# argumenty w @ARGV na pniej (tu bdzie sowo1 i sowo2)
# jeli brak choby jednego argumentu, pokazujemy sposb uycia skryptu.
my %args; getopts('stgScparlAonbdTkx', \%args);
if (@ARGV > 2 || @ARGV == 0) { usage(  ); exit 0; }

# przeksztacamy oba nasze sowa w zapytania.
$ARGV[0] =~ s/ /\+/g; $ARGV[1] ||= "";
if ($ARGV[1]) { $ARGV[1] =~ s/ /\+/g; }

# zaczynamy tworzenie URL ze sowami kluczowymi.
my $URL = "http://www.lexfn.com/l/lexfn-cuff.cgi?sWord=$ARGV[0]".
          "&tWord=$ARGV[1]&query=show&maxReach=2";

# teraz okrelmy argumenty wiersza polece. kady argument jest wizany
# z odpowiednim poszukiwaniem w LexFN, wic najpierw stworzymy
# stosowne mapowanie.
my %keynames = (
 s => 'ASYN', t => 'ATRG', g => 'AGEN', S => 'ASPC', c => 'ACOM', 
 p => 'APAR', a => 'AANT', r => 'ARHY', l => 'ASIM', A => 'AANA', 
 o => 'ABOX', n => 'ABNX', b => 'ABBX', d => 'ABDX', T => 'ABTR', 
 k => 'ABAK'
);

# jeli chcemy wszystko, co pasuje, przygotowujc adres URL
# dodajemy to do tablicy z argumentami.
if (defined($args{'x'}) && $args{'x'} == 1) {
   foreach my $arg (qw/s t g l S c p a r l A o n b d T k/){
       $args{$arg} = 1; # przygotowanie do URL.
   } delete $args{'x'}; # x nie ma w LexFN znaczenia.
}

# tworzymy adres URL z danych flag.
foreach my $arg (keys %args) { $URL .= '&' . $keynames{$arg} . '=on'; }

######################
# danie            #
######################

# i pobieramy wszystko, co bdziemy dalej analizowa.
my $content = get($URL) or die $!;

######################
# wycinanie          #
######################

# kiedy mamy dane, przekazujemy je do parsera.
my $stream = HTML::TokeParser->new( \$content ) or die $!;

# pomijamy formularz, po formularzu jest pierwsze <b>,
# od ktrego zaczynamy wybiera dane
my $tag = $stream->get_tag("/form");
while ($tag = $stream->get_tag("b")) {
    print $stream->get_trimmed_text("/b") . " ";
    $tag = $stream->get_tag("img");
    print $tag->[1]{alt} . " ";
    $tag = $stream->get_tag("a");
    print $stream->get_trimmed_text("/a") . "\n";
}

exit 0;

