that invoke callback routines.
<html>
+<head>
+<title> WWW/Z39.50 Gateway Query Form</title>
+</head>
+<body>
{
-# $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<br>}
- set sessionWait 0
+ set sessionWait -1
}
proc init-response {} {
global sessionWait
- htmlr {Init ok <br>}
- htmlr {</body>}
- htmlr {</html>}
- 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 <br>"
+ htmlr "</body></html>"
+ return
+ }
z39 callback init-response
z39 init
-}
-<head>
-<title> WWW/Z39.50 Gateway Query Form</title>
-</head>
-<body>
-<h2> Search in databases </h2>
-<h1> <blink> Not Functional Yet </blink> </h1>
-{
+ zwait sessionWait
+ if {$sessionWait == -1} {
+ htmlr "Cannot initialize with target $t <br>"
+ htmlr "</body></html>"
+ return
+ }
+ htmlr {
+ <h2> Search in databases </h2>
+ <h1> <blink> Not Functional Yet </blink> </h1>
+ }
html {<form action="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
htmlr / $sessionId {/search.egw" method=post>}
set nodb [llength $databases]
if {$nodb > 1} {
if {$nodb > 2} {
- htmlr {The chosen target supports searching in several databases. <br>}
+ html {The chosen target supports searching in }
+ htmlr {several databases. <br>}
htmlr {Choose the bases you want to search: <br>}
}
set i 0
htmlr [concat $databases] {"> All <br>}
}
}
-}
-<hr>
-<strong>Input your search criteria: </strong> <br>
-{
+ htmlr {<hr>}
+ htmlr {<strong>Input your search criteria: </strong> <br>}
set fields [lindex $targets($t) 2]
for {set no 1} {$no < 4} {incr no} {
htmlr {<select name="menu} $no {">}
}
htmlr <br>
}
-}
-<hr>
-<p>
-Alternatively you can enter your query in <a href="ccl.html"> CCL </a> here: <br>
-<input type=text name="cclentry" size=60> <br>
-<hr>
-<strong> Various technical parameters: </strong> <br>
-Max hits: <input type="text" name="hits" value="50" 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>
-sessionId: {html $sessionId} <br>
-sessionParms: {html $sessionParms} <br>
-{
+ html {<hr><p>
+ Alternatively you can enter your query
+ in <a href="ccl.html"> CCL </a> here: <br>
+ <input type=text name="cclentry" size=60> <br>
+ <hr>
+ <strong> Various technical parameters: </strong> <br>
+ Max hits: <input type="text" name="hits" value="50" 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>
+ }
+ htmlr {sessionId: } $sessionId { <br>}
+ htmlr {sessionParms: } $sessionParms { <br>}
foreach e {SERVER_NAME PATH_INFO SCRIPT_NAME} {
htmlr $e {: } $env($e) {<br>}
}
-}
-form: {html [form]} <br>
-target: {html $t} <br>
-databases: {html $databases} <br>
+ htmlr {form: } [form] {<br>}
+ htmlr {target: } $t { <br>}
+ htmlr {databases: } $databases { <br>}
+ htmlr {</body></html>}
+}
\ No newline at end of file
<html>
{
-# $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 <br>"
- set r [z39.1 resultCount]
- htmlr "<strong>$r hits</strong><br>"
- htmlr "</body></html>"
+ set sessionWait 1
}
proc fail-response {} {
global sessionWait
- set sessionWait 0
-
- htmlr "<strong>failed</strong><br>"
- htmlr "</body></html>"
+ 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 <head>
- htmlr "<title> WWW/Z39.50 Gateway Search Result ...</title>"
-}
-</head>
-<body>
-sessionId: {html $sessionId} <br>
-sessionParms: {html $sessionParms} <br>
-form: {html [form]} <br>
-target: {html $t} <br>
-databases: {html $databases} <br>
-<h2> Search in databases </h2>
-{
- htmlr [form entry1] <br>
-}
+ htmlr {<head><title> WWW/Z39.50 Gateway Search } $t { </title>}
+ htmlr {</head><body>}
+ htmlr {sessionId: } $sessionId {<br>}
+ htmlr {sessionParms: } $sessionParms {<br>}
+ htmlr {form: } [form] { <br>}
+ htmlr {databases: } $databases { <br>}
+ zwait sessionWait
+ if {$sessionWait == 1} {
+ set r [z39.1 resultCount]
+ htmlr {<strong> } $r { hits</strong><br>}
+ htmlr {</body></html>}
+ } 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>}
+ }
+
* 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
};
+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);
exit (1);
}
/* initialize irtcl */
+ Tcl_CreateCommand (p->interp, "zwait", proc_zwait_invoke, p, NULL);
for (i=0; i<MAX_CALLBACK; i++)
{
callback_table[i].r_handle = NULL;
static int do_exec (const char *fname, char *parms, void *mydata)
{
struct tcl_info *p = mydata;
- int i, r, min_fd = 0;
- const char *cp;
+ int r;
+ if ((r = w_interp_exec (p->w_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)
}
}
if (!r)
- return 0;
+ break;
if ((r = select(max_fd+1, &fdset_tcl_r, &fdset_tcl_w,
&fdset_tcl_x, 0)) < 0)
{
}
}
}
+ free (waitVarVal);
return 0;
}
* 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
{
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;
"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)
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;
projects / egate.git / commitdiff