#!/usr/local/bin/perl # Janne Himanka 1996-09-19 # Hieman keskeneräinen perl-ohjelma, joka toteuttaa yhdyskäytävän # WWW:n ja VTLS-kirjastojärjestelmän välillä. Puuttuvat toiminnot: # katkaisu ja Boolen haku. Ohjelma on tehty kokonaan Perlillä. # Vapaasti levitettävissä kunhan tieto alkuperäisestä tekijästä # säilytetään koodin mukana. Tekijä sanoutuu irti kaikesta vastuusta # ohjelman tekemien mahdollisten tuhojen suhteen. use CGI::Base; use CGI::MiniSvr; use CGI::Request; require "Comm.pl"; #use sigtrap; #use diagnostics; $ENV{PATH} .= ":/usr/sbin"; CGI::Base::Debug(2); CGI::Request::Debug(2); $SIG{TERM} = 'IGNORE'; $req = GetRequest('R'); $cgi = new CGI::MiniSvr; $port = $cgi->port; $me = "http://clovis.oulu.fi$port/cgi-bin/han/han"; $kw = 0; $Debug = 1; CGI::Base::LogFile("/usr/local/httpd/cgi-bin/han/han.log") unless -t STDIN; sub init { &Comm'init(); #' ($Proc_pty_handle, $Proc_tty_handle, $Proc_pid) = &open_proc("telnet kirjasto.oulu.fi"); &stty_raw($Proc_tty_handle); ( $match, $err, $before, $after ) = &expect( $Proc_pty_handle, 30, 'KIRJASTO'); # print STDERR "HELLO: $err\n"; if ($err eq 'TIMEOUT') { close_it ($Proc_pty_handle); die "TIMEOUT"; } sleep 2; print $Proc_pty_handle "hello han,user.clas01\r\n"; ( $match, $err, $before, $after ) = &expect( $Proc_pty_handle, 40, 'erminal type'); # print STDERR "Terminal type: $err\n"; if ($err eq 'TIMEOUT') { close_it ($Proc_pty_handle); die "TIMEOUT"; } sleep 2; print $Proc_pty_handle "10\r\n"; ( $match, $err, $before, $after ) = &expect( $Proc_pty_handle, 40, 'Anna kokoelmatunnus'); # print STDERR "Kokoelmatunnus: $err\n"; if ($err eq 'TIMEOUT') { close_it ($Proc_pty_handle); die "TIMEOUT"; } sleep 2; print $Proc_pty_handle "100\r\n"; } sub hakulomake { print <<"EOT"; Haku OULA-kirjastoluettelosta

Haku OULA-kirjastoluettelosta

EOT $cgi->done; } sub tee_haku { my $komento; my (@rivit, @rivi); my ($match, $err, $before, $after); for ($R::kohde) { /^Tekij/ && do { $komento = "a/"; last; }; /^Nimeke/ && do { $komento = "t/"; last; }; /^Hakusana/ && do { &sanahaku; return; }; /^Asiasana/ && do { $komento = "s/"; last; }; /^UDK/ && do { $komento = "z/"; last; }; } $komento .= $R::kysely; print <<"EOT"; OULA-haun tulos

OULA-haun tulos

EOT print $Proc_pty_handle "$komento\r\n"; ($match, $err, $before, $after) = &expect($Proc_pty_handle, 20, '\s+1[.>*][\0-\377]+\nRivin'); @rivit = split(/\n/, $match); for (@rivit) { next unless (/\s*(\d+)[.>\s]+(\d*)\s+(.+)/); @rivi = ($1, $2, $3); if ($rivi[1] > 1) { $rivi[0] =~ s#(\d+)#$1#; } else { $rivi[0] =~ s#(\d+)#$1#; } print <<"EOT"; EOT } print <<"EOT";

Viite	Teoksia kpl	Hakuavain
$rivi[0]	$rivi[1]	$rivi[2]

Hakusivulle Taaksepäin listauksessa Eteenpäin listauksessa EOT $cgi->done; } sub valitse_listasta2 { my (@rivi, @rivit); my ($match, $err, $before, $after) = ("", "", "", ""); my $ekasivu = 0; print <<"EOT"; OULA-haun viitteet

OULA-haun viitteet

EOT print $Proc_pty_handle "$R::valitse\r\n"; ($match, $err, $before, $after) = &expect($Proc_pty_handle, 20, '\s+\d+\.[\0-\377]+Muu komento'); @rivit = split(/\n/, $match); for (@rivit) { next unless (/^\s+(\d+)\.\s+(.+)/); @rivi = ($1, $2); if ($rivi[0] == 1) { $ekasivu = 1; } $rivi[0] =~ s#(\d+)#$1#; print <<"EOT"; EOT } print <<"EOT";

Viite	Sijaintitiedot
$rivi[0]	$rivi[1]

Hakusivulle EOT if ($ekasivu) { if ($R::edellinen eq "haku") { print "Edelliselle sivulle
\n"; } elsif ($R::edellinen eq "sanahaku") { print "Edelliselle sivulle
\n"; } } else { print "Taaksepäin listassa
\n"; } if ($match =~ /NS\.+Seuraava n/) { print "Eteenpäin listassa
\n"; } if ($kw) { print "Haetut sanat -sivulle
\n"; } print <<"EOT"; EOT $cgi->done; } sub nide { my (@rivi, @rivit); my ($label, $value); my $template = "A4A2A21A15A14A6"; print <<"EOT"; OULA-haun nidevalikko

OULA-haun nidevalikko

EOT print $Proc_pty_handle "$R::valitse\r\n"; ($match, $err, $before, $after) = &expect($Proc_pty_handle, 20, '[A-ZÅÄÖ]+:[\0-\377]+\nRivin'); @rivit = split(/\n/, $match); for (@rivit) { next unless (/([A-ZÅÄÖ]+:)\s+(.+)/); $label = $1; $value = $2; print "$label $value
\n"; } print <<"EOT";

EOT for (@rivit) { next unless (/^\s+\d/); @rivi = unpack($template, $_); $rivi[0] =~ s/\s//g; $rivi[0] =~ s!(\d+)!$1!; print "\n"; print <<"EOT"; EOT } print <<"EOT";

VIITE	KOKOELMA	TILA	ID-NUMERO	KPL OSA/NRO
$rivi[0]	$rivi[2]	$rivi[3]	$rivi[4]	$rivi[5]

EOT if (($R::edellinen eq "lista2") ||($R::edellinen eq "hylly") ) { print "Edelliselle sivulle
\n"; } elsif ($R::edellinen eq "sanahaku") { print "Edelliselle sivulle
\n"; } if ($kw) { print "Haetut sanat -sivulle
\n"; } print <<"EOT"; Hakusivulle EOT $cgi->done; } sub hylly { my (@rivi, @rivit); my ($label, $value); print <<"EOT"; OULA - teoksen hyllysijainti

OULA - teoksen hyllysijainti

EOT print $Proc_pty_handle "$R::valitse\r\n"; ($match, $err, $before, $after) = &expect($Proc_pty_handle, 20, '[A-ZÅÄÖ]+:[\0-\377]+\nPS'); @rivit = split(/\n/, $match); for (@rivit) { next unless (/([A-ZÅÄÖ]+:)\s+(.+)/); $label = $1; $value = $2; print "$label $value
\n"; } for (@rivit) { next unless (/^(---->)(.+)/); @rivi = ($1, $2); print "

$rivi[0] $rivi[1]

\n"; } print <<"EOT";

Edelliselle sivulle
Hakusivulle
EOT if ($kw) { print "Haetut sanat -sivulle
\n"; } print <<"EOT"; EOT $cgi->done; } sub sanahaku { my (@rivi, @rivit); my $komento; my ($match, $err, $before, $after); if ($R::kysely eq "ps") { $komento = "ps\r\n"; } elsif ($R::kysely eq "kw") { $komento = "/kw\r\n"; } elsif ($R::kysely =~ /^\d+$/) { $komento = $R::kysely } else { $komento = "w/$R::kysely\r\n"; $kw = 1; } print <<"EOT"; OULA-haun tulos

OULA-haun tulos

komento = $komento %% kysely = $R::kysely

EOT if ($R::kysely =~ /\*$/) { # Käyttäjä on katkaissut oikealta print $Proc_pty_handle $komento; while (1) { print "\n"; ($match, $err, $before, $after) = &expect($Proc_pty_handle, 15, 'Jatkatko hakua', 'Jatka painamalla', 'ASIASANAT[\0-\377]+Muu komento', '^\s*\d+\.[\0-\377]+Muu komento'); if (($match eq 'Jatkatko hakua') || ($match eq 'Jatka painamalla')) { print $Proc_pty_handle "\r\n"; } else { last; } } print "\n"; if ($match =~ /ASIASANAT/) { &sanahakuselaus($match); return; } else { # ($match, $err, $before, $after) = # &expect($Proc_pty_handle, 5, '^\s+\d+\.[\0-\377]+Muu komento'); @rivit = split(/\n/, $match); for (@rivit) { next unless (/^\s+(\d+)\.[\s*]+(.+) VIIT/); @rivi = ($1, $2, $3); print "\n"; next if ($rivi[2] == 4992); # Liian suuri tulosjoukko $rivi[1] =~ s#(\w+)#$1#; print <<"EOT"; EOT } } } else { # Käyttäjä ei ole katkaissut print $Proc_pty_handle $komento; ($match, $err, $before, $after) = &expect($Proc_pty_handle, 20, '\s+\d+\.[\0-\377]+Muu komento'); @rivit = split(/\n/, $match); for (@rivit) { next unless (/^\s+(\d+)\.[\s*]+(.+) VIIT/); @rivi = ($1, $2, $3); next if ($rivi[2] == 4992); # Liian suuri tulosjoukko $rivi[1] =~ s#(\w+)#$1#; print <<"EOT"; EOT } } print <<"EOT";

Viite	Hakusana	Teoksia kpl
$rivi[0]	$rivi[1]	$rivi[2]
$rivi[0]	$rivi[1]	$rivi[2]

Hakusivulle EOT $cgi->done; } sub sanahakuselaus { my $sivu = shift || ""; my ($match, $err, $before, $after); my (@rivi, @rivit); if ($sivu eq "") { print $Proc_pty_handle "$R::kysely\r\n"; ($match, $err, $before, $after) = &expect($Proc_pty_handle, 20, 'ASIASANAT[\0-\377]+Muu komento'); $sivu = $match; } print <<"EOT"; OULA - sanaluettelo

OULA - sanaluettelo

EOT @rivit = split(/\n/, $sivu); for (@rivit) { next unless (/^\s*(\d+)\.\s+(.+)\s+\d+\s+\d+\s+\d+\s+(\d+)/); @rivi = ($1, $2, $3); $rivi[1] =~ s#(\d+)#$1#; print <<"EOT"; EOT } print <<"EOT";

Viite	Sana	KPL
$rivi[0]	$rivi[1]	$rivi[2]

Edelliselle sivulle Seuraavalle sivulle Hakusivulle EOT $cgi->done; } ### PARENT print <<"EOT"; OULA-kirjastoluettelo

Yhdyskäytävä OULA-kirjastoluetteloon

Tervetuloa käyttämään Oulun yliopiston kirjaston OULA-kirjastoluetteloa tämän WWW-yhdyskäytävän kautta! Tämä on testiversio, joten toiminta on enemmän tai vähemmän epäluotettavaa.

Ota yhteys OULAan...tämä kestää hetkisen.

HUOM Älä käytä selaimen (esim. netscapen) Back-nappia kun palaat edelliselle sivulle, käytä sen sijaan sivun alalaidassa olevia linkkejä. Yhteys katkeaa itsestään, jos et tee mitään noin minuuttiin.

Tämä ohjelma voi lakata toimimasta milloin hyvänsä, sillä teen siihen koko ajan suurehkoja muutoksia. --Janne

webmaster\@clovis.oulu.fi

EOT $cgi->done(); $cgi->spawn and exit 0; ### CHILD CGI::Request::Interface($cgi); &init; while($req = GetRequest('R') or $cgi->exit){ # SendHeaders(); for ($req->param('sivu')) { /eka/ && do { &hakulomake; last; }; /^haku/ && do { &tee_haku; last; }; /^sanahaku$/ && do { &sanahaku; last; }; /^sanahakuselaus/ && do { &sanahakuselaus; last; }; /^lista2/ && do { &valitse_listasta2; last; }; /nide/ && do { &nide; last; }; /hylly/ && do { &hylly; last; }; /^ps/ && do { $R::valitse = "ps"; if ($R::kohde eq "lista2") { &valitse_listasta2; } elsif ($R::kohde eq "nide") { &nide; } elsif ($R::kohde eq "haku") { &tee_haku; } elsif ($R::kohde eq "sanahaku") { &sanahaku; } elsif ($R::kohde eq "sanahakuselaus") { &sanahakuselaus; } last; }; /^ns/ && do { $R::valitse = "ns"; if ($R::kohde eq "lista2") {&valitse_listasta2;} elsif ($R::kohde eq "haku") { &tee_haku; } elsif ($R::kohde eq "sanahaku") { &sanahaku; } elsif ($R::kohde eq "sanahakuselaus") { &sanahakuselaus; } last; }; } } $cgi->exit;