New command implemented - aborts script.
</head>
<body>
{
-# $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
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 <br>"
htmlr "</body></html>"
- return
+ wabort
}
z39 callback init-response
z39 init
if {$sessionWait == -1} {
htmlr "Cannot initialize with target $t <br>"
htmlr "</body></html>"
- return
+ wabort
}
htmlr {
<h2> Search in databases </h2>
htmlr [concat $databases] {"> All <br>}
}
}
- htmlr {<hr>}
- htmlr {<strong>Input your search criteria: </strong> <br>}
+}
+<hr>
+<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>
}
- 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>}
+}
+<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>
+{
foreach e {SERVER_NAME PATH_INFO SCRIPT_NAME} {
htmlr $e {: } $env($e) {<br>}
}
- htmlr {form: } [form] {<br>}
- htmlr {target: } $t { <br>}
- htmlr {databases: } $databases { <br>}
- htmlr {</body></html>}
-}
\ No newline at end of file
+}
+form: {html [form]} <br>
+target: {html $t} <br>
+databases: {html $databases} <br>
+</body></html>
<html>
{
-# $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
}
set sessionWait -1
}
+proc display-rec {from to} {
+ while {$from < $to} {
+ htmlr {<b>} $from {</b><br>}
+ 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 { <i> } $year {</i><br>}
+ }
+ 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 {<head><title> WWW/Z39.50 Gateway Search } $t { </title>}
htmlr {</head><body>}
+ set query [build-query]
+ htmlr {query: } $query {<br>}
+ z39.1 search $query
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>}
+ set r [z39.1 resultCount]
+ htmlr {<strong> } $r { hits</strong><br>}
} 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
+ if {$msg != ""} {
+ html {, } $addinfo
+ }
+ htmlr {</strong><br></body></html>}
+ 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 {</strong><br>}
}
+}
+</body>
+</html>
* 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.
*
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)))
}
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);
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)
{
}
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)
{
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))
{
}
}
free (waitVarVal);
- return 0;
+ return TCL_OK;
}
void ir_select_add (int fd, void *obj)
* 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.
*
char *fbuf;
int fbuf_size;
int fbuf_ptr;
+ int wabort;
WCLIENT wcl;
};
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)
{
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;
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;
}
projects / egate.git / commitdiff