#!/usr/bin/perl -w

require 5.0;
eval "use Socket";

$id = $0;
$id =~ s#.*/(.*)#$1#;
#############################################################################
### bokmaal -- Sverre H. Huseby, Norway. <shh@thathost.com>
###            [mail evt. endringer/utvidelser til meg]
###            Lisens: Artistic License
###
### Snakker HTTP med en bokmlsordbok.
### Ingenting garanteres, dette er et hurtighack.
###
### ChangeLog ###############################################################
###
###   1.9, 2005-07-28, Hans F. Nordhaug
###       * Endret parser til  droppe <DOCBOOK>-header i output.
###       * Fjernet redundant code i showUsage().
###
###   1.8, 2002-10-03, Sverre H. Huseby
###       * Sttte for proxy-server via environment-variabelen http_proxy,
###         som er p flgende format: http://host:port/
###         Ingen sttte for proxy-autentisering.
###       * Endret min kontaktinformasjon.
###       * Endret local() til my(), siden vi n krever Perl 5.
###
###   1.7, 2002-10-03, Kjetil Torgrim Homme
###       * Ta bort HTML-kommentarar.  Dette brukar non-greedy regexp, alts
###         er Perl 5 naudsynt.
###
###   1.6, 2002-07-23, Dagfinn I. Mannsker
###       * Bruk sockaddr_in() og inet_aton() i openConnection()
###         Dette gjr at ting funker nr gethostbyname(`hostname`) ville
###         returnert 127.0.0.1.
###       * Skriv ut $! nr ting feiler i openConnection().
###       * Slutt  se etter opsjoner etter '--', s man kan sl opp endelser.
###
###   1.5, 2001-10-29, Petter Reinholdtsen
###       * Endret URL og la inn HTTP 'Host:'-felt for  f serveren
###         til  forst hvilken virtuell server den skal bruke.
###       * La inn liten endring fra IFI i xterm-sjekk.
###
###   1.4, 2000-01-04, Kjetil Torgrim Homme
###       * Fjernar overskrifta fr tabellen.  Endra dina.uio.no til
###         www.dokpro.uio.no.
###
###   1.3, 1997-07-09, Arne Georg Gleditsch
###       * La til "alfabet=n" i $request.  CGI-skriptet er tydeligvis
###         endret, og nekter  svare fornuftig hvis ikke denne er med.
###
###   1.2, 1996-10-25, Kjetil Torgrim Homme
###       * Nynorsk "Ikkje funne"
###
###   1.1, 1996-09-02, Sverre H. Huseby
###       * $action vil visst plutselig ha med "?bokmaal" (uansett mlform).
###
###   1.0, 1996-05-13, Kjetil Torgrim Homme
###       * Egen sjekk p versjon 5 i toppen, siden det er en forstyrrende
###         bug i de automaisk genererte headerfilene.
###
###   0.9, 1996-05-10, Sverre H. Huseby
###       * Chopper ogs \r i skiphead, siden linjer i headeren n ender
###         med "\r\n".
###       * Fjernet spesialhndteringene fra v0.7, siden disse n ser ut til
###          vre riktige.
###
###   0.8, 1996-02-22, Steinar Midtskogen
###       * -k/--key-opsjon lagt til for kodenkkel.
###
###   0.7, 1996-02-20, Sverre H. Huseby
###       * $Nrope og $Pd
###
###   0.6, 1996-01-09, Sverre H. Huseby
###       * tolkning av &lt og &gt
###
###   0.5, 1996-01-09, 9/1/96, Kjetil Torgrim Homme
###       * endringer i formattering av output.
###
###   0.4, 1996-01-08, Sverre H. Huseby
###       * --plain er p hvis output ikke gr til tty.
###
###   0.3, 1996-01-07, Arne Georg Gleditsch og Per Kristian Gjermshus
###       * Hndterer syv-bit norsk i oppslagsord.
###       * Kan sl opp nynorske ord. (ser p programmnavnet)
###
###   0.2, 1996-01-06, Per Kristian Gjermshus
###       * Kan n ta flere ord p kommandolinjen.
###
###   0.1, 1996-01-05, Sverre H. Huseby
###
### Configuration section ###################################################

### Default values.
$verbose = 0;
$plaintext = 0;
$linelen = 75;
### End of configuration section ###########################################

$dokserver = "www.dokpro.uio.no";
$dokserverport = 80;
$proxyserver = "";
$proxyport = 0;
$action = "/perl/ordboksoek/ordbok.cgi?ordbok=bokmaal";

%term = (
	 "itStart", "\x1B[4m",
         "itEnd",   "\x1B[m",
	 "bfStart", "\x1B[1m",
	 "bfEnd",   "\x1B[m"
	 );

### Misc functions #########################################################

### Display the given string if verbose mode is on.
sub report {
    return if !$verbose;
    print @_;
}

### Return length of a word with terminal escapes removed.
sub wordLength {
    my($word) = join(" ", @_);

    foreach $esc (values %term) {
	$word =~ s/\Q$esc\E//g;
    }
    return length($word);
}

### Split lines on word boundaries to match width of screen.
sub formatOutput {
    my($text) = join("\n", @_);
    my($n, $len);

    foreach $line (split("\n", $text)) {
	$n = 0;
	foreach $word (split(" ", $line)) {
	    $len = &wordLength($word);
	    if ($n + $len + 1 >= $linelen) {
		print "\n";
		$n = 0;
	    }
	    if ($n) {
		print " ";
		++$n;
	    }
	    print $word;
	    $n += $len;
	}
	print "\n";
    }
}

### HTTP-Functions #################################################

### Open a connection to the HTTP-server
sub openConnection {
    my($host, $port);

    if (length($proxyserver)) {
	$host = $proxyserver;
	$port = $proxyport;
	&report("Connecting to proxy server at $dokserver\n");
    } else {
	$host = $dokserver;
	$port = $dokserverport;
	&report("Connecting to http server at $dokserver\n");
    }
    $proto = (getprotobyname('tcp'))[2];
    
    socket(SOCK, &PF_INET, &SOCK_STREAM, $proto)
	|| die "$id: cannot create socket: $!\n";
    connect(SOCK, sockaddr_in($port, inet_aton($host)))
	|| die "$id: cannot connect socket: $!\n";
    
    select(SOCK); $| = 1; select(STDOUT);
}

### Skip up to and including an empty line.
sub skipHead {
    while (<SOCK>) {
	s/(\r|\n)*$//;
	last if (length($_) == 0);
    }
    # Remove everything before the start of the HTML-tag
    # Normally just the DOCTYPE statement.
    while (<SOCK>) {
        last if (/.*<HTML>/i);
    } 
}

### Get a sequence of textlines, and display on stdout. Filter html,
### and stop when appropriate.
sub getHtml {
    my($stop) = 0;
    my($nomatch) = 0;
    my($table_start) = 0;
    my($in_comment) = 0;

    while (<SOCK>) {
	if (!$stop) {
	    $nomatch = /Ingen artikkel i .* om ordet/ unless $nomatch;

	    if ($in_comment) {
		if (/-->/) {
		    s/^.*?-->//;
		    $in_comment = 0;
		    next if /^\s*$/;
		} else {
		    next;
		}
	    }
	    s/<!--.*?-->//;
	    if (/<!--/) {
		$in_comment = 1;
		s/<!--.*//;
		next if /^\s*$/;
	    }

	    # Skip the new search query.
	    $stop = s/Over(sikt|syn) over grammatiske kod[ae]r.*//;

	    # Remove headline from TABLE.  Only trigger on first
	    # TABLE since there are TABLEs within TABLEs.
	    if (/<TABLE/i) {
		++$table_start;
	    }
	    if (/<TR/ && $table_start == 1) {
		++$table_start;
		s,<TR.*?</TR>,,ig;
	    }

	    # Remove header elements.
	    s/<title>.*?<\/title>//ig;
	    s/<h\d>.*?<\/h\d>//ig;

	    # Line breaks.
	    s/\s*<br>/\n/ig;
	    s/\s*<p>/\n/ig;
	    s/\s*<b>/\n<b>/ig;

	    # Italics and boldface.
	    if (!$plaintext) {
		s/<b>/$term{"itStart"}/ig;
		s/\s*<\/b>/$term{"itEnd"}/ig;
		s/<i>/$term{"bfStart"}/ig;
		s/\s*<\/i>/$term{"bfEnd"}/ig;
	    }

	    # Special characters
	    s/&lt;?/</g;
	    s/&gt;?/>/g;
	    s/&nbsp;?/ /g;

	    # Remove any leftover tags.
	    s,(</?T[DR].*?>)+, ,ig;
	    s/<.*?>//g;

	    # Fix some strange formatting.
	    s/ +/ /g;
	    s/ ,/,/g;
	    s/ \)/\)/g;

	    # Collate multiple empty lines.
	    s/\n+/\n/g;

	    &formatOutput($_);;
	}
    }
    print $maalform eq "nynorsk" ? "Ikkje funne" : "Ikke funnet" if $nomatch;
    print "\n";
}

### Pass a command to the server, and get the reply. Abort if error.
sub sendCommand {
    my($command) = join(' ', @_);
    print SOCK $command, "\r\n";
}

### Get the word
sub getWord {
    my($i, $request, $act);

    $i = 0;

    if (length($proxyserver)) {
	$act = "http://$dokserver:$dokserverport" . $action;
    } else {
	$act = $action;
    }

    while($word[$i]) {
	$word[$i] =~ tr/{|}[\]//;
	&report("fetching word $word[$i]\n");
	&openConnection;
	&sendCommand("POST $act HTTP/1.0");
	&sendCommand("Content-type: application/x-www-form-urlencoded");
	$request = "OPP=$word[$i]&$maalform=bar&alfabet=n";
	&sendCommand("Content-length: " . length($request));
	&sendCommand("Host: " . $dokserver);
	&sendCommand("");
	&sendCommand($request);
	&skipHead;
	&getHtml;
	$i++;
    }
}
 
### Soon finished! ################################################

sub showUsage {
    print <<EOT;

Bruk: $id [--plain] [--key] oppslagsord

      --plain skrur av uthevet skrift.
      -k --key gir kodenkkel

Merk! Dette er et ikke-robust hack som kan slutte  virke nr som
helst. Send mail til shh\@thathost.com hvis noe gr galt, s
_kanskje_ det blir fikset.

Ordbkene er utarbeidet i Avdeling for leksikografi p Institutt for
nordistikk og litteraturvitenskap ved Universitetet i Oslo i samarbeid
med Norsk sprkrd. Bokmlsordboka er utgitt p Universitetsforlaget.
Nynorskordboka er utgitt p Det Norske Samlaget. 

Den elektroniske WWW-versjonen (som dette hacket snakker med) er
utviklet i regi av Dokumentasjonsprosjektet etter oppdrag fra Avdeling
for leksikografi.

EOT
#*/
     exit 0;
}

sub showKey {

    if ($maalform =~ "bokmaal") {
      print <<EOT

   ubf. ent.    bf. ent.     ubf. fl.                     bf. fl.
f1 seng         senga        senger                       sengene
m1 stol         stolen       stoler                       stolene
m2 lrer        lreren      lrere [lrerer]             lrerne
m3 bever        beveren      bevere [beverer] el. bevrer  beverne el. bevrene
n1 slott        slottet      slott                        slotta el. slottene
n2 eple         eplet        epler                        epla el. eplene
n3 kontor       kontoret     kontor el. kontorer          kontora el. kontorene
n4 salt         saltet       salter                       salta el. saltene

   infinitiv    presens      preteritum                   perf. part.
v1 kaste        kaster       kasta el. kastet             kasta el. kastet
v2 lyse         lyser        lyste                        lyst
v3 leve         lever        levde                        levd
v4 n           nr          ndde                        ndd

   hankjnn     intetkjnn   flertall
a1 god          godt         gode
a2 norsk        norsk        norske
a3 ekte         ekte         ekte
a4 oppskjrtet  oppskjrtet  oppskjrtede el. oppskjrtete
a5 makaber      makabert     makabre
   lunken       lunkent      lunkne
EOT

    }
    else {

      print <<EOT

   ubf. eint.        bf. eint.             ubf. fl.            bf. fl.
f1 bygd              bygda [bygdi]         bygder              bygdene
f2 vise [visa]       visa                  viser [visor]       visene [visone]
f3 dronning          dronninga [dronningi] dronningar          dronningane
m1 bt               bten                 btar               btane
   hage              hagen                 hagar               hagane
   lrar             lraren               lrarar             lrarane
n1 hus               huset                 hus                 husa [husi]
   rike              riket                 rike                rika [riki]

   infinitiv         presens               preteritum          perf. part.
v1 kasta el. kaste   kastar                kasta               kasta
v2 kvila el. kvile   kviler                kvilte              kvilt

   hankjnn          hokjnn               inkjekjnn          fleirtal
a1 stor              stor                  stort               store
a2 norsk             norsk                 norsk               norske
a3 grepa             grepa                 grepa               grepa
a4 open              open [opi]            ope el. opi [opent] opne
a5 vaksen            vaksen [vaksi]        vakse el. vaksi     vaksne
EOT
}
    exit 0;
}

sub getProxySetting {
    my($httpProxy, $host, $port);

    $httpProxy = $ENV{"http_proxy"};
    return if (!defined($httpProxy));
    ($host, $port) = ($httpProxy =~ /([a-zA-z.-]+):(\d+)/);
    return if (!defined($host) || !defined($port));
    $proxyserver = $host;
    $proxyport = $port;
}

sub getOptions {
    my($a);
    my($i);
    my($optdone);
    $i = 0;
    $optdone = 0;
    $maalform = $id;
    $maalform =~ s/bokm[}]l/bokmaal/;
    &showUsage if !@ARGV;
    while (@ARGV) {
	$a = shift @ARGV;
	if ($a eq "--") {
	    $optdone = 1;
	} elsif ($a =~ m#^-# && !$optdone) {
	    if ($a eq "-h" || $a eq "--help") {
	        &showUsage;
	    } elsif ($a eq "--plain") {
	        $plaintext = 1;
	    } elsif ($a eq "-q" || $a eq "--quiet") {
	        $verbose = 0;
	    } elsif ($a eq "-v" || $a eq "--verbose") {
	        $verbose = 1;
	    } elsif ($a eq "-k" || $a eq "--key") {
	        &showKey;
	    } else {
	        print STDERR "$id: ukjent opsjon $a\n";
		&showUsage;
		exit 64;
	    }
        } else {
	    $word[$i] = $a;
	    $i++;
	}
    }
    die "$id: mangler oppslagsord\n" unless $word[0];
}

### main() ############################################################

$terminal = $ENV{'TERM'};
$plaintext = ($terminal ne "vt100" && $terminal !~ /^xterm/
	      && $terminal ne "ansi") || ! -t STDOUT;
&getProxySetting;
&getOptions;
&getWord;
exit 0;