From fb42e8909c46dfe29d2b8d8852e0ebf297eb2963 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Mon, 30 Oct 1995 17:35:17 +0000 Subject: [PATCH] New function zwait that waits for a variable change - due to i/o events that invoke callback routines. --- www/query.egw | 114 +++++++++++++++++++++++++++++--------------------------- www/search.egw | 53 +++++++++++++------------- www/wirtcl.c | 64 ++++++++++++++++++++++++++----- www/wtcl.c | 18 +++++++-- 4 files changed, 155 insertions(+), 94 deletions(-) diff --git a/www/query.egw b/www/query.egw index 3f0d25f..319d5f1 100644 --- a/www/query.egw +++ b/www/query.egw @@ -1,42 +1,49 @@ + + WWW/Z39.50 Gateway Query Form + + { -# $Id: query.egw,v 1.3 1995/10/27 17:30:15 adam Exp $ +# $Id: query.egw,v 1.4 1995/10/30 17:35:17 adam Exp $ proc fail-response {} { global sessionWait - htmlr {Init fail
} - set sessionWait 0 + set sessionWait -1 } proc init-response {} { global sessionWait - htmlr {Init ok
} - htmlr {} - htmlr {} - set sessionWait 0 + set sessionWait 1 } set t $sessionParms set databases [lindex $targets($t) 1] - set sessionWait 1 + set sessionWait 0 ir z39 z39 failback fail-response - z39 connect $t + if {[catch {z39 connect $t}]} { + htmlr "Cannot connect to target $t
" + htmlr "" + return + } z39 callback init-response z39 init -} - - WWW/Z39.50 Gateway Query Form - - -

Search in databases

Not Functional Yet

-{ + zwait sessionWait + if {$sessionWait == -1} { + htmlr "Cannot initialize with target $t
" + htmlr "" + return + } + htmlr { +

Search in databases

Not Functional Yet

+ } html {

} set nodb [llength $databases] if {$nodb > 1} { if {$nodb > 2} { - htmlr {The chosen target supports searching in several databases.
} + html {The chosen target supports searching in } + htmlr {several databases.
} htmlr {Choose the bases you want to search:
} } set i 0 @@ -54,10 +61,8 @@ proc init-response {} { htmlr [concat $databases] {"> All
} } } -} -

-Input your search criteria:
-{ + htmlr {

} + htmlr {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. -

-sessionId: {html $sessionId}
-sessionParms: {html $sessionParms}
-{ + html {

+ 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. +

+ } + htmlr {sessionId: } $sessionId {
} + htmlr {sessionParms: } $sessionParms {
} foreach e {SERVER_NAME PATH_INFO SCRIPT_NAME} { htmlr $e {: } $env($e) {
} } -} -form: {html [form]}
-target: {html $t}
-databases: {html $databases}
+ htmlr {form: } [form] {
} + htmlr {target: } $t {
} + htmlr {databases: } $databases {
} + htmlr {} +} \ No newline at end of file diff --git a/www/search.egw b/www/search.egw index 7c0b84e..be30940 100644 --- a/www/search.egw +++ b/www/search.egw @@ -1,44 +1,43 @@ { -# $Id: search.egw,v 1.2 1995/10/27 17:30:16 adam Exp $ +# $Id: search.egw,v 1.3 1995/10/30 17:35:18 adam Exp $ proc search-response {} { global sessionWait - set sessionWait 0 - - htmlr "search response
" - set r [z39.1 resultCount] - htmlr "$r hits
" - htmlr "" + set sessionWait 1 } proc fail-response {} { global sessionWait - set sessionWait 0 - - htmlr "failed
" - htmlr "" + set sessionWait -1 } global sessionWait - z39 callback search-response z39 failback fail-response - set sessionWait 1 + set sessionWait 0 ir-set z39.1 z39 z39.1 databaseNames [form base] z39.1 search [form entry1] - htmlr - htmlr " WWW/Z39.50 Gateway Search Result ..." -} - - -sessionId: {html $sessionId}
-sessionParms: {html $sessionParms}
-form: {html [form]}
-target: {html $t}
-databases: {html $databases}
-

Search in databases

-{ - htmlr [form entry1]
-} + htmlr { WWW/Z39.50 Gateway Search } $t { } + htmlr {} + 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 {} + } else { + set status [z39.1 searchStatus] + set msg [lindex $status 2] + set addinfo [lindex $status 3] + html {Search fail: } $msg + if ($msg != ""} { + html {,} $addinfo + } + htmlr {
} + } + diff --git a/www/wirtcl.c b/www/wirtcl.c index f05500f..cae84ee 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.2 1995/10/27 17:30:16 adam + * 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. + * + * Revision 1.2 1995/10/27 17:30:16 adam * First search request/response that works. * * Revision 1.1 1995/10/27 15:12:08 adam @@ -87,6 +91,21 @@ struct tcl_info { }; +static int events (struct tcl_info *p, char *waitVar); + +static int proc_zwait_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + struct tcl_info *p = (struct tcl_info*) clientData; + + if (argc < 2) + return TCL_OK; + events (p, argv[1]); + return TCL_OK; +} + + + /* select(2) callbacks */ struct callback { void (*r_handle)(ClientData); @@ -122,6 +141,7 @@ static void *do_create (WCLIENT wcl, void *args) exit (1); } /* initialize irtcl */ + Tcl_CreateCommand (p->interp, "zwait", proc_zwait_invoke, p, NULL); for (i=0; iw_interp, fname, parms))) + return r; + return 0; +} + + +static int events (struct tcl_info *p, char *waitVar) +{ + int r, i, min_fd = 0; + char *cp; + char *waitVarVal; static fd_set fdset_tcl_r; static fd_set fdset_tcl_w; static fd_set fdset_tcl_x; - if ((r = w_interp_exec (p->w_interp, fname, parms))) - return r; + assert (waitVar); + if ((cp = Tcl_GetVar (p->interp, waitVar, 0))) + { + waitVarVal = malloc (strlen(cp)+1); + strcpy (waitVarVal, cp); + } + else + { + gw_log (GW_LOG_WARN, mod, "Variable %s doesn't exist", waitVar); + return 0; + } + gw_log (GW_LOG_DEBUG, mod, "Waiting for variable %s=%s", + waitVar, waitVarVal); while (1) { + if (!(cp = Tcl_GetVar (p->interp, waitVar, 0)) || + strcmp (cp, waitVarVal)) + { + free (waitVarVal); + return 0; + } FD_ZERO (&fdset_tcl_r); FD_ZERO (&fdset_tcl_w); FD_ZERO (&fdset_tcl_x); - - if ((cp=Tcl_GetVar (p->interp, "sessionWait", 0)) && !strcmp (cp, "0")) - return 0; + for (r=0, i=min_fd; i<=max_fd; i++) { if (callback_table[i].w_handle) @@ -170,7 +215,7 @@ static int do_exec (const char *fname, char *parms, void *mydata) } } if (!r) - return 0; + break; if ((r = select(max_fd+1, &fdset_tcl_r, &fdset_tcl_w, &fdset_tcl_x, 0)) < 0) { @@ -198,6 +243,7 @@ static int do_exec (const char *fname, char *parms, void *mydata) } } } + free (waitVarVal); return 0; } diff --git a/www/wtcl.c b/www/wtcl.c index 5255b66..bd63995 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.4 1995/10/27 17:30:16 adam + * 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. + * + * Revision 1.4 1995/10/27 17:30:16 adam * First search request/response that works. * * Revision 1.3 1995/10/27 15:12:14 adam @@ -216,7 +220,7 @@ static int tcl_exec (const char *fname, char *parms, { report_error (p, *lineno, "Error in Tcl script starting at line", "Unexpected EOF (missing right brace)"); - return -1; + return TCL_ERROR; } if (c == '\\') escape = 1; @@ -246,7 +250,7 @@ static int tcl_exec (const char *fname, char *parms, "Error in Tcl script in line", Tcl_GetVar (p->interp, "errorInfo", 0)); (*lineno) += local_line; - return 0; + return r; } static int do_exec (const char *fname, char *parms, void *mydata) @@ -273,7 +277,13 @@ static int do_exec (const char *fname, char *parms, void *mydata) wo_putc (p->wcl, c); else { - if (tcl_exec (fname, parms, p, inf, &lineno)) + int r = tcl_exec (fname, parms, p, inf, &lineno); + if (r == TCL_RETURN) + { + fclose (inf); + return 0; + } + else if (r == TCL_ERROR) { fclose (inf); return -2; -- 1.7.10.4