X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=0f056779b1ff28b500c58aeac342859156370718;hb=a48560994cdd4d65473fd26f7aaabf974a8c9f19;hp=9d910c9ea1206d954fba443e1eefe877c9e7376d;hpb=6ddbb3991cc5ad6089410078695f574b2bd8388e;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index 9d910c9..0f05677 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,46 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.52 1995-08-04 11:32:38 adam + * Revision 1.63 1995-11-13 09:55:39 adam + * Multiple records at a position in a result-set with differnt + * element specs. + * + * Revision 1.62 1995/10/18 17:20:33 adam + * Work on target setup in client.tcl. + * + * Revision 1.61 1995/10/18 16:42:42 adam + * New settings: smallSetElementSetNames and mediumSetElementSetNames. + * + * Revision 1.60 1995/10/18 15:43:31 adam + * In search: mediumSetElementSetNames and smallSetElementSetNames are + * set to elementSetNames. + * + * Revision 1.59 1995/10/17 12:18:58 adam + * Bug fix: when target connection closed, the connection was not + * properly reestablished. + * + * Revision 1.58 1995/10/16 17:00:55 adam + * New setting: elementSetNames. + * Various client improvements. Medium presentation format looks better. + * + * Revision 1.57 1995/09/21 13:11:51 adam + * Support of dynamic loading. + * Test script uses load command if necessary. + * + * Revision 1.56 1995/08/29 15:30:14 adam + * Work on GRS records. + * + * 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,21 +243,22 @@ 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); static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, - int no, int which) + int no, int which, + const char *elements) { IrTcl_RecordList *rl; for (rl = setobj->record_list; rl; rl = rl->next) { - if (no == rl->no) + if (no == rl->no && (!rl->elements || !elements || + !strcmp(elements, rl->elements))) { + free (rl->elements); switch (rl->which) { case Z_NamePlusRecord_databaseRecord: @@ -241,6 +281,7 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, setobj->record_list = rl; } rl->which = which; + ir_tcl_strdup (NULL, &rl->elements, elements); return rl; } @@ -264,6 +305,7 @@ static struct { { VAL_AUSMARC, "AUSMARC" }, { VAL_IBERMARC, "IBERMARC" }, { VAL_SUTRS, "SUTRS" }, +{ VAL_GRS1, "GRS1" }, { 0, NULL } }; @@ -314,7 +356,9 @@ static IrTcl_RecordList *find_IR_record (IrTcl_SetObj *setobj, int no) IrTcl_RecordList *rl; for (rl = setobj->record_list; rl; rl = rl->next) - if (no == rl->no) + if (no == rl->no && + (!setobj->recordElements || !rl->elements || + !strcmp (setobj->recordElements, rl->elements))) return rl; return NULL; } @@ -484,7 +528,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); @@ -883,6 +927,8 @@ static int do_connect (void *obj, Tcl_Interp *interp, interp->result = "already connected"; return TCL_ERROR; } + if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) + return TCL_ERROR; if (!strcmp (p->cs_type, "tcpip")) { p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type); @@ -916,8 +962,6 @@ static int do_connect (void *obj, Tcl_Interp *interp, p->cs_type, NULL); return TCL_ERROR; } - if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) - return TCL_ERROR; if ((r=cs_connect (p->cs_link, addr)) < 0) { interp->result = "connect fail"; @@ -937,6 +981,8 @@ static int do_connect (void *obj, Tcl_Interp *interp, IrTcl_eval (p->interp, p->callback); } } + else + Tcl_AppendResult (interp, p->hostname, NULL); return TCL_OK; } @@ -962,6 +1008,8 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, ir_select_remove_write (cs_fileno (p->cs_link), p); ir_select_remove (cs_fileno (p->cs_link), p); + odr_reset (p->odr_in); + assert (p->cs_link); cs_close (p->cs_link); p->cs_link = NULL; @@ -1047,7 +1095,6 @@ static int do_callback (void *obj, Tcl_Interp *interp, } else p->callback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1077,7 +1124,6 @@ static int do_failback (void *obj, Tcl_Interp *interp, } else p->failback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1134,7 +1180,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); @@ -1352,6 +1398,84 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp, } +/* + * do_elementSetNames: Set/Get element Set Names + */ +static int do_elementSetNames (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; + + if (argc == 0) + { + p->elementSetNames = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->elementSetNames); + if (argc == 3) + { + free (p->elementSetNames); + if (ir_tcl_strdup (interp, &p->elementSetNames, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->elementSetNames, NULL); + return TCL_OK; +} + +/* + * do_smallSetElementSetNames: Set/Get small Set Element Set Names + */ +static int do_smallSetElementSetNames (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; + + if (argc == 0) + { + p->smallSetElementSetNames = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->smallSetElementSetNames); + if (argc == 3) + { + free (p->smallSetElementSetNames); + if (ir_tcl_strdup (interp, &p->smallSetElementSetNames, + argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->smallSetElementSetNames, NULL); + return TCL_OK; +} + +/* + * do_mediumSetElementSetNames: Set/Get medium Set Element Set Names + */ +static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; + + if (argc == 0) + { + p->mediumSetElementSetNames = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->mediumSetElementSetNames); + if (argc == 3) + { + free (p->mediumSetElementSetNames); + if (ir_tcl_strdup (interp, &p->mediumSetElementSetNames, + argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->mediumSetElementSetNames, NULL); + return TCL_OK; +} + + static IrTcl_Method ir_method_tab[] = { { 1, "comstack", do_comstack }, { 1, "protocol", do_protocol }, @@ -1389,6 +1513,9 @@ static IrTcl_Method ir_set_c_method_tab[] = { { 0, "largeSetLowerBound", do_largeSetLowerBound}, { 0, "mediumSetPresentNumber", do_mediumSetPresentNumber}, { 0, "referenceId", do_referenceId }, +{ 0, "elementSetNames", do_elementSetNames }, +{ 0, "smallSetElementSetNames", do_smallSetElementSetNames }, +{ 0, "mediumSetElementSetNames", do_mediumSetElementSetNames }, { 0, NULL, NULL} }; @@ -1475,6 +1602,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,12 +1652,14 @@ 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); req = apdu->u.searchRequest; + obj->start = 1; + bib1.proto = p->protocol_type; bib1.class = CLASS_ATTSET; bib1.value = VAL_BIB1; @@ -1547,8 +1677,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) req->databaseNames = obj->set_inher.databaseNames; for (r=0; r < obj->set_inher.num_databaseNames; r++) logf (LOG_DEBUG, " Database %s", obj->set_inher.databaseNames[r]); - req->smallSetElementSetNames = 0; - req->mediumSetElementSetNames = 0; if (obj->set_inher.preferredRecordSyntax) { struct oident ident; @@ -1562,8 +1690,33 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) } else req->preferredRecordSyntax = 0; - req->query = &query; + if (obj->set_inher.smallSetElementSetNames && + *obj->set_inher.smallSetElementSetNames) + { + Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn)); + + esn->which = Z_ElementSetNames_generic; + esn->u.generic = obj->set_inher.elementSetNames; + req->smallSetElementSetNames = esn; + } + else + req->smallSetElementSetNames = NULL; + + if (obj->set_inher.mediumSetElementSetNames && + *obj->set_inher.mediumSetElementSetNames) + { + Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn)); + + esn->which = Z_ElementSetNames_generic; + esn->u.generic = obj->set_inher.elementSetNames; + req->mediumSetElementSetNames = esn; + } + else + req->mediumSetElementSetNames = NULL; + + req->query = &query; + if (!strcmp (obj->set_inher.queryType, "rpn")) { Z_RPNQuery *RPNquery; @@ -1733,7 +1886,7 @@ static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) delete_IR_records (obj); return TCL_OK; } - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1742,7 +1895,10 @@ static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_ERROR; rl = find_IR_record (obj, offset); if (!rl) + { + logf (LOG_DEBUG, "No record at position %d", offset); return TCL_OK; + } switch (rl->which) { case Z_NamePlusRecord_databaseRecord: @@ -1773,7 +1929,7 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) { return TCL_OK; } - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1794,6 +1950,33 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) } /* + * set record elements (for record extraction) + */ +static int do_recordElements (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc == 0) + { + obj->recordElements = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (NULL, &obj->recordElements); + if (argc > 2) + { + sprintf (interp->result, "wrong # args"); + return TCL_ERROR; + } + if (argc == 2) + return ir_tcl_strdup (NULL, &obj->recordElements, + (*argv[1] ? argv[1] : NULL)); + Tcl_AppendResult (interp, obj->recordElements, NULL); + return TCL_OK; +} + +/* * ir_diagResult */ static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num) @@ -1831,7 +2014,7 @@ static int do_diag (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc <= 0) return TCL_OK; - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1896,7 +2079,7 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc <= 0) return TCL_OK; - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1922,6 +2105,41 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) /* + * do_getGrs: Get a GRS1 Record + */ +static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + int offset; + IrTcl_RecordList *rl; + + if (argc <= 0) + return TCL_OK; + if (argc < 3) + { + sprintf (interp->result, "wrong # args"); + return TCL_ERROR; + } + if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) + return TCL_ERROR; + rl = find_IR_record (obj, offset); + if (!rl) + { + Tcl_AppendResult (interp, "No record at #", argv[2], NULL); + return TCL_ERROR; + } + if (rl->which != Z_NamePlusRecord_databaseRecord) + { + Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL); + return TCL_ERROR; + } + if (rl->u.dbrec.type != VAL_GRS1) + return TCL_OK; + return ir_tcl_get_grs (interp, rl->u.dbrec.u.grs1, argc, argv); +} + + +/* * do_responseStatus: Return response status (present or search) */ static int do_responseStatus (void *o, Tcl_Interp *interp, @@ -1964,8 +2182,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 +2207,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; @@ -2023,7 +2240,21 @@ static int do_present (void *o, Tcl_Interp *interp, } else req->preferredRecordSyntax = 0; - + + if (obj->set_inher.elementSetNames && *obj->set_inher.elementSetNames) + { + Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn)); + Z_RecordComposition *compo = odr_malloc (p->odr_out, sizeof(*compo)); + + esn->which = Z_ElementSetNames_generic; + esn->u.generic = obj->set_inher.elementSetNames; + + req->recordComposition = compo; + compo->which = Z_RecordComp_simple; + compo->u.simple = esn; + } + else + req->recordComposition = NULL; return ir_tcl_send_APDU (interp, p, apdu, "present", argv[0]); } @@ -2042,7 +2273,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - if (argc < 3) + if (argc != 3) { interp->result = "wrong # args"; return TCL_ERROR; @@ -2057,7 +2288,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, { IrTcl_RecordList *rl; - rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord); + rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord, "F"); rl->u.dbrec.type = VAL_USMARC; rl->u.dbrec.buf = buf; rl->u.dbrec.size = size; @@ -2080,7 +2311,9 @@ static IrTcl_Method ir_set_method_tab[] = { { 0, "type", do_type }, { 0, "getMarc", do_getMarc }, { 0, "getSutrs", do_getSutrs }, + { 0, "getGrs", do_getGrs }, { 0, "recordType", do_recordType }, + { 0, "recordElements", do_recordElements }, { 0, "diag", do_diag }, { 0, "responseStatus", do_responseStatus }, { 0, "loadFile", do_loadFile }, @@ -2164,16 +2397,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; @@ -2182,6 +2415,20 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, == TCL_ERROR) return TCL_ERROR; + if (ir_tcl_strdup (interp, &dst->elementSetNames, src->elementSetNames) + == TCL_ERROR) + return TCL_ERROR; + + if (ir_tcl_strdup (interp, &dst->smallSetElementSetNames, + src->smallSetElementSetNames) + == TCL_ERROR) + return TCL_ERROR; + + if (ir_tcl_strdup (interp, &dst->mediumSetElementSetNames, + src->mediumSetElementSetNames) + == TCL_ERROR) + return TCL_ERROR; + if (src->preferredRecordSyntax && (dst->preferredRecordSyntax = ir_tcl_malloc (sizeof(*dst->preferredRecordSyntax)))) @@ -2239,7 +2486,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; } @@ -2597,7 +2844,8 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, } } -static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) +static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj, + const char *elements) { IrTcl_Obj *p = o; @@ -2618,7 +2866,8 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) { rl = new_IR_record (setobj, setobj->start + offset, zrs->u.databaseOrSurDiagnostics-> - records[offset]->which); + records[offset]->which, + elements); if (rl->which == Z_NamePlusRecord_surrogateDiagnostic) { ir_handleDiags (&rl->u.surrogateDiagnostics.list, @@ -2630,17 +2879,19 @@ 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; if ((ident = oid_getentbyoid (oe->direct_reference))) rl->u.dbrec.type = ident->value; + else + rl->u.dbrec.type = VAL_USMARC; + if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0) { char *buf = (char*) zr->u.octet_aligned->buf; @@ -2648,27 +2899,23 @@ 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 if (rl->u.dbrec.type == VAL_GRS1 && + oe->which == Z_External_grs1) + { + ir_tcl_read_grs (oe->u.grs1, &rl->u.dbrec.u.grs1); + rl->u.dbrec.buf = NULL; } else rl->u.dbrec.buf = NULL; @@ -2718,7 +2965,14 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs, logf (LOG_DEBUG, "Search response %d, %d hits", setobj->searchStatus, setobj->resultCount); if (zrs) - ir_handleRecords (o, zrs, setobj); + { + const char *es; + if (setobj->resultCount <= setobj->set_inher.smallSetUpperBound) + es = setobj->set_inher.smallSetElementSetNames; + else + es = setobj->set_inher.mediumSetElementSetNames; + ir_handleRecords (o, zrs, setobj, es); + } else setobj->recordFlag = 0; } @@ -2739,7 +2993,7 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs, get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId); setobj->nextResultSetPosition = *presrs->nextResultSetPosition; if (zrs) - ir_handleRecords (o, zrs, setobj); + ir_handleRecords (o, zrs, setobj, setobj->set_inher.elementSetNames); else { setobj->recordFlag = 0; @@ -2889,13 +3143,12 @@ void ir_select_read (ClientData clientData) { logf (LOG_DEBUG, "cs_get failed, code %d", r); ir_select_remove (cs_fileno (p->cs_link), p); + do_disconnect (p, NULL, 2, NULL); if (p->failback) { p->failInfo = IR_TCL_FAIL_READ; IrTcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); - /* release ir object now if callback deleted it */ ir_obj_delete (p); return; @@ -2908,13 +3161,12 @@ void ir_select_read (ClientData clientData) if (!z_APDU (p->odr_in, &apdu, 0)) { logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]); + do_disconnect (p, NULL, 2, NULL); 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 */ ir_obj_delete (p); return; @@ -2927,6 +3179,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) @@ -2949,12 +3202,12 @@ void ir_select_read (ClientData clientData) default: logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); + do_disconnect (p, NULL, 2, NULL); if (p->failback) { p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; IrTcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); return; } } @@ -3038,9 +3291,9 @@ void ir_select_write (ClientData clientData) /* ------------------------------------------------------- */ /* - * ir_tcl_init: Registration of TCL commands. + * Irtcl_init: Registration of TCL commands. */ -int ir_tcl_init (Tcl_Interp *interp) +int Irtcl_Init (Tcl_Interp *interp) { Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); @@ -3048,8 +3301,6 @@ 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; } -