#
# $Log: client.tcl,v $
-# Revision 1.11 1995-03-21 10:39:06 adam
+# Revision 1.12 1995-03-21 13:41:03 adam
+# Comstack cs_create not used too often. Non-blocking connect.
+#
+# Revision 1.11 1995/03/21 10:39:06 adam
# Diagnostic error message displayed with tkerror.
#
# Revision 1.10 1995/03/20 15:24:06 adam
set settingsChanged 0
set setNo 0
-wm minsize . 360 200
+wm minsize . 300 200
if {[file readable "~/.tk-c"]} {
source "~/.tk-c"
frame $w.top -relief raised -border 1
frame $w.bot -relief raised -border 1
- # pack $w.top $w.bot -side top -fill both -expand yes
pack $w.top -side top -fill both -expand yes
pack $w.bot -fill both
- text $w.top.record -width 60 -height 10 -wrap word \
+ text $w.top.record -width 60 -height 12 -wrap word \
-yscrollcommand [list $w.top.s set]
scrollbar $w.top.s -command [list $w.top.record yview]
destroy .target-define
}
+proc connect-response {target} {
+ puts "connect-response"
+ show-target $target
+ init-request
+}
+
proc open-target {target base} {
global profile
} else {
z39 databaseNames $base
}
- show-target $target
- z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2]
- init-request
+ show-status {Connecting} 1
+ z39 callback [list connect-response $target]
+ z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2]
}
proc load-set-action {} {
proc init-response {} {
show-status {Ready} 0
- pack .mid.searchlabel .mid.searchentry -side left
bind .mid.searchentry <Return> search-request
focus .mid.searchentry
}
}
proc close-target {} {
- pack forget .mid.searchlabel .mid.searchentry
+ # pack forget .mid.searchlabel .mid.searchentry
+ .mid.searchentry -state disabled
z39 disconnect
show-target {None}
show-status {Not connected} 0
pack .top.help -side right
label .mid.searchlabel -text {Search:}
-entry .mid.searchentry -width 40 -relief sunken
+entry .mid.searchentry -width 32 -relief sunken
+pack .mid.searchlabel -side left
+pack .mid.searchentry -side left -fill x -expand yes
bind .mid.searchentry <Left> {left-cursor .mid.searchentry}
bind .mid.searchentry <Right> {right-cursor .mid.searchentry}
message .bot.target -text "None" -aspect 1000 -relief sunken -border 1
label .bot.status -text "Not connected" -width 12 -relief \
sunken -anchor w -border 1
-label .bot.message -text "" -width 20 -relief \
+label .bot.set -textvariable setNo -width 5 -relief \
+ sunken -anchor w -border 1
+label .bot.message -text "" -width 14 -relief \
sunken -anchor w -border 1
-pack .bot.target .bot.status .bot.message -anchor nw -side left -padx 2 -pady 2
+pack .bot.target .bot.status .bot.set .bot.message -anchor nw -side left -padx 2 -pady 2
bind .data.list <Double-Button-1> {set indx [.data.list nearest %y]
show-full-marc $indx}
* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tcl.c,v $
- * Revision 1.16 1995-03-21 08:26:06 adam
+ * Revision 1.17 1995-03-21 13:41:03 adam
+ * Comstack cs_create not used too often. Non-blocking connect.
+ *
+ * Revision 1.16 1995/03/21 08:26:06 adam
* New method, setName, to specify the result set name (other than Default).
* New method, responseStatus, which returns diagnostic info, if any, after
* present response / search response.
#include <iso2709p.h>
#include <comstack.h>
#include <tcpip.h>
+
+#if MOSI
#include <xmosi.h>
+#endif
#include <odr.h>
#include <proto.h>
#define CS_BLOCK 0
typedef struct {
+ char *cs_type;
+ int connectFlag;
COMSTACK cs_link;
+
int preferredMessageSize;
int maximumRecordSize;
Odr_bitmask options;
{
void *addr;
IRObj *p = obj;
+ int r;
if (argc == 3)
{
interp->result = "already connected";
return TCL_ERROR;
}
- if (cs_type(p->cs_link) == tcpip_type)
+ if (!strcmp (p->cs_type, "tcpip"))
{
+ p->cs_link = cs_create (tcpip_type, CS_BLOCK);
addr = tcpip_strtoaddr (argv[2]);
if (!addr)
{
}
printf ("tcp/ip connect %s\n", argv[2]);
}
- else if (cs_type (p->cs_link) == mosi_type)
+#if MOSI
+ else if (!strcmp (p->cs_type, "mosi"))
{
+ p->cs_link = cs_create (mosi_type, CS_BLOCK);
addr = mosi_strtoaddr (argv[2]);
if (!addr)
{
}
printf ("mosi connect %s\n", argv[2]);
}
- if (cs_connect (p->cs_link, addr) < 0)
+#endif
+ else
{
- interp->result = "cs_connect fail";
- do_disconnect (p, interp, argc, argv);
+ interp->result = "unknown cs type";
return TCL_ERROR;
}
if (ir_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
return TCL_ERROR;
+ if ((r=cs_connect (p->cs_link, addr)) < 0)
+ {
+ interp->result = "cs_connect fail";
+ return TCL_ERROR;
+ }
ir_select_add (cs_fileno (p->cs_link), p);
+ if (r == 1)
+ {
+ ir_select_add_write (cs_fileno (p->cs_link), p);
+ p->connectFlag = 1;
+ }
+ else
+ {
+ p->connectFlag = 0;
+ if (p->callback)
+ Tcl_Eval (p->interp, p->callback);
+ }
}
- Tcl_AppendResult (interp, p->hostname, NULL);
+ Tcl_AppendElement (interp, p->hostname);
return TCL_OK;
}
free (p->hostname);
p->hostname = NULL;
ir_select_remove (cs_fileno (p->cs_link), p);
- }
- if (cs_type (p->cs_link) == tcpip_type)
- {
- cs_close (p->cs_link);
- p->cs_link = cs_create (tcpip_type, CS_BLOCK);
- }
- else if (cs_type (p->cs_link) == mosi_type)
- {
+
+ assert (p->cs_link);
cs_close (p->cs_link);
- p->cs_link = cs_create (mosi_type, CS_BLOCK);
- }
- else
- {
- interp->result = "unknown comstack type";
- return TCL_ERROR;
+ p->cs_link = NULL;
}
return TCL_OK;
}
/*
* do_comstack: Set/get comstack method on IR object
*/
-static int do_comstack (void *obj, Tcl_Interp *interp,
+static int do_comstack (void *o, Tcl_Interp *interp,
int argc, char **argv)
{
- char *cs_type = NULL;
+ IRObj *obj = o;
+
if (argc == 3)
{
- cs_close (((IRObj*) obj)->cs_link);
- if (!strcmp (argv[2], "tcpip"))
- ((IRObj *)obj)->cs_link = cs_create (tcpip_type, CS_BLOCK);
- else if (!strcmp (argv[2], "mosi"))
- ((IRObj *)obj)->cs_link = cs_create (mosi_type, CS_BLOCK);
- else
- {
- interp->result = "wrong comstack type";
+ free (obj->cs_type);
+ if (ir_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR)
return TCL_ERROR;
- }
}
- if (cs_type(((IRObj *)obj)->cs_link) == tcpip_type)
- cs_type = "tcpip";
- else if (cs_type(((IRObj *)obj)->cs_link) == mosi_type)
- cs_type = "comstack";
- Tcl_AppendResult (interp, cs_type, NULL);
+ Tcl_AppendElement (interp, obj->cs_type);
return TCL_OK;
}
}
if (!(obj = ir_malloc (interp, sizeof(*obj))))
return TCL_ERROR;
- obj->cs_link = cs_create (tcpip_type, CS_BLOCK);
+ if (ir_strdup (interp, &obj->cs_type, "tcpip") == TCL_ERROR)
+ return TCL_ERROR;
+ obj->cs_link = NULL;
obj->maximumRecordSize = 32768;
obj->preferredMessageSize = 4096;
+ obj->connectFlag = 0;
obj->idAuthentication = NULL;
IRObj *p = clientData;
Z_APDU *apdu;
int r;
-
+
+ if (p->connectFlag)
+ {
+ r = cs_rcvconnect (p->cs_link);
+ if (r == 1)
+ return;
+ p->connectFlag = 0;
+ if (r < 0)
+ {
+ printf ("cs_rcvconnect error\n");
+ ir_select_remove_write (cs_fileno (p->cs_link), p);
+ return;
+ }
+ ir_select_remove_write (cs_fileno (p->cs_link), p);
+ if (p->callback)
+ Tcl_Eval (p->interp, p->callback);
+ return;
+ }
do
{
if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 0)
int r;
printf ("In write handler.....\n");
+ if (p->connectFlag)
+ {
+ r = cs_rcvconnect (p->cs_link);
+ if (r == 1)
+ return;
+ p->connectFlag = 0;
+ if (r < 0)
+ {
+ printf ("cs_rcvconnect error\n");
+ ir_select_remove_write (cs_fileno (p->cs_link), p);
+ return;
+ }
+ ir_select_remove_write (cs_fileno (p->cs_link), p);
+ if (p->callback)
+ Tcl_Eval (p->interp, p->callback);
+ return;
+ }
if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
{
printf ("select write fail\n");