From 2e12e18cb9594b3ca047e66a754f0ce597e24dbb Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Tue, 28 Mar 1995 12:45:22 +0000 Subject: [PATCH] New ir method failback: called on disconnect/protocol error. New ir set/get method: protocol: SR / Z3950. Simple popup and disconnect when failback is invoked. --- client.tcl | 48 +++++++++++++++++++++--------------- ir-tcl.c | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 103 insertions(+), 25 deletions(-) diff --git a/client.tcl b/client.tcl index 4e859b8..65bae20 100644 --- a/client.tcl +++ b/client.tcl @@ -1,6 +1,11 @@ # # $Log: client.tcl,v $ -# Revision 1.14 1995-03-22 16:07:55 adam +# Revision 1.15 1995-03-28 12:45:22 adam +# New ir method failback: called on disconnect/protocol error. +# New ir set/get method: protocol: SR / Z3950. +# Simple popup and disconnect when failback is invoked. +# +# Revision 1.14 1995/03/22 16:07:55 adam # Minor changes. # # Revision 1.13 1995/03/21 17:27:26 adam @@ -253,6 +258,11 @@ proc define-target-action {} { destroy .target-define } +proc fail-response {target} { + close-target + tkerror "Target connection closed or protocol error" +} + proc connect-response {target} { puts "connect-response" show-target $target @@ -263,9 +273,6 @@ proc open-target {target base} { global profile global hostid - set hostid $target - .top.target.m disable 0 - .top.target.m enable 1 z39 disconnect z39 comstack [lindex $profile($target) 6] # z39 idAuthentication [lindex $profile($target) 3] @@ -280,9 +287,25 @@ proc open-target {target base} { } else { z39 databaseNames $base } - show-status {Connecting} 1 + z39 failback [list fail-response $target] z39 callback [list connect-response $target] z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2] + show-status {Connecting} 1 + set hostid $target + .top.target.m disable 0 + .top.target.m enable 1 +} + +proc close-target {} { + global hostid + + set hostid Default + z39 disconnect + show-target {None} + show-status {Not connected} 0 + show-message {} + .top.target.m disable 1 + .top.target.m enable 0 } proc load-set-action {} { @@ -503,17 +526,6 @@ proc define-target-dialog {} { top-down-ok-cancel $w {define-target-action} 1 } -proc close-target {} { - # pack forget .mid.searchlabel .mid.searchentry - #.mid.searchentry -state disabled - z39 disconnect - show-target {None} - show-status {Not connected} 0 - show-message {} - .top.target.m disable 1 - .top.target.m enable 0 -} - proc protocol-setup-action {target} { global profile global csRadioType @@ -737,10 +749,6 @@ proc database-select {} { top-down-window $w - if {$hostid == ""} { - set hostid Default - } - frame $w.top.databases -relief ridge -border 2 pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x diff --git a/ir-tcl.c b/ir-tcl.c index edfd4c3..c48977c 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -4,7 +4,12 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.18 1995-03-21 15:50:12 adam + * Revision 1.19 1995-03-28 12:45:23 adam + * New ir method failback: called on disconnect/protocol error. + * New ir set/get method: protocol: SR / Z3950. + * Simple popup and disconnect when failback is invoked. + * + * Revision 1.18 1995/03/21 15:50:12 adam * Minor changes. * * Revision 1.17 1995/03/21 13:41:03 adam @@ -82,6 +87,7 @@ typedef struct { char *cs_type; + char *protocol_type; int connectFlag; COMSTACK cs_link; @@ -111,6 +117,7 @@ typedef struct { Tcl_Interp *interp; char *callback; + char *failback; int smallSetUpperBound; int largeSetLowerBound; @@ -496,6 +503,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, void *addr; IRObj *p = obj; int r; + int protocol_type = CS_Z3950; if (argc == 3) { @@ -504,9 +512,18 @@ static int do_connect (void *obj, Tcl_Interp *interp, interp->result = "already connected"; return TCL_ERROR; } + if (!strcmp (p->protocol_type, "Z3950")) + protocol_type = CS_Z3950; + else if (!strcmp (p->protocol_type, "SR")) + protocol_type = CS_SR; + else + { + interp->result = "bad protocol type"; + return TCL_ERROR; + } if (!strcmp (p->cs_type, "tcpip")) { - p->cs_link = cs_create (tcpip_type, CS_BLOCK); + p->cs_link = cs_create (tcpip_type, CS_BLOCK, protocol_type); addr = tcpip_strtoaddr (argv[2]); if (!addr) { @@ -518,7 +535,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, #if MOSI else if (!strcmp (p->cs_type, "mosi")) { - p->cs_link = cs_create (mosi_type, CS_BLOCK); + p->cs_link = cs_create (mosi_type, CS_BLOCK, protocol_type); addr = mosi_strtoaddr (argv[2]); if (!addr) { @@ -530,7 +547,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, #endif else { - interp->result = "unknown cs type"; + interp->result = "unknown comstack type"; return TCL_ERROR; } if (ir_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) @@ -597,6 +614,24 @@ static int do_comstack (void *o, Tcl_Interp *interp, } /* + * do_protocol: Set/get protocol method on IR object + */ +static int do_protocol (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IRObj *obj = o; + + if (argc == 3) + { + free (obj->protocol_type); + if (ir_strdup (interp, &obj->protocol_type, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendElement (interp, obj->protocol_type); + return TCL_OK; +} + +/* * do_callback: add callback */ static int do_callback (void *obj, Tcl_Interp *interp, @@ -615,6 +650,24 @@ static int do_callback (void *obj, Tcl_Interp *interp, } /* + * do_failback: add error handle callback + */ +static int do_failback (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IRObj *p = obj; + + if (argc == 3) + { + free (p->failback); + if (ir_strdup (interp, &p->failback, argv[2]) == TCL_ERROR) + return TCL_ERROR; + p->interp = interp; + } + return TCL_OK; +} + +/* * do_databaseNames: specify database names */ static int do_databaseNames (void *obj, Tcl_Interp *interp, @@ -693,6 +746,7 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, { static IRMethod tab[] = { { 1, "comstack", do_comstack }, + { 1, "protocol", do_protocol }, { 1, "connect", do_connect }, { 0, "protocolVersion", do_protocolVersion }, { 0, "options", do_options }, @@ -704,6 +758,7 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, { 0, "init", do_init_request }, { 0, "disconnect", do_disconnect }, { 0, "callback", do_callback }, + { 0, "failback", do_failback }, { 1, "databaseNames", do_databaseNames}, { 1, "replaceIndicator", do_replaceIndicator}, { 1, "query", do_query }, @@ -740,6 +795,8 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, return TCL_ERROR; if (ir_strdup (interp, &obj->cs_type, "tcpip") == TCL_ERROR) return TCL_ERROR; + if (ir_strdup (interp, &obj->protocol_type, "Z3950") == TCL_ERROR) + return TCL_ERROR; obj->cs_link = NULL; obj->maximumRecordSize = 32768; @@ -793,6 +850,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->buf_in = NULL; obj->callback = NULL; + obj->failback = NULL; Tcl_CreateCommand (interp, argv[1], ir_obj_method, (ClientData) obj, ir_obj_delete); return TCL_OK; @@ -870,7 +928,7 @@ static int do_search (void *o, Tcl_Interp *interp, { query.which = Z_Query_type_2; query.u.type_2 = &ccl_query; - ccl_query.buf = argv[2]; + ccl_query.buf = (unsigned char *) argv[2]; ccl_query.len = strlen (argv[2]); printf ("- CCL\n"); } @@ -1498,6 +1556,8 @@ void ir_select_read (ClientData clientData) if (r < 0) { printf ("cs_rcvconnect error\n"); + if (p->failback) + Tcl_Eval (p->interp, p->failback); return; } if (p->callback) @@ -1510,6 +1570,8 @@ void ir_select_read (ClientData clientData) { printf ("cs_get failed\n"); ir_select_remove (cs_fileno (p->cs_link), p); + if (p->failback) + Tcl_Eval (p->interp, p->failback); return; } if (r == 1) @@ -1519,6 +1581,8 @@ void ir_select_read (ClientData clientData) if (!z_APDU (p->odr_in, &apdu, 0)) { printf ("%s\n", odr_errlist [odr_geterror (p->odr_in)]); + if (p->failback) + Tcl_Eval (p->interp, p->failback); return; } switch(apdu->which) @@ -1535,6 +1599,8 @@ void ir_select_read (ClientData clientData) default: printf("Received unknown APDU type (%d).\n", apdu->which); + if (p->failback) + Tcl_Eval (p->interp, p->failback); } if (p->callback) Tcl_Eval (p->interp, p->callback); @@ -1560,6 +1626,8 @@ void ir_select_write (ClientData clientData) { printf ("cs_rcvconnect error\n"); ir_select_remove_write (cs_fileno (p->cs_link), p); + if (p->failback) + Tcl_Eval (p->interp, p->failback); return; } ir_select_remove_write (cs_fileno (p->cs_link), p); @@ -1571,6 +1639,8 @@ void ir_select_write (ClientData clientData) { printf ("select write fail\n"); cs_close (p->cs_link); + if (p->failback) + Tcl_Eval (p->interp, p->failback); } else if (r == 0) /* remove select bit */ { -- 1.7.10.4