X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=86da3b3ea9bb05ae7e1b44071f0d7df0cb99b1de;hb=4b96df0e1f1db0983dff2d019373fea918b8b6ec;hp=9d910c9ea1206d954fba443e1eefe877c9e7376d;hpb=6ddbb3991cc5ad6089410078695f574b2bd8388e;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index 9d910c9..86da3b3 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,17 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.52 1995-08-04 11:32:38 adam + * Revision 1.55 1995-08-28 09:43:25 adam + * Minor changes. configure only searches for yaz beta 3 and versions after + * that. + * + * Revision 1.54 1995/08/24 12:25:16 adam + * Modified to work with yaz 1.0b3. + * + * Revision 1.53 1995/08/04 12:49:26 adam + * Bug fix: reading uninitialized variable p. + * + * Revision 1.52 1995/08/04 11:32:38 adam * More work on output queue. Memory related routines moved * to mem.c * @@ -204,8 +214,6 @@ typedef struct { IrTcl_Method *tab; } IrTcl_Methods; -static Tcl_Interp *irTcl_interp; - static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num); static int do_disconnect (void *obj, Tcl_Interp *interp, int argc, char **argv); @@ -484,7 +492,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, return TCL_OK; if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "init: not connected"; return TCL_ERROR; } apdu = zget_APDU (p->odr_out, Z_APDU_initRequest); @@ -1047,7 +1055,6 @@ static int do_callback (void *obj, Tcl_Interp *interp, } else p->callback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1077,7 +1084,6 @@ static int do_failback (void *obj, Tcl_Interp *interp, } else p->failback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1134,7 +1140,7 @@ static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, return TCL_OK; if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "triggerResourceControl: not connected"; return TCL_ERROR; } apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest); @@ -1475,6 +1481,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->odr_out = odr_createmem (ODR_ENCODE); obj->odr_pr = odr_createmem (ODR_PRINT); obj->state = IR_TCL_R_Idle; + obj->interp = interp; obj->len_in = 0; obj->buf_in = NULL; @@ -1524,7 +1531,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) } if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "search: not connected"; return TCL_ERROR; } apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest); @@ -1964,8 +1971,7 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, * do_present: Perform Present Request */ -static int do_present (void *o, Tcl_Interp *interp, - int argc, char **argv) +static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) { IrTcl_SetObj *obj = o; IrTcl_Obj *p; @@ -1990,12 +1996,12 @@ static int do_present (void *o, Tcl_Interp *interp, } else number = 10; + p = obj->parent; if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "present: not connected"; return TCL_ERROR; } - p = obj->parent; obj->start = start; obj->number = number; @@ -2164,16 +2170,16 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, dst = &obj->set_inher; src = &obj->parent->set_inher; - dst->num_databaseNames = src->num_databaseNames; - dst->databaseNames = - ir_tcl_malloc (sizeof (*dst->databaseNames) - * dst->num_databaseNames); + if ((dst->num_databaseNames = src->num_databaseNames)) + dst->databaseNames = + ir_tcl_malloc (sizeof (*dst->databaseNames) + * dst->num_databaseNames); + else + dst->databaseNames = NULL; for (i = 0; i < dst->num_databaseNames; i++) - { if (ir_tcl_strdup (interp, &dst->databaseNames[i], src->databaseNames[i]) == TCL_ERROR) return TCL_ERROR; - } if (ir_tcl_strdup (interp, &dst->queryType, src->queryType) == TCL_ERROR) return TCL_ERROR; @@ -2239,7 +2245,7 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) } if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "scan: not connected"; return TCL_ERROR; } @@ -2630,12 +2636,12 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) else { Z_DatabaseRecord *zr; - Odr_external *oe; + Z_External *oe; struct oident *ident; zr = zrs->u.databaseOrSurDiagnostics->records[offset] ->u.databaseRecord; - oe = (Odr_external*) zr; + oe = (Z_External*) zr; rl->u.dbrec.size = zr->u.octet_aligned->len; rl->u.dbrec.type = VAL_USMARC; @@ -2648,27 +2654,17 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size); } else if (rl->u.dbrec.type == VAL_SUTRS && - oe->which == ODR_EXTERNAL_single) + oe->which == Z_External_sutrs) { - Odr_oct *rc; - - logf (LOG_DEBUG, "Decoding SUTRS"); odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf, oe->u.single_ASN1_type->len, 0); - if (!z_SUTRS(p->odr_in, &rc, 0)) + if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1))) { - logf (LOG_WARN, "Cannot decode SUTRS"); - rl->u.dbrec.buf = NULL; - } - else - { - if ((rl->u.dbrec.buf = ir_tcl_malloc (rc->len+1))) - { - memcpy (rl->u.dbrec.buf, rc->buf, rc->len); - rl->u.dbrec.buf[rc->len] = '\0'; - } - rl->u.dbrec.size = rc->len; + memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf, + oe->u.sutrs->len); + rl->u.dbrec.buf[oe->u.sutrs->len] = '\0'; } + rl->u.dbrec.size = oe->u.sutrs->len; } else rl->u.dbrec.buf = NULL; @@ -2927,6 +2923,7 @@ void ir_select_read (ClientData clientData) exit (1); } object_name = rq->object_name; + logf (LOG_DEBUG, "getCommandInfo (%s)", object_name); if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info)) { switch(apdu->which) @@ -3048,8 +3045,5 @@ int ir_tcl_init (Tcl_Interp *interp) (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - irTcl_interp = interp; return TCL_OK; } - -