New function zwait that waits for a variable change - due to i/o events
authorAdam Dickmeiss <adam@indexdata.dk>
Mon, 30 Oct 1995 17:35:17 +0000 (17:35 +0000)
committerAdam Dickmeiss <adam@indexdata.dk>
Mon, 30 Oct 1995 17:35:17 +0000 (17:35 +0000)
that invoke callback routines.

www/query.egw
www/search.egw
www/wirtcl.c
www/wtcl.c

index 3f0d25f..319d5f1 100644 (file)
@@ -1,42 +1,49 @@
 <html>
 <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
 proc fail-response {} {
     global sessionWait
-    htmlr {Init fail<br>}
-    set sessionWait 0
+    set sessionWait -1
 }
 
 proc init-response {} {
     global sessionWait
 }
 
 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 t $sessionParms
     set databases [lindex $targets($t) 1]
-    set sessionWait 1
+    set sessionWait 0
     ir z39
     z39 failback fail-response
     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
     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} {
     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 {Choose the bases you want to search: <br>}
         }
         set i 0
@@ -54,10 +61,8 @@ proc init-response {} {
             htmlr [concat $databases] {"> All <br>}
         }
     }
             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 {">}
     set fields [lindex $targets($t) 2]
     for {set no 1} {$no < 4} {incr no} {
         htmlr {<select name="menu} $no {">}
@@ -75,38 +80,39 @@ proc init-response {} {
         }
         htmlr <br>
     }
         }
         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>}
     }
     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
index 7c0b84e..be30940 100644 (file)
@@ -1,44 +1,43 @@
 <html>
 {
 <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
 
 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
 }
 
 proc fail-response {} {
     global sessionWait
-    set sessionWait 0
-
-    htmlr "<strong>failed</strong><br>"
-    htmlr "</body></html>"
+    set sessionWait -1
 }
 
     global sessionWait
 }
 
     global sessionWait
-
     z39 callback search-response
     z39 failback fail-response
     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]
     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>}
+    }
+
index f05500f..cae84ee 100644 (file)
  * USE OR PERFORMANCE OF THIS SOFTWARE.
  *
  * $Log: wirtcl.c,v $
  * 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
  * 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);
 /* 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 */
         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;
     for (i=0; i<MAX_CALLBACK; i++)
     {
         callback_table[i].r_handle = NULL;
@@ -135,22 +155,47 @@ static void *do_create (WCLIENT wcl, void *args)
 static int do_exec (const char *fname, char *parms, void *mydata)
 {
     struct tcl_info *p = mydata;
 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;
 
     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)
     {
     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);
         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)
         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)
             }
         }
         if (!r)
-            return 0;
+            break;
         if ((r = select(max_fd+1, &fdset_tcl_r, &fdset_tcl_w, 
                           &fdset_tcl_x, 0)) < 0)
         {
         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;
 }
 
     return 0;
 }
 
index 5255b66..bd63995 100644 (file)
  * USE OR PERFORMANCE OF THIS SOFTWARE.
  *
  * $Log: wtcl.c,v $
  * 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
  * 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)");
         {
             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;
         }
         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;
                       "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)
 }
 
 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
             {
                 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;
                 {
                     fclose (inf);
                     return -2;