# Europagate, 1995
#
# $Log: Makefile,v $
-# Revision 1.6 1995/10/27 17:30:15 adam
+# Revision 1.7 1995/10/31 16:56:23 adam
+# Record presentation.
+#
+# Revision 1.6 1995/10/27 17:30:15 adam
# First search request/response that works.
#
# Revision 1.5 1995/10/27 15:12:02 adam
# First version of www gateway.
#
SHELL=/bin/sh
-INCLUDE=-I../include
#
+ZDEFS=
+ZINC=-I../../yaz/include
+ZLIB=../../yaz/lib/libyaz.a
MOSILIB=../../xtimosi/src/libmosi.a ../../yaz/lib/librfc.a
-LIBIRTCL=/usr/local/lib/libirtcl.a ../../yaz/lib/libyaz.a $(MOSILIB)
+LIBIRTCL=/usr/local/lib/libirtcl.a $(ZLIB) $(MOSILIB)
#
-#CFLAGS=-g -Wall -pedantic -ansi
OLIB=../lib/libres+log.a
TCLLIB=/usr/local/lib/libtcl7.4.a
-WSCRIPTS=egwscript targets.egw query.egw search.egw
+#
+WSCRIPTS=egwscript targets.egw query.egw search.egw showfull.egw
HSCRIPTS=egwindex.html
CONFFILES=ztargets.conf
GIFFILES=webgate.gif
P2=wproto.o winterp.o wsh.o wtcl.o whtml.o wirtcl.o
P3=wproto.o wtest.o
CPP=$(CC) -E
-DEFS=$(INCLUDE)
+#
+INCLUDE=-I../include $(ZINC)
+DEFS=$(INCLUDE) $(ZDEFS)
HTTPDDIR=/usr/local/etc/httpd
CGIBIN=$(HTTPDDIR)/cgi-bin
</head>
<body>
{
-# $Id: query.egw,v 1.5 1995/10/31 10:03:51 adam Exp $
+# $Id: query.egw,v 1.6 1995/10/31 16:56:23 adam Exp $
proc fail-response {} {
global sessionWait
set sessionWait -1
}
-proc init-response {} {
+proc ok-response {} {
global sessionWait
set sessionWait 1
}
- set t $sessionParms
- set databases [lindex $targets($t) 1]
+ global host
+ set host $sessionParms
+ set databases [lindex $targets($host) 1]
catch {z39 disconnect}
set sessionWait 0
ir z39
z39 failback fail-response
- if {[catch {z39 connect $t}]} {
- htmlr "Cannot connect to target $t <br>"
+ z39 callback ok-response
+ if {[catch {z39 connect $host}]} {
+ htmlr "Cannot connect to target ${host} <br>"
htmlr "</body></html>"
wabort
- }
- z39 callback init-response
+ } elseif {$sessionWait == 0} {
+ zwait sessionWait
+ if {$sessionWait != 1} {
+ htmlr "Cannot connect to target ${host} <br>"
+ htmlr "</body></html>"
+ wabort
+ }
+ }
+ set sessionWait 0
z39 init
zwait sessionWait
if {$sessionWait == -1} {
- htmlr "Cannot initialize with target $t <br>"
+ htmlr "Cannot initialize with target ${host} <br>"
htmlr "</body></html>"
wabort
}
- htmlr {
- <h2> Search in databases </h2>
- <h1> <blink> Not Functional Yet </blink> </h1>
- }
+ htmlr {<h2> Search in databases </h2>}
html {<form action="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
- htmlr / $sessionId {/search.egw" method=post>}
+ htmlr / $sessionId {/search.egw/} $host {" method=post>}
set nodb [llength $databases]
if {$nodb > 1} {
if {$nodb > 2} {
<hr>
<strong>Input your search criteria: </strong> <br>
{
- set fields [lindex $targets($t) 2]
+ set fields [lindex $targets($host) 2]
for {set no 1} {$no < 4} {incr no} {
htmlr {<select name="menu} $no {">}
foreach f $fields {
htmlr $e {: } $env($e) {<br>}
}
}
-form: {html [form]} <br>
-target: {html $t} <br>
+form: {html [wform]} <br>
+target: {html $host} <br>
databases: {html $databases} <br>
</body></html>
<html>
{
-# $Id: search.egw,v 1.4 1995/10/31 10:03:53 adam Exp $
+# $Id: search.egw,v 1.5 1995/10/31 16:56:24 adam Exp $
+
+proc search-response {} {
+ global sessionWait
+
+ set status [z39.1 responseStatus]
+ if {[lindex $status 0] == "NSD"} {
+ z39.1 nextResultSetPosition 0
+ set code [lindex $status 1]
+ set msg [lindex $status 2]
+ set addinfo [lindex $status 3]
+ htmlr {<strong>Error} $code {: } $msg {: } $addinfo { </strong><br>}
+ set sessionWait -2
+ } else {
+ set sessionWait 1
+ }
+}
proc ok-response {} {
global sessionWait
set sessionWait -1
}
-proc display-rec {from to} {
- while {$from < $to} {
- htmlr {<b>} $from {</b><br>}
- if {![catch {
- set title [lindex [z39.1 getMarc $from field 245 * a] 0]
- set year [lindex [z39.1 getMarc $from field 260 * c] 0]
- } ] } {
- htmlr $title { <i> } $year {</i><br>}
+proc display-brief {zset no} {
+ global env
+ global sessionId
+
+ set type [$zset type $no]
+ if {$type == "SD"} {
+ set err [lindex [$zset diag $no] 1]
+ set add [lindex [$zset diag $no] 2]
+ if {$add != {}} {
+ set add " :${add}"
+ }
+ htmlr "${no} Error ${err}${add} <br>"
+ return
+ }
+ if {$type != "DB"} {
+ return
+ }
+ html "${no} "
+ set rtype [$zset recordType $no]
+ if {$rtype == "SUTRS"} {
+ html [join [$zset getSutrs $no]]
+ htmlr {<br>}
+ return
+ }
+ if {![catch {
+ set title [lindex [$zset getMarc $no field 245 * a] 0]
+ set year [lindex [$zset getMarc $no field 260 * c] 0]
+ } ] } {
+ html {<a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME) /
+ html $sessionId {/showfull.egw/} $no {"> } $title {</a>}
+ html " <i> ${year} </i>"
+ }
+ htmlr {<br>}
+}
+
+proc display-full {zset no} {
+ set type [$zset type $no]
+ if {$type == "SD"} {
+ set err [lindex [$zset diag $no] 1]
+ set add [lindex [$zset diag $no] 2]
+ if {$add != {}} {
+ set add " :${add}"
+ }
+ htmlr "<hr> ${no} <br>"
+ htmlr "Error ${err}${add} <br>"
+ return
+ }
+ if {$type != "DB"} {
+ return
+ }
+ htmlr "<hr> ${no} <br>"
+ set rtype [$zset recordType $no]
+ if {$rtype == "SUTRS"} {
+ htmlr [join [$zset getSutrs $no]]
+ return
+ }
+ if {[catch {set r [$zset getMarc $no line * * *]}]} {
+ htmlr "Unknown record type: $rtype"
+ return
+ }
+ foreach line $r {
+ set tag [lindex $line 0]
+ set indicator [lindex $line 1]
+ set fields [lindex $line 2]
+ set l [string length $indicator]
+ html "$tag "
+ if {$l > 0} {
+ for {set i 0} {$i < $l} {incr i} {
+ if {[string index $tag $i] == " "} {
+ html "_"
+ } else {
+ html [string index $tag $i]
+ }
+ }
}
+ foreach field $fields {
+ set id [lindex $field 0]
+ set data [lindex $field 1]
+ if {$id != ""} {
+ html " <b>\$$id</b> "
+ }
+ html $data
+ }
+ htmlr {<br>}
+ }
+}
+
+proc display-rec {from to} {
+ while {$from <= $to} {
+ display-brief z39.1 $from
incr from
}
}
set op {}
set q {}
for {set i 1} {$i < 4} {incr i} {
- set term [form entry$i]
+ set term [wform entry$i]
if {$term != ""} {
- set field [form menu$i]
+ set field [wform menu$i]
foreach x [lindex $targets($t) 2] {
if {[lindex $x 0] == $field} {
set attr [lindex $x 1]
{}
{ set q "${attr} ${term}" }
}
- set op [form logic$i]
+ set op [wform logic$i]
}
}
return $q
}
global sessionWait
- z39 callback ok-response
- z39 failback fail-response
- set sessionWait 0
- ir-set z39.1 z39
- z39.1 databaseNames [form base]
- htmlr {<head><title> WWW/Z39.50 Gateway Search } $t { </title>}
+ global host
+
+ set newHost $sessionParms
+ set databases [lindex $targets($newHost) 1]
+
+ htmlr {<head><title> WWW/Z39.50 Gateway Search } $newHost { </title>}
htmlr {</head><body>}
+ wflush
+
+ if {[catch {z39 callback ok-response}]} {
+ ir z39
+ }
+ if {$newHost != $host} {
+ set host $newHost
+ z39 disconnect
+ z39 callback ok-response
+ z39 failback fail-response
+
+ htmlr {Connecting to target } $host { <br>}
+ set sessionWait 0
+ if {[catch {z39 connect $host}]} {
+ htmlr "Cannot connect to target ${host} <br>"
+ htmlr "</body></html>"
+ wabort
+ } elseif {$sessionWait == 0} {
+ zwait sessionWait
+ if {$sessionWait != 1} {
+ htmlr "Cannot connect to target ${host} <br>"
+ htmlr "</body></html>"
+ wabort
+ }
+ }
+ set sessionWait 0
+ z39 init
+ zwait sessionWait
+ if {$sessionWait != "1"} {
+ htmlr "Cannot initialize with target ${host} <br>"
+ htmlr "</body></html>"
+ wabort
+ }
+ }
+ ir-set z39.1 z39
+ set b [wform base]
+ if {$b == ""} {
+ z39.1 databaseNames [lindex $targets($host) 1]
+ } else {
+ z39.1 databaseNames [list $b]
+ htmlr {selected: } $b { <br>}
+ }
+ z39.1 preferredRecordSyntax USMARC
+
set query [build-query]
- htmlr {query: } $query {<br>}
- z39.1 search $query
+
+ htmlr {<hr>query: --} $query {-- <br>}
htmlr {sessionId: } $sessionId {<br>}
htmlr {sessionParms: } $sessionParms {<br>}
- htmlr {form: } [form] { <br>}
+ htmlr {form: } [wform] { <br>}
htmlr {databases: } $databases { <br>}
+ htmlr {selected: } [wform base] { <br><hr>}
+
+ z39 callback search-response
+ set sessionWait 0
+ z39.1 search $query
+
zwait sessionWait
if {$sessionWait == 1} {
set r [z39.1 resultCount]
- htmlr {<strong> } $r { hits</strong><br>}
+ htmlr {<strong> } $r { hits</strong><br><br>}
} else {
- set status [z39.1 searchStatus]
- set msg [lindex $status 2]
- set addinfo [lindex $status 3]
- html {<strong>Search fail: } $msg
- if {$msg != ""} {
- html {, } $addinfo
- }
- htmlr {</strong><br></body></html>}
+ htmlr {</body></html>}
wabort
}
set setOffset [z39.1 numberOfRecordsReturned]
- display-rec 0 $setOffset
+ display-rec 1 $setOffset
+ wflush
+ incr setOffset
set setMax [z39.1 resultCount]
if {$setMax > 30} {
set setMax 30
}
- set toGet [expr $setMax - $setOffset]
+ set toGet [expr 1 + $setMax - $setOffset]
while {$toGet > 0} {
- z39.1 present $setOffset $toGet
- set got [z39.1 numberOfRecordsReturned]
- display-rec $setOffset [expr $got + $setOffset]
- set $setOffset [expr $got + $setOffset]
- set toGet [expr $setMax - $setOffset]
set sessionWait 0
+ z39.1 present $setOffset $toGet
zwait sessionWait
if {$sessionWait != "1"} {
break
}
+ set got [z39.1 numberOfRecordsReturned]
+ display-rec $setOffset [expr $got + $setOffset - 1]
+ set setOffset [expr $got + $setOffset]
+ set toGet [expr 1 + $setMax - $setOffset]
+ wflush
}
}
</body>
--- /dev/null
+<html>
+{
+# $Id: showfull.egw,v 1.1 1995/10/31 16:56:24 adam Exp $
+
+ htmlr {<head><title> WWW/Z39.50 Gateway Record } $host { </title>}
+ htmlr {</head><body>}
+ wflush
+
+ set no $sessionParms
+
+ display-full z39.1 $no
+}
+</body>
+</html>
+
* USE OR PERFORMANCE OF THIS SOFTWARE.
*
* $Log: wcgi.c,v $
- * Revision 1.2 1995/10/23 16:55:36 adam
+ * Revision 1.3 1995/10/31 16:56:24 adam
+ * Record presentation.
+ *
+ * Revision 1.2 1995/10/23 16:55:36 adam
* A lot of changes - really.
*
* Revision 1.1 1995/10/20 11:49:25 adam
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
-#include <sys/types.h>
#include <fcntl.h>
#include <sys/stat.h>
+#include <sys/time.h>
+#include <sys/types.h>
+#ifdef AIX
+#include <sys/select.h>
+#endif
#define DEADSTRING "Your database server has terminated. To reactivate \
the server, please reload the server's 'front page'."
fatal("Internal error in server.");
}
gw_log (GW_LOG_DEBUG, prog, "Reading response.");
+
+#if 1
while ((data = read(linein, combuf, COMBUF)) > 0)
{
- if (write(1, combuf, data) < data)
- {
- gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, prog, "write");
- fatal("Internal server error.");
- }
+ gw_log (GW_LOG_DEBUG, prog, "Got %d bytes", data);
+ if (write(1, combuf, data) < data)
+ {
+ gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, prog, "write");
+ exit (1);
+ }
}
+#else
+ fcntl (linein, F_SETFL, O_NONBLOCK);
+ while (1)
+ {
+ fd_set s_input, s_output;
+ int r;
+
+ FD_ZERO(&s_input);
+ FD_ZERO(&s_output);
+ FD_SET(linein, &s_input);
+#if 0
+ FD_SET(1, &s_output);
+#endif
+ r = select (linein + 1, &s_input, &s_output, NULL, 0);
+ if (r <= 0)
+ {
+ gw_log (GW_LOG_ERRNO|GW_LOG_FATAL, prog, "select");
+ exit(1);
+ }
+ if (FD_ISSET (linein, &s_input))
+ {
+ data = read(linein, combuf, COMBUF);
+ if (data == 0)
+ break;
+ else if (data < 0)
+ {
+ gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, prog, "read");
+ exit (1);
+ }
+ gw_log (GW_LOG_DEBUG, prog, "Got %d bytes", data);
+ if (write(1, combuf, data) < data)
+ {
+ gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, prog, "write");
+ exit (1);
+ }
+ }
+ if (FD_ISSET (1, &s_output))
+ {
+ gw_log (GW_LOG_DEBUG, prog, "stdout closed");
+ break;
+ }
+ }
+#endif
if (data < 0)
{
gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, prog, "read");
- fatal("Internal server error.");
+ exit (1);
}
gw_log (GW_LOG_DEBUG, prog, "Cleaning up.");
close(linein);
* USE OR PERFORMANCE OF THIS SOFTWARE.
*
* $Log: wirtcl.c,v $
- * Revision 1.4 1995/10/31 10:03:53 adam
+ * Revision 1.5 1995/10/31 16:56:24 adam
+ * Record presentation.
+ *
+ * Revision 1.4 1995/10/31 10:03:53 adam
* Work on queries.
* New command implemented - aborts script.
*
#include <assert.h>
#include <ctype.h>
+#include <log.h>
#include "wtcl.h"
#include "wirtcl.h"
gw_log (GW_LOG_FATAL, mod, "Cannot make Irtcl_Interp");
exit (1);
}
+ log_init(LOG_ALL, "irtcl", "/usr/local/etc/httpd/logs/irtcl_log");
/* initialize irtcl */
Tcl_CreateCommand (p->interp, "zwait", proc_zwait_invoke, p, NULL);
for (i=0; i<MAX_CALLBACK; i++)
Tcl_AppendResult (p->interp, msg, NULL);
return TCL_ERROR;
}
- gw_log (GW_LOG_DEBUG, mod, "Waiting for variable %s=%s",
- waitVar, waitVarVal);
+ gw_log (GW_LOG_DEBUG, mod, "Waiting %s=%s", waitVar, waitVarVal);
while (1)
{
if (!(cp = Tcl_GetVar (p->interp, waitVar, 0)) ||
strcmp (cp, waitVarVal))
{
+ gw_log (GW_LOG_DEBUG, mod, "Changed to %s", cp);
Tcl_AppendResult (p->interp, cp, NULL);
free (waitVarVal);
return TCL_OK;
}
if (!r)
break;
+ gw_log (GW_LOG_DEBUG, mod, "fifo select %d", fifo_in);
FD_SET (fifo_in, &fdset_tcl_r);
if ((r = select(max_fd+1, &fdset_tcl_r, &fdset_tcl_w,
&fdset_tcl_x, 0)) < 0)
{
- perror("select");
+ gw_log (GW_LOG_ERRNO|GW_LOG_FATAL, mod, "select");
exit(1);
}
if (!r)
+ {
+ gw_log (GW_LOG_DEBUG, mod, "timeout");
break;
+ }
if (FD_ISSET (fifo_in, &fdset_tcl_r))
+ {
+ gw_log (GW_LOG_DEBUG, mod, "FIFO closed");
break;
+ }
for (i=0; i<=max_fd; i++)
{
if (FD_ISSET (i, &fdset_tcl_r))
* USE OR PERFORMANCE OF THIS SOFTWARE.
*
* $Log: wproto.c,v $
- * Revision 1.3 1995/10/27 15:12:10 adam
+ * Revision 1.4 1995/10/31 16:56:25 adam
+ * Record presentation.
+ *
+ * Revision 1.3 1995/10/27 15:12:10 adam
* IrTcl incorporated in the gateway.
* Better separation of script types.
* Z39.50 gateway scripts entered.
gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, mod, "open input %s", new->path);
exit(1);
}
+ gw_log (GW_LOG_DEBUG, mod, "init. linein=%d lineout=%d",
+ new->linein, new->lineout);
/* we put a handle on this so we get a blocking read when no peer */
if (open(new->path, O_WRONLY | O_NDELAY) < 0)
{
* USE OR PERFORMANCE OF THIS SOFTWARE.
*
* $Log: wtcl.c,v $
- * Revision 1.6 1995/10/31 10:03:54 adam
+ * Revision 1.7 1995/10/31 16:56:25 adam
+ * Record presentation.
+ *
+ * Revision 1.6 1995/10/31 10:03:54 adam
* Work on queries.
* New command implemented - aborts script.
*
return TCL_RETURN;
}
+static int proc_wflush_invoke (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ struct tcl_info *p = (struct tcl_info*) clientData;
+
+ wo_flush (p->wcl);
+ return TCL_OK;
+}
+
static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp,
int argc, char **argv)
{
return r;
}
-static int proc_form_invoke (ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv)
+static int proc_wform_invoke (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
{
struct tcl_info *p = (struct tcl_info*) clientData;
int i;
if (argc == 2)
{
- Tcl_AppendResult (p->interp, wgetval (p->wcl, argv[1]), NULL);
+ for (i = 0; *p->wcl->wf_data[i].name; i++)
+ if (!strcmp (argv[1], p->wcl->wf_data[i].name) &&
+ *p->wcl->wf_data[i].value)
+ Tcl_AppendElement (p->interp, p->wcl->wf_data[i].value);
return TCL_OK;
}
for (i = 0; *p->wcl->wf_data[i].name; i++)
Tcl_AppInit (p->interp);
Tcl_CreateCommand (p->interp, "html", proc_html_invoke, p, NULL);
Tcl_CreateCommand (p->interp, "htmlr", proc_htmlr_invoke, p, NULL);
- Tcl_CreateCommand (p->interp, "form", proc_form_invoke, p, NULL);
+ Tcl_CreateCommand (p->interp, "wform", proc_wform_invoke, p, NULL);
Tcl_CreateCommand (p->interp, "wabort", proc_wabort_invoke, p, NULL);
+ Tcl_CreateCommand (p->interp, "wflush", proc_wflush_invoke, p, NULL);
sprintf (tmp_str, "%d", wcl->id);
Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY);
return p;
-# $Id: ztargets.conf,v 1.2 1995/10/27 15:12:15 adam Exp $
+# $Id: ztargets.conf,v 1.3 1995/10/31 16:56:25 adam Exp $
set commonFields {
{ Title {@attr 1=4} }
{ Author {@attr 1=1003} }
set targets(localhost:9999) [list \
ztest9999 \
- Default \
+ {ABE BETA} \
+ $commonFields \
+]
+
+set targets(dtbsun.dtv.dk:2100) [list \
+ zserver \
+ {usgs esdd} \
+ $commonFields \
+]
+
+set targets(z3950.research.att.com) [list \
+ {AT&T Z39.50 Server} \
+ {Default} \
$commonFields \
]