From 4a4288c5b72d694c1ca2c1c08926d1e10f01cc48 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Tue, 31 Oct 1995 10:03:51 +0000 Subject: [PATCH] Work on queries. New command implemented - aborts script. --- www/query.egw | 79 ++++++++++++++++++++++++++------------------------ www/search.egw | 88 +++++++++++++++++++++++++++++++++++++++++++++++++------- www/wirtcl.c | 33 +++++++++++++++------ www/wtcl.c | 20 ++++++++++++- 4 files changed, 162 insertions(+), 58 deletions(-) diff --git a/www/query.egw b/www/query.egw index 319d5f1..1677291 100644 --- a/www/query.egw +++ b/www/query.egw @@ -4,7 +4,7 @@ { -# $Id: query.egw,v 1.4 1995/10/30 17:35:17 adam Exp $ +# $Id: query.egw,v 1.5 1995/10/31 10:03:51 adam Exp $ proc fail-response {} { global sessionWait set sessionWait -1 @@ -17,13 +17,14 @@ proc init-response {} { set t $sessionParms set databases [lindex $targets($t) 1] + catch {z39 disconnect} set sessionWait 0 ir z39 z39 failback fail-response if {[catch {z39 connect $t}]} { htmlr "Cannot connect to target $t
" htmlr "" - return + wabort } z39 callback init-response z39 init @@ -31,7 +32,7 @@ proc init-response {} { if {$sessionWait == -1} { htmlr "Cannot initialize with target $t
" htmlr "" - return + wabort } htmlr {

Search in databases

@@ -61,8 +62,10 @@ proc init-response {} { htmlr [concat $databases] {"> All
} } } - htmlr {
} - htmlr {Input your search criteria:
} +} +
+Input your search criteria:
+{ set fields [lindex $targets($t) 2] for {set no 1} {$no < 4} {incr no} { htmlr {
-
- Various technical parameters:
- Max hits: - Records are shown in: - -
-

- - -

- This page is maintained by - Peter Wad Hansen . - Last modified 29. september 1995.
- This and the following pages are under construction - and will continue to be so until the end of December 1995. -
- } - htmlr {sessionId: } $sessionId {
} - htmlr {sessionParms: } $sessionParms {
} +} +

+Alternatively you can enter your query in + CCL here:
+
+

+ Various technical parameters:
+Max hits: +Records are shown in: + +
+

+ + +

+This page is maintained by Peter Wad Hansen . +Last modified 29. september 1995.
+ This and the following pages are under construction +and will continue to be so until the end of December 1995. +
+sessionId: {html $sessionId}
+sessionParms: {html $sessionParms}
+{ foreach e {SERVER_NAME PATH_INFO SCRIPT_NAME} { htmlr $e {: } $env($e) {
} } - htmlr {form: } [form] {
} - htmlr {target: } $t {
} - htmlr {databases: } $databases {
} - htmlr {} -} \ No newline at end of file +} +form: {html [form]}
+target: {html $t}
+databases: {html $databases}
+ diff --git a/www/search.egw b/www/search.egw index be30940..71f4cb0 100644 --- a/www/search.egw +++ b/www/search.egw @@ -1,8 +1,8 @@ { -# $Id: search.egw,v 1.3 1995/10/30 17:35:18 adam Exp $ +# $Id: search.egw,v 1.4 1995/10/31 10:03:53 adam Exp $ -proc search-response {} { +proc ok-response {} { global sessionWait set sessionWait 1 } @@ -12,32 +12,100 @@ proc fail-response {} { set sessionWait -1 } +proc display-rec {from to} { + while {$from < $to} { + htmlr {} $from {
} + 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 { } $year {
} + } + incr from + } +} + +proc build-query {} { + global targets + global t + + set op {} + set q {} + for {set i 1} {$i < 4} {incr i} { + set term [form entry$i] + if {$term != ""} { + set field [form menu$i] + foreach x [lindex $targets($t) 2] { + if {[lindex $x 0] == $field} { + set attr [lindex $x 1] + } + } + switch $op { + And + { set q "@and $q ${attr} ${term}" } + Or + { set q "@or $q ${attr} ${term}" } + {And not} + { set q "@not $q ${attr} ${term}" } + {} + { set q "${attr} ${term}" } + } + set op [form logic$i] + } + } + return $q +} + global sessionWait - z39 callback search-response + z39 callback ok-response z39 failback fail-response set sessionWait 0 ir-set z39.1 z39 z39.1 databaseNames [form base] - z39.1 search [form entry1] htmlr { WWW/Z39.50 Gateway Search } $t { } htmlr {} + set query [build-query] + htmlr {query: } $query {
} + z39.1 search $query htmlr {sessionId: } $sessionId {
} htmlr {sessionParms: } $sessionParms {
} htmlr {form: } [form] {
} htmlr {databases: } $databases {
} zwait sessionWait if {$sessionWait == 1} { - set r [z39.1 resultCount] - htmlr { } $r { hits
} - htmlr {} + set r [z39.1 resultCount] + htmlr { } $r { hits
} } else { set status [z39.1 searchStatus] set msg [lindex $status 2] set addinfo [lindex $status 3] html {Search fail: } $msg - if ($msg != ""} { - html {,} $addinfo + if {$msg != ""} { + html {, } $addinfo + } + htmlr {
} + wabort + } + set setOffset [z39.1 numberOfRecordsReturned] + display-rec 0 $setOffset + set setMax [z39.1 resultCount] + if {$setMax > 30} { + set setMax 30 + } + set toGet [expr $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 + zwait sessionWait + if {$sessionWait != "1"} { + break } - htmlr {
} } +} + + diff --git a/www/wirtcl.c b/www/wirtcl.c index cae84ee..fcb49ff 100644 --- a/www/wirtcl.c +++ b/www/wirtcl.c @@ -41,7 +41,11 @@ * USE OR PERFORMANCE OF THIS SOFTWARE. * * $Log: wirtcl.c,v $ - * Revision 1.3 1995/10/30 17:35:18 adam + * Revision 1.4 1995/10/31 10:03:53 adam + * Work on queries. + * New command implemented - aborts script. + * + * Revision 1.3 1995/10/30 17:35:18 adam * New function zwait that waits for a variable change - due to i/o events * that invoke callback routines. * @@ -164,12 +168,15 @@ static int do_exec (const char *fname, char *parms, void *mydata) static int events (struct tcl_info *p, char *waitVar) { - int r, i, min_fd = 0; + int r, i; char *cp; char *waitVarVal; static fd_set fdset_tcl_r; static fd_set fdset_tcl_w; static fd_set fdset_tcl_x; + int fifo_in = p->wcl->linein; + if (fifo_in > max_fd) + max_fd = fifo_in; assert (waitVar); if ((cp = Tcl_GetVar (p->interp, waitVar, 0))) @@ -179,8 +186,12 @@ static int events (struct tcl_info *p, char *waitVar) } else { - gw_log (GW_LOG_WARN, mod, "Variable %s doesn't exist", waitVar); - return 0; + char msg[128]; + + sprintf (msg, "Variable %s doesn't exist", waitVar); + gw_log (GW_LOG_WARN, mod, "%s", msg); + Tcl_AppendResult (p->interp, msg, NULL); + return TCL_ERROR; } gw_log (GW_LOG_DEBUG, mod, "Waiting for variable %s=%s", waitVar, waitVarVal); @@ -189,14 +200,15 @@ static int events (struct tcl_info *p, char *waitVar) if (!(cp = Tcl_GetVar (p->interp, waitVar, 0)) || strcmp (cp, waitVarVal)) { + Tcl_AppendResult (p->interp, cp, NULL); free (waitVarVal); - return 0; + return TCL_OK; } FD_ZERO (&fdset_tcl_r); FD_ZERO (&fdset_tcl_w); FD_ZERO (&fdset_tcl_x); - for (r=0, i=min_fd; i<=max_fd; i++) + for (r=0, i=0; i<=max_fd; i++) { if (callback_table[i].w_handle) { @@ -216,6 +228,7 @@ static int events (struct tcl_info *p, char *waitVar) } if (!r) break; + FD_SET (fifo_in, &fdset_tcl_r); if ((r = select(max_fd+1, &fdset_tcl_r, &fdset_tcl_w, &fdset_tcl_x, 0)) < 0) { @@ -223,8 +236,10 @@ static int events (struct tcl_info *p, char *waitVar) exit(1); } if (!r) - continue; - for (i=min_fd; i<=max_fd; i++) + break; + if (FD_ISSET (fifo_in, &fdset_tcl_r)) + break; + for (i=0; i<=max_fd; i++) { if (FD_ISSET (i, &fdset_tcl_r)) { @@ -244,7 +259,7 @@ static int events (struct tcl_info *p, char *waitVar) } } free (waitVarVal); - return 0; + return TCL_OK; } void ir_select_add (int fd, void *obj) diff --git a/www/wtcl.c b/www/wtcl.c index bd63995..f8273cb 100644 --- a/www/wtcl.c +++ b/www/wtcl.c @@ -41,7 +41,11 @@ * USE OR PERFORMANCE OF THIS SOFTWARE. * * $Log: wtcl.c,v $ - * Revision 1.5 1995/10/30 17:35:18 adam + * Revision 1.6 1995/10/31 10:03:54 adam + * Work on queries. + * New command implemented - aborts script. + * + * Revision 1.5 1995/10/30 17:35:18 adam * New function zwait that waits for a variable change - due to i/o events * that invoke callback routines. * @@ -88,6 +92,7 @@ struct tcl_info { char *fbuf; int fbuf_size; int fbuf_ptr; + int wabort; WCLIENT wcl; }; @@ -104,6 +109,15 @@ Tcl_Interp *w_interp_tcl_get (W_Interp w_interp) return p->interp; } +static int proc_wabort_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + struct tcl_info *p = (struct tcl_info*) clientData; + + p->wabort = 1; + return TCL_RETURN; +} + static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { @@ -179,6 +193,7 @@ static void *do_create (WCLIENT wcl, void *args) 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, "wabort", proc_wabort_invoke, p, NULL); sprintf (tmp_str, "%d", wcl->id); Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY); return p; @@ -244,12 +259,15 @@ static int tcl_exec (const char *fname, char *parms, p->fbuf[fbuf_ptr++] = c; } p->fbuf[fbuf_ptr] = '\0'; + p->wabort = 0; r = Tcl_Eval (p->interp, p->fbuf); if (r == TCL_ERROR) report_error (p, p->interp->errorLine + *lineno - 1, "Error in Tcl script in line", Tcl_GetVar (p->interp, "errorInfo", 0)); (*lineno) += local_line; + if (p->wabort) + return TCL_RETURN; return r; } -- 1.7.10.4