From 6b7704f0e063b05c5817dd4dd8d3d4dedea22499 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Tue, 20 Jun 1995 08:07:23 +0000 Subject: [PATCH] New setting: failInfo. Working on better cancel mechanism. --- client.tcl | 69 +++++++++++++++++++++++++++++++++++++++++++++++------------- ir-tcl.c | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- ir-tclp.h | 13 +++++++++++- 3 files changed, 133 insertions(+), 18 deletions(-) diff --git a/client.tcl b/client.tcl index 0e22966..31f724b 100644 --- a/client.tcl +++ b/client.tcl @@ -4,7 +4,11 @@ # Sebastian Hammer, Adam Dickmeiss # # $Log: client.tcl,v $ -# Revision 1.47 1995-06-19 14:05:29 adam +# Revision 1.48 1995-06-20 08:07:23 adam +# New setting: failInfo. +# Working on better cancel mechanism. +# +# Revision 1.47 1995/06/19 14:05:29 adam # Bug fix: asked for SUTRS. # # Revision 1.46 1995/06/19 13:06:06 adam @@ -182,6 +186,7 @@ set fullMarcSeq 0 set displayFormat 1 set popupMarcdf 0 set textWrap word +set delayRequest {} set queryTypes {Simple} set queryButtons { { {I 0} {I 1} {I 2} } } @@ -210,7 +215,7 @@ proc set-wrap {m} { } proc dputs {m} { -# puts $m + puts $m } proc set-display-format {f} { @@ -344,10 +349,12 @@ proc bottom-buttons {w buttonList g} { proc cancel-operation {} { global cancelFlag global busy + global delayRequest set cancelFlag 1 + set delayRequest {} if {$busy} { - show-status Canceling 0 {} + show-status Cancel 0 1 } } @@ -716,8 +723,10 @@ proc define-target-action {} { } proc fail-response {target} { + set c [lindex [z39 failInfo] 0] + set m [lindex [z39 failInfo] 1] close-target - tkerror "Target connection closed or protocol error" + tkerror "$m ($c)" } proc connect-response {target base} { @@ -872,12 +881,23 @@ proc search-request {} { global busy global cancelFlag global searchEnable + global delayRequest set target $hostid - if {$searchEnable == 0} { + dputs "search-request" + if {$searchEnable < 0} { + dputs "searchEnable == 0" + return + } + if {$cancelFlag} { + dputs "cancelFlag" + show-status {Searching} 1 0 + set delayRequest search-request return } + set delayRequest {} + set query [index-query] if {$query==""} { return @@ -1139,8 +1159,18 @@ proc search-response {} { global setMax global cancelFlag global busy + global delayRequest dputs "In search-response" + if {$cancelFlag} { + dputs "Handling cancel" + set cancelFlag 0 + if {$delayRequest != ""} { + $delayRequest + } + return + } + set delayRequest {} init-title-lines set setMax [z39.$setNo resultCount] show-message "${setMax} hits" @@ -1163,10 +1193,6 @@ proc search-response {} { } set setOffset 1 show-status {Ready} 0 1 - if {$cancelFlag} { - set cancelFlag 0 - return - } z39 callback {present-response} z39.$setNo present $setOffset 1 show-status {Retrieving} 1 0 @@ -1176,9 +1202,18 @@ proc present-more {number} { global setNo global setOffset global setMax + global busy + global cancelFlag + global delayRequest - dputs "setOffset=$setOffset" dputs "present-more" + if {$cancelFlag} { + show-status {Retrieving} 1 0 + set delayRequest [list present-request $number] + return + } + set delayRequest {} + if {$setNo == 0} { dputs "setNo=$setNo" return @@ -1256,7 +1291,16 @@ proc present-response {} { global setOffset global setMax global cancelFlag + global delayRequest + if {$cancelFlag} { + dputs "Handling cancel" + set cancelFlag 0 + if {$delayRequest != ""} { + $delayRequest + } + return + } dputs "In present-response" set no [z39.$setNo numberOfRecordsReturned] dputs "Returned $no records, setOffset $setOffset" @@ -1271,11 +1315,6 @@ proc present-response {} { tkerror "NSD$code: $msg: $addinfo" return } - if {$cancelFlag} { - show-status {Ready} 0 1 - set cancelFlag 0 - return - } if {$no > 0 && $setOffset <= $setMax} { dputs "present-request from ${setOffset}" set toGet [expr $setMax - $setOffset + 1] diff --git a/ir-tcl.c b/ir-tcl.c index 468bf3a..d2c1881 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,11 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.44 1995-06-19 17:01:20 adam + * Revision 1.45 1995-06-20 08:07:30 adam + * New setting: failInfo. + * Working on better cancel mechanism. + * + * Revision 1.44 1995/06/19 17:01:20 adam * Minor changes. * * Revision 1.43 1995/06/19 13:06:08 adam @@ -646,6 +650,48 @@ static int do_options (void *obj, Tcl_Interp *interp, } /* + * do_failInfo: Get fail information + */ +static int do_failInfo (void *obj, Tcl_Interp *interp, int argc, char **argv) +{ + char buf[16], *cp; + IrTcl_Obj *p = obj; + + if (argc <= 0) + { + p->failInfo = 0; + return TCL_OK; + } + sprintf (buf, "%d", p->failInfo); + switch (p->failInfo) + { + case 0: + cp = "ok"; + break; + case IR_TCL_FAIL_CONNECT: + cp = "connect failed"; + break; + case IR_TCL_FAIL_READ: + cp = "connection closed"; + break; + case IR_TCL_FAIL_WRITE: + cp = "connection closed"; + break; + case IR_TCL_FAIL_IN_APDU: + cp = "failed to decode incoming APDU"; + break; + case IR_TCL_FAIL_UNKNOWN_APDU: + cp = "unknown APDU"; + break; + default: + cp = ""; + } + Tcl_AppendElement (interp, buf); + Tcl_AppendElement (interp, cp); + return TCL_OK; +} + +/* * do_preferredMessageSize: Set/get preferred message size */ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp, @@ -755,7 +801,7 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Obj *p = obj; - + if (argc == 0) { p->targetImplementationName = NULL; @@ -1309,6 +1355,7 @@ static IrTcl_Method ir_method_tab[] = { { 1, "comstack", do_comstack }, { 1, "protocol", do_protocol }, { 0, "failback", do_failback }, +{ 0, "failInfo", do_failInfo }, { 1, "connect", do_connect }, { 0, "protocolVersion", do_protocolVersion }, @@ -2817,7 +2864,10 @@ void ir_select_read (ClientData clientData) { logf (LOG_DEBUG, "cs_rcvconnect error"); if (p->failback) + { + p->failInfo = IR_TCL_FAIL_CONNECT; IrTcl_eval (p->interp, p->failback); + } do_disconnect (p, NULL, 2, NULL); return; } @@ -2835,7 +2885,10 @@ void ir_select_read (ClientData clientData) logf (LOG_DEBUG, "cs_get failed, code %d", r); ir_select_remove (cs_fileno (p->cs_link), p); if (p->failback) + { + p->failInfo = IR_TCL_FAIL_READ; IrTcl_eval (p->interp, p->failback); + } do_disconnect (p, NULL, 2, NULL); /* relase ir object now if callback deleted it */ @@ -2850,7 +2903,10 @@ void ir_select_read (ClientData clientData) { logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]); if (p->failback) + { + p->failInfo = IR_TCL_FAIL_IN_APDU; IrTcl_eval (p->interp, p->failback); + } do_disconnect (p, NULL, 2, NULL); /* release ir object now if failback deleted it */ @@ -2874,7 +2930,10 @@ void ir_select_read (ClientData clientData) default: logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); if (p->failback) + { + p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; IrTcl_eval (p->interp, p->failback); + } do_disconnect (p, NULL, 2, NULL); } odr_reset (p->odr_in); @@ -2909,7 +2968,10 @@ void ir_select_write (ClientData clientData) logf (LOG_DEBUG, "cs_rcvconnect error"); ir_select_remove_write (cs_fileno (p->cs_link), p); if (p->failback) + { + p->failInfo = IR_TCL_FAIL_CONNECT; IrTcl_eval (p->interp, p->failback); + } do_disconnect (p, NULL, 2, NULL); return; } @@ -2922,7 +2984,10 @@ void ir_select_write (ClientData clientData) { logf (LOG_DEBUG, "select write fail"); if (p->failback) + { + p->failInfo = IR_TCL_FAIL_WRITE; IrTcl_eval (p->interp, p->failback); + } do_disconnect (p, NULL, 2, NULL); } else if (r == 0) /* remove select bit */ diff --git a/ir-tclp.h b/ir-tclp.h index eec7017..0898d3a 100644 --- a/ir-tclp.h +++ b/ir-tclp.h @@ -5,7 +5,11 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tclp.h,v $ - * Revision 1.10 1995-06-16 12:28:20 adam + * Revision 1.11 1995-06-20 08:07:35 adam + * New setting: failInfo. + * Working on better cancel mechanism. + * + * Revision 1.10 1995/06/16 12:28:20 adam * Implemented preferredRecordSyntax. * Minor changes in diagnostic handling. * Record list deleted when connection closes. @@ -90,6 +94,7 @@ typedef struct { char *cs_type; int protocol_type; int connectFlag; + int failInfo; COMSTACK cs_link; int preferredMessageSize; @@ -220,4 +225,10 @@ struct ir_named_entry { int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf, int argc, char **argv); char *ir_tcl_fread_marc (FILE *inf, size_t *size); + +#define IR_TCL_FAIL_CONNECT 1 +#define IR_TCL_FAIL_READ 2 +#define IR_TCL_FAIL_WRITE 3 +#define IR_TCL_FAIL_IN_APDU 4 +#define IR_TCL_FAIL_UNKNOWN_APDU 5 #endif -- 1.7.10.4