X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=345aec58377f43d7c5e349ec9c5ad487c81a027b;hb=e2c43820d02a17f663b564b9d139fb188c370bfc;hp=4650a77297ff600d48e1e622d74a1013822ea09d;hpb=f74154d3c256f1147dfc5de059cf50ba2c4f0280;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index 4650a77..345aec5 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -1,11 +1,21 @@ /* * IR toolkit for tcl/tk - * (c) Index Data 1995-1996 + * (c) Index Data 1995-1997 * See the file LICENSE for details. * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.99 1997-04-30 07:24:47 adam + * Revision 1.102 1997-09-17 12:22:40 adam + * Changed to use YAZ version 1.4. The new comstack utility, cs_straddr, + * is used. + * + * Revision 1.101 1997/09/09 10:19:53 adam + * New MSV5.0 port with fewer warnings. + * + * Revision 1.100 1997/05/01 15:04:05 adam + * Added ir-log command. + * + * Revision 1.99 1997/04/30 07:24:47 adam * Spell fix of an error message. * * Revision 1.98 1997/04/13 18:57:20 adam @@ -1167,24 +1177,12 @@ static int do_connect (void *obj, Tcl_Interp *interp, if (!strcmp (p->comstackType, "tcpip")) { p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type); - addr = tcpip_strtoaddr (argv[2]); - if (!addr) - { - Tcl_AppendResult (interp, "tcpip_strtoaddr fail", NULL); - return ir_tcl_error_exec (interp, argc, argv); - } logf (LOG_DEBUG, "tcp/ip connect %s", argv[2]); } else if (!strcmp (p->comstackType, "mosi")) { #if MOSI p->cs_link = cs_create (mosi_type, CS_BLOCK, p->protocol_type); - addr = mosi_strtoaddr (argv[2]); - if (!addr) - { - Tcl_AppendResult (interp, "mosi_strtoaddr fail", NULL); - return ir_tcl_error_exec (interp, argc, argv); - } logf (LOG_DEBUG, "mosi connect %s", argv[2]); #else Tcl_AppendResult (interp, "mosi not supported", NULL); @@ -1200,6 +1198,13 @@ static int do_connect (void *obj, Tcl_Interp *interp, if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) return TCL_ERROR; p->eventType = "connect"; + addr = cs_straddr (p->cs_link, argv[2]); + if (!addr) + { + ir_tcl_disconnect (p); + Tcl_AppendResult (interp, "cs_straddr fail", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } if ((r=cs_connect (p->cs_link, addr)) < 0) { ir_tcl_disconnect (p); @@ -1239,6 +1244,9 @@ void ir_tcl_disconnect (IrTcl_Obj *p) odr_reset (p->odr_in); +#if TCL_MAJOR_VERSION == 8 + cs_fileno(p->cs_link) = -1; +#endif cs_close (p->cs_link); p->cs_link = NULL; @@ -1829,7 +1837,7 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Methods tab[3]; - IrTcl_Obj *p = clientData; + IrTcl_Obj *p = (IrTcl_Obj *) clientData; int r; if (argc < 2) @@ -1854,7 +1862,7 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, */ static void ir_obj_delete (ClientData clientData) { - IrTcl_Obj *obj = clientData; + IrTcl_Obj *obj = (IrTcl_Obj *) clientData; IrTcl_Methods tab[3]; --(obj->ref_count); @@ -1930,7 +1938,7 @@ int ir_obj_init (ClientData clientData, Tcl_Interp *interp, Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL); return TCL_ERROR; } - *subData = obj; + *subData = (ClientData) obj; return TCL_OK; } @@ -2514,7 +2522,7 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL); return TCL_ERROR; } - if (rl->u.dbrec.type != VAL_SUTRS) + if (!rl->u.dbrec.buf || rl->u.dbrec.type != VAL_SUTRS) return TCL_OK; Tcl_AppendElement (interp, rl->u.dbrec.buf); return TCL_OK; @@ -2590,12 +2598,12 @@ static int do_getExplain (void *o, Tcl_Interp *interp, int argc, char **argv) Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL); return TCL_ERROR; } - if (rl->u.dbrec.type != VAL_EXPLAIN) + if (!rl->u.dbrec.buf || rl->u.dbrec.type != VAL_EXPLAIN) return TCL_OK; if (!(etype = z_ext_getentbyref (VAL_EXPLAIN))) return TCL_OK; - + assert (rl->u.dbrec.buf); odr_setbuf (p->odr_in, rl->u.dbrec.buf, rl->u.dbrec.size, 0); if (!(*etype->fun)(p->odr_in, &rr, 0)) return TCL_OK; @@ -2731,7 +2739,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) typedef struct { int encoding; int syntax; - int size; + size_t size; } IrTcl_FileRecordHead; /* @@ -2916,7 +2924,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Methods tabs[3]; - IrTcl_SetObj *p = clientData; + IrTcl_SetObj *p = (IrTcl_SetObj *) clientData; int r; if (argc < 2) @@ -2941,7 +2949,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, static void ir_set_obj_delete (ClientData clientData) { IrTcl_Methods tabs[3]; - IrTcl_SetObj *p = clientData; + IrTcl_SetObj *p = (IrTcl_SetObj *) clientData; logf (LOG_DEBUG, "ir set delete"); @@ -3041,7 +3049,7 @@ static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp, if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR) return TCL_ERROR; - *subData = obj; + *subData = (ClientData) obj; return TCL_OK; } @@ -3378,7 +3386,7 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, static void ir_scan_obj_delete (ClientData clientData) { IrTcl_Methods tabs[2]; - IrTcl_ScanObj *obj = clientData; + IrTcl_ScanObj *obj = (IrTcl_ScanObj *) clientData; tabs[0].tab = ir_scan_method_tab; tabs[0].obj = obj; @@ -3427,7 +3435,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, /* ------------------------------------------------------- */ /* - * ir_log_proc: set yaz log level + * ir_log_init_proc: set yaz log level */ static int ir_log_init_proc (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) @@ -3447,6 +3455,25 @@ static int ir_log_init_proc (ClientData clientData, Tcl_Interp *interp, return TCL_OK; } +/* + * ir_log_proc: log yaz message + */ +static int ir_log_proc (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int mask; + if (argc != 3) + { + Tcl_AppendResult (interp, wrongArgs, *argv, + " level string\"", NULL); + return TCL_OK; + } + mask = log_mask_str_x (argv[1], 0); + logf (mask, "%s", argv[1], mask, argv[2]); + return TCL_OK; +} + + /* ------------------------------------------------------- */ static void ir_initResponse (void *obj, Z_InitResponse *initrs) { @@ -3824,7 +3851,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs, */ static void ir_select_read (ClientData clientData) { - IrTcl_Obj *p = clientData; + IrTcl_Obj *p = (IrTcl_Obj *) clientData; Z_APDU *apdu; int r; IrTcl_Request *rq; @@ -3854,7 +3881,7 @@ static void ir_select_read (ClientData clientData) p->failInfo = IR_TCL_FAIL_CONNECT; ir_tcl_eval (p->interp, p->failback); } - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); return; } if (p->callback) @@ -3862,7 +3889,7 @@ static void ir_select_read (ClientData clientData) if (p->ref_count == 2 && p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle) ir_tcl_send_q (p, p->request_queue, "x"); - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); return; } do @@ -3881,7 +3908,6 @@ static void ir_select_read (ClientData clientData) if (r <= 0) { logf (LOG_DEBUG, "cs_get failed, code %d", r); - ir_select_remove (cs_fileno (p->cs_link), p); ir_tcl_disconnect (p); if (p->failback) { @@ -3889,7 +3915,7 @@ static void ir_select_read (ClientData clientData) ir_tcl_eval (p->interp, p->failback); } /* release ir object now if callback deleted it */ - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); return; } /* got complete APDU. Now decode */ @@ -3909,7 +3935,7 @@ static void ir_select_read (ClientData clientData) ir_tcl_eval (p->interp, p->failback); } /* release ir object now if failback deleted it */ - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); return; } /* handle APDU and invoke callback */ @@ -3978,10 +4004,10 @@ static void ir_select_read (ClientData clientData) odr_reset (p->odr_in); if (p->ref_count == 1) { - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); return; } - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); } while (p->cs_link && cs_more (p->cs_link)); if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle) ir_tcl_send_q (p, p->request_queue, "x"); @@ -3992,7 +4018,7 @@ static void ir_select_read (ClientData clientData) */ static int ir_select_write (ClientData clientData) { - IrTcl_Obj *p = clientData; + IrTcl_Obj *p = (IrTcl_Obj *) clientData; int r; IrTcl_Request *rq; @@ -4018,12 +4044,12 @@ static int ir_select_write (ClientData clientData) p->failInfo = IR_TCL_FAIL_CONNECT; ir_tcl_eval (p->interp, p->failback); } - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); return 2; } if (p->callback) ir_tcl_eval (p->interp, p->callback); - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); return 2; } rq = p->request_queue; @@ -4042,7 +4068,7 @@ static int ir_select_write (ClientData clientData) p->failInfo = IR_TCL_FAIL_WRITE; ir_tcl_eval (p->interp, p->failback); } - ir_obj_delete (p); + ir_obj_delete ((ClientData) p); } else if (r == 0) /* remove select bit */ { @@ -4109,6 +4135,8 @@ EXPORT (int,Irtcl_Init) (Tcl_Interp *interp) (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand (interp, "ir-log-init", ir_log_init_proc, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand (interp, "ir-log", ir_log_proc, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; }