New wtcl command: wlog.
Optional timeout parameter to zwait.
# Europagate, 1995
#
# $Log: Makefile,v $
-# Revision 1.10 1995/11/07 10:44:29 adam
+# Revision 1.11 1995/11/07 14:56:58 adam
+# Work on search in multiple targets.
+# New wtcl command: wlog.
+# Optional timeout parameter to zwait.
+#
+# Revision 1.10 1995/11/07 10:44:29 adam
# Work on search in multiple targets.
#
# Revision 1.9 1995/11/06 17:44:20 adam
TCLLIB=/usr/local/lib/libtcl7.4.a
#
WSCRIPTS=egwscript targets.egw query.egw search.egw showfull.egw z39util.tcl \
- mtargets.egw
+ mtargets.egw mquery.egw msearch.egw
HSCRIPTS=egwindex.html
CONFFILES=ztargets.conf
GIFFILES=webgate.gif
--- /dev/null
+<html>
+<head>
+<title> WWW/Z39.50 Gateway Query Form</title>
+</head>
+<body>
+{
+# $Id: mquery.egw,v 1.1 1995/11/07 14:56:58 adam Exp $
+
+ if {[info commands saveState] == ""} {
+ source z39util.tcl
+ }
+
+ global setNo
+ global nextSetNo
+ global hist
+
+ html {<form action="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
+ html / $sessionId {/msearch.egw/} $setNo {" method=post>} \n
+
+ if {[catch {set setNo $nextSetNo}]} {
+ set nextSetNo 1
+ set setNo 1
+ }
+ set hosts [wform target]
+ html "hosts=$hosts <br>\n"
+ set i 1
+ foreach host $hosts {
+ set hist($setNo,$i,host) $host
+ set hist($setNo,$i,database) [lindex [lindex $targets($host) 1] 0]
+ incr i
+ }
+ set hist($setNo,0,host) [expr $i - 1]
+ set host [lindex $hosts 0]
+}
+<hr>
+<h3>Input your search criteria: </h3> <br>
+{
+ set fields [lindex $targets($host) 2]
+ for {set no 1} {$no < 4} {incr no} {
+ html {<select name="menu} $no {">} \n
+ foreach f $fields {
+ html {<option> } [lindex $f 0] \n
+ }
+ html "</select>\n"
+ html {<input type="text" name="entry} $no {" size=30>} \n
+ if {$no < 3} {
+ html {<select name="logic} $no {">} \n
+ html "<option> And\n"
+ html "<option> Or\n"
+ html "<option> And not\n"
+ html "</select>\n"
+ }
+ html "<br>\n"
+ }
+}
+<h3> Various technical parameters: </h3> <br>
+Max hits: <input type="text" name="hits" value="10" size=3>
+Records are shown in:
+<select name="format">
+<option> Long format
+<option> Medium format
+<option> Short format
+<option> Raw MARC
+</select>
+<br>
+<p>
+<input type="submit" value="Send Query">
+</form>
+<hr>
+This page is maintained by <a href="mailto:pwh@dtv.dk"> Peter Wad Hansen </a>.
+Last modified 29. september 1995. <br>
+<em> This and the following pages are under construction
+and will continue to be so until the end of December 1995.</em>
+<hr>
+
+{
+ html {<a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
+ html / $sessionId {/mtargets.egw"> New target </a>}
+}
+{
+ html "<hr>\n"
+ html "<h3>Debug information</h3>\n"
+ html "sessionId: $sessionId <br>\n"
+ html "sessionParms: $sessionParms <br>\n"
+ foreach e {SERVER_NAME PATH_INFO SCRIPT_NAME} {
+ html $e {: } $env($e) {<br>} \n
+ }
+ html "form: " [wform] " <br>\n"
+ html "target: " $host " <br>\n"
+ html "setNo: " $setNo " <br>\n"
+ html "nextSetNo: " $nextSetNo " <br>\n"
+}
+</body></html>
--- /dev/null
+<html>
+{
+# $Id: msearch.egw,v 1.1 1995/11/07 14:56:58 adam Exp $
+
+ if {[info commands saveState] == ""} {
+ source z39util.tcl
+ }
+ global sessionWait
+ global nextSetNo
+ global setNo
+ global hist
+ global zstatus
+
+ if {[wform menu1] == ""} {
+ set setNo [lindex $sessionParms 0]
+ } else {
+ if {![info exists hist($nextSetNo,0,host)]} {
+ set hist($nextSetNo,0,host) $hist($setNo,0,host)
+ for {set i 1} {$i <= $hist($setNo,0,host)} {incr i} {
+ set hist($nextSetNo,$i,host) $hist($setNo,$i,host)
+ set hist($nextSetNo,$i,database) $hist($setNo,$i,database)
+ }
+ }
+ set setNo $nextSetNo
+ incr nextSetNo
+
+ for {set i 1} {$i <= $hist($setNo,0,host)} {incr i} {
+ set hist($setNo,$i,query) [build-query $hist($setNo,$i,host)]
+ }
+ set hist($setNo,maxPresent) [wform hits]
+ if {$hist($setNo,maxPresent) == ""} {
+ set hist($setNo,maxPresent) 30
+ }
+ }
+ html "<head><title> WWW/Z39.50 Gateway Search </title>\n"
+ html "</head><body>\n"
+
+ z39msearch $setNo 1
+
+ html "<dl>\n"
+ set not $hist($setNo,0,host)
+ for {set i 1} {$i <= $not} {incr i} {
+ if {$zstatus($i) != 2} continue
+ html "<dt> " $hist($setNo,$i,host) ": "
+ set status [z39$i.$setNo responseStatus]
+ if {[lindex $status 0] == "NSD"} {
+ z39$i.$setNo nextResultSetPosition 0
+ set code [lindex $status 1]
+ set msg [lindex $status 2]
+ set addinfo [lindex $status 3]
+ html "Error\n<dd>NSD$code: $msg: $addinfo"
+ } else {
+ set r [z39$i.$setNo resultCount]
+ html "$r hits\n<dd>\n"
+
+ display-rec 1 $hist($setNo,$i,offset) display-brief z39$i
+ }
+ html "\n"
+ }
+ html "</dl>\n"
+}
+
+
+<hr>
+{
+ html {<a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
+ html / $sessionId {/mtargets.egw"> New target </a>} " | \n"
+ html {<a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
+ html / $sessionId {/mquery.egw/} $host + $setNo {"> New query </a>}
+}
+
+{
+ html "<hr>\n"
+ html "<h3>Debug information</h3>\n"
+ html "sessionId: $sessionId <br>\n"
+ html "sessionParms: $sessionParms <br>\n"
+ foreach e {SERVER_NAME PATH_INFO SCRIPT_NAME} {
+ html $e {: } $env($e) {<br>} \n
+ }
+ html "form: " [wform] " <br>\n"
+ html "target: " $host " <br>\n"
+ html "query: --" $hist($setNo,1,query) "-- <br>"
+ html "setNo: " $setNo " <br>\n"
+ html "nextSetNo: " $nextSetNo " <br>\n"
+}
+
+</body>
+</html>
<html>
{
-# $Id: mtargets.egw,v 1.1 1995/11/07 10:44:31 adam Exp $
+# $Id: mtargets.egw,v 1.2 1995/11/07 14:56:58 adam Exp $
set setNo 1
source /usr/local/etc/httpd/conf/ztargets.conf
if {[info commands saveState] == ""} {
<h3>Choose one or more Z39.50 targets:</h3>
{
html {<form action="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
- html / $sessionId {/msearch.egw/} $setNo {" method=post><br>} \n
+ html / $sessionId {/mquery.egw/} $setNo {" method=post><br>} \n
foreach t [array names targets] {
html {<input type="checkbox" name="target" value="} $t
html {"> } $t \n
<html>
{
-# $Id: search.egw,v 1.8 1995/11/06 17:44:21 adam Exp $
+# $Id: search.egw,v 1.9 1995/11/07 14:56:59 adam Exp $
if {[info commands saveState] == ""} {
source z39util.tcl
html "using host " $hist($setNo,host) " <br\n"
incr nextSetNo
- set hist($setNo,query) [build-query]
+ set hist($setNo,query) [build-query $hist($setNo,host)]
set b [wform base]
if {$b == ""} {
set hist($setNo,database) $databases
html "<h2> Search result $r hits</h2>\n"
wflush
set setOffset [z39.$setNo numberOfRecordsReturned]
- display-rec 1 $setOffset display-brief
+ display-rec 1 $setOffset display-brief z39
incr setOffset
set setMax [z39.$setNo resultCount]
if {$setMax > $hist($setNo,maxPresent)} {
<html>
{
-# $Id: showfull.egw,v 1.3 1995/11/06 17:44:21 adam Exp $
+# $Id: showfull.egw,v 1.4 1995/11/07 14:56:59 adam Exp $
if {[info commands saveState] == ""} {
source z39util.tcl
{
z39present $setNo $no $no display-full
-# display-full z39.$sno $no
}
<hr>
{
* USE OR PERFORMANCE OF THIS SOFTWARE.
*
* $Log: wirtcl.c,v $
- * Revision 1.8 1995/11/06 17:44:22 adam
+ * Revision 1.9 1995/11/07 14:56:59 adam
+ * Work on search in multiple targets.
+ * New wtcl command: wlog.
+ * Optional timeout parameter to zwait.
+ *
+ * Revision 1.8 1995/11/06 17:44:22 adam
* State reestablised when shell restarts. History of previous
* result sets.
*
};
-static int events (struct tcl_info *p, char *waitVar);
+static int events (struct tcl_info *p, char *waitVar, int tout);
static int proc_zwait_invoke (ClientData clientData, Tcl_Interp *interp,
int argc, char **argv)
if (argc < 2)
return TCL_OK;
- events (p, argv[1]);
- return TCL_OK;
+ return events (p, argv[1], (argc == 3) ? atoi(argv[2]) : 0);
}
}
-static int events (struct tcl_info *p, char *waitVar)
+static int events (struct tcl_info *p, char *waitVar, int tout)
{
int r, i;
char *cp;
gw_log (GW_LOG_DEBUG, mod, "Waiting %s=%s", waitVar, waitVarVal);
while (1)
{
+ struct timeval to, *top;
+ if (tout > 0)
+ {
+ to.tv_usec = 0;
+ to.tv_sec = tout;
+ top = &to;
+ }
+ else
+ top = 0;
+
if (!(cp = Tcl_GetVar (p->interp, waitVar, 0)) ||
strcmp (cp, waitVarVal))
{
FD_SET (fifo_in, &fdset_tcl_r);
#endif
if ((r = select(max_fd+1, &fdset_tcl_r, &fdset_tcl_w,
- &fdset_tcl_x, NULL)) < 0)
+ &fdset_tcl_x, top)) < 0)
{
gw_log (GW_LOG_ERRNO|GW_LOG_FATAL, mod, "select");
exit(1);
if (!r)
{
gw_log (GW_LOG_DEBUG, mod, "timeout");
- break;
+ free (waitVarVal);
+ return TCL_ERROR;
}
if (FD_ISSET (fifo_in, &fdset_tcl_r))
{
gw_log (GW_LOG_DEBUG, mod, "FIFO closed");
- break;
+ free (waitVarVal);
+ return TCL_ERROR;
}
for (i=0; i<=max_fd; i++)
{
* USE OR PERFORMANCE OF THIS SOFTWARE.
*
* $Log: wtcl.c,v $
- * Revision 1.8 1995/11/06 17:44:23 adam
+ * Revision 1.9 1995/11/07 14:57:00 adam
+ * Work on search in multiple targets.
+ * New wtcl command: wlog.
+ * Optional timeout parameter to zwait.
+ *
+ * Revision 1.8 1995/11/06 17:44:23 adam
* State reestablised when shell restarts. History of previous
* result sets.
*
return TCL_OK;
}
+static int proc_wlog_invoke (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ unsigned mask;
+
+ if (argc < 3)
+ return TCL_OK;
+ if (!strcmp (argv[1], "debug"))
+ mask = GW_LOG_DEBUG;
+ else if (!strcmp (argv[1], "fatal"))
+ mask = GW_LOG_FATAL;
+ else if (!strcmp (argv[1], "warn"))
+ mask = GW_LOG_WARN;
+ else if (!strcmp (argv[1], "acct"))
+ mask = GW_LOG_ACCT;
+ else
+ mask = GW_LOG_DEBUG;
+ switch (argc)
+ {
+ case 3:
+ gw_log (mask, mod, "%s", argv[2]);
+ break;
+ case 4:
+ gw_log (mask, mod, "%s %s", argv[2], argv[3]);
+ break;
+ case 5:
+ gw_log (mask, mod, "%s %s %s", argv[2], argv[3], argv[4]);
+ break;
+ case 6:
+ gw_log (mask, mod, "%s %s %s %s", argv[2], argv[3], argv[4], argv[5]);
+ break;
+ }
+ return TCL_OK;
+}
+
+
int Tcl_AppInit (Tcl_Interp *interp)
{
if (Tcl_Init (interp) == TCL_ERROR)
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);
+ Tcl_CreateCommand (p->interp, "wlog", proc_wlog_invoke, p, NULL);
sprintf (tmp_str, "%d", wcl->id);
Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY);
return p;
#
-# $Id: z39util.tcl,v 1.1 1995/11/06 17:44:23 adam Exp $
+# $Id: z39util.tcl,v 1.2 1995/11/07 14:57:00 adam Exp $
#
proc saveState {} {
uplevel #0 {
}
}
-proc display-rec {from to dfunc} {
+proc display-rec {from to dfunc zz} {
global setNo
while {$from <= $to} {
- eval "$dfunc z39.$setNo $from"
+ eval "$dfunc $zz.$setNo $from"
incr from
}
}
-proc build-query {} {
+proc build-query {t} {
global targets
- global t
set op {}
set q {}
return 1
}
+proc init-m-response {i} {
+ global zstatus
+ global zleft
+
+ wlog debug "init-m-response"
+
+ set zstatus($i) 1
+ incr zleft -1
+}
+
+proc connect-m-response {i} {
+ global zstatus
+ global zleft
+
+ wlog debug "connect-m-response"
+ z39$i callback [list init-m-response $i]
+ if {[catch {z39$i init}]} {
+ set zstatus($i) -1
+ incr zleft -1
+ }
+}
+
+proc fail-m-response {i} {
+ global zstatus
+ global zleft
+
+ wlog debug "fail-m-response"
+ set zstatus($i) -1
+ incr zleft -1
+}
+
+proc search-m-response {setNo i} {
+ global zleft
+ global zstatus
+
+ incr zleft -1
+ set zstatus($i) 2
+}
+
+proc z39msearch {setNo piggy} {
+ global zleft
+ global zstatus
+ global hist
+
+ set not $hist($setNo,0,host)
+
+ for {set i 1} {$i <= $not} {incr i} {
+ set host $hist($setNo,$i,host)
+ if {[catch {z39 failback fail-response}]} {
+ ir z39$i
+ }
+ if {[catch {set oldHost [z39$i connect]}]} {
+ set oldHost ""
+ }
+ if {$oldHost != $host} {
+ catch {z39$i disconnect}
+ }
+ z39$i callback [list connect-m-response $i]
+ z39$i failback [list fail-m-response $i]
+ }
+ set zleft 0
+ for {set i 1} {$i <= $not} {incr i} {
+ set oldHost [z39$i connect]
+ set host $hist($setNo,$i,host)
+ if {$oldHost == $host} {
+ set zstatus($i) 1
+ continue
+ }
+ html "Connecting to target " $host " <br>\n"
+ set zstatus($i) -1
+ if {![catch {z39$i connect $host}]} {
+ incr zleft
+ }
+ }
+ while {$zleft > 0} {
+ wlog debug "Waiting for init response"
+ if {[catch {zwait zleft 10}]} {
+ break
+ }
+ }
+ set zleft 0
+ for {set i 1} {$i <= $not} {incr i} {
+ html "host " $hist($setNo,$i,host) ": "
+ if {$zstatus($i) >= 1} {
+ html "ok <br>\n"
+ ir-set z39$i.$setNo z39$i
+ set hist($setNo,$i,offset) 0
+ eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
+ z39$i.$setNo preferredRecordSyntax USMARC
+ z39$i callback [list search-m-response $setNo $i]
+
+ if {$piggy} {
+ z39$i.$setNo largeSetLowerBound 999999
+ z39$i.$setNo smallSetUpperBound 0
+ z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
+ } else {
+ z39$i.$setNo largeSetLowerBound 2
+ z39$i.$setNo smallSetUpperBound 0
+ z39$i.$setNo mediumSetPresentNumber 0
+ }
+ set zstatus($i) 1
+ wlog debug "search " $hist($setNo,$i,query)
+ z39$i.$setNo search $hist($setNo,$i,query)
+ incr zleft
+ } else {
+ html "fail <br>\n"
+ }
+ }
+ while {$zleft > 0} {
+ wlog debug "Waiting for search response"
+ if {[catch {zwait zleft 30}]} {
+ break
+ }
+ }
+ for {set i 1} {$i <= $not} {incr i} {
+ if {$zstatus($i) != 2} continue
+ set status [z39$i.$setNo responseStatus]
+ if {[lindex $status 0] != "NSD"} {
+ set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
+ }
+ }
+}
+
proc z39present {setNo setOffset setMax dfunc} {
global hist
global sessionWait
projects / egate.git / commitdiff