X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=ir-tcl.c;h=6aff70d69d4febf4630dd9cd8b587612dd391ede;hb=d96c455efaab3a585c3ba93a924856a4a6ee2ddb;hp=b28028d329c9023d2cde3cbdc7c52d145ae43700;hpb=756d3de787699768bca9079be47cf0c3839e9eec;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index b28028d..6aff70d 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,50 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.48 1995-06-27 19:03:50 adam + * 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 + * + * Revision 1.51 1995/08/03 13:22:54 adam + * Request queue. + * + * Revision 1.50 1995/07/20 08:09:49 adam + * client.tcl: Targets removed from hotTargets list when targets + * are removed/modified. + * ir-tcl.c: More work on triggerResourceControl. + * + * Revision 1.49 1995/06/30 12:39:21 adam + * Bug fix: loadFile didn't set record type. + * The MARC routines are a little less strict in the interpretation. + * Script display.tcl replaces the old marc.tcl. + * New interactive script: shell.tcl. + * + * Revision 1.48 1995/06/27 19:03:50 adam * Bug fix in do_present in ir-tcl.c: p->set_child member weren't set. * nextResultSetPosition used instead of setOffset. * @@ -186,8 +229,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); @@ -217,8 +258,7 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, } if (!rl) { - rl = malloc (sizeof(*rl)); - assert (rl); + rl = ir_tcl_malloc (sizeof(*rl)); rl->next = setobj->record_list; rl->no = no; setobj->record_list = rl; @@ -247,6 +287,7 @@ static struct { { VAL_AUSMARC, "AUSMARC" }, { VAL_IBERMARC, "IBERMARC" }, { VAL_SUTRS, "SUTRS" }, +{ VAL_GRS1, "GRS1" }, { 0, NULL } }; @@ -255,14 +296,9 @@ static struct { */ int IrTcl_eval (Tcl_Interp *interp, const char *command) { - char *tmp = malloc (strlen(command)+1); + char *tmp = ir_tcl_malloc (strlen(command)+1); int r; - if (!tmp) - { - logf (LOG_FATAL, "Out of memory in IrTcl_eval"); - exit (1); - } strcpy (tmp, command); r = Tcl_Eval (interp, tmp); if (r == TCL_ERROR) @@ -367,7 +403,8 @@ int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab) if (argc <= 0) return TCL_OK; - Tcl_AppendResult (interp, "Bad method. Possible methods:", NULL); + Tcl_AppendResult (interp, "Bad method: ", argv[1], + ". Possible methods:", NULL); for (tab_i = tab; tab_i->tab; tab_i++) for (t = tab_i->tab; t->name; t++) Tcl_AppendResult (interp, " ", t->name, NULL); @@ -429,53 +466,6 @@ int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, return TCL_OK; } -/* - * ir_strdup: Duplicate string - */ -int ir_strdup (Tcl_Interp *interp, char** p, const char *s) -{ - if (!s) - { - *p = NULL; - return TCL_OK; - } - *p = malloc (strlen(s)+1); - if (!*p) - { - interp->result = "strdup fail"; - return TCL_ERROR; - } - strcpy (*p, s); - return TCL_OK; -} - -/* - * ir_strdel: Delete string - */ -int ir_strdel (Tcl_Interp *interp, char **p) -{ - free (*p); - *p = NULL; - return TCL_OK; -} - -/* - * ir_malloc: Malloc function - */ -void *ir_malloc (Tcl_Interp *interp, size_t size) -{ - static char buf[128]; - void *p = malloc (size); - - if (!p) - { - sprintf (buf, "Malloc fail. %ld bytes requested", (long) size); - interp->result = buf; - return NULL; - } - return p; -} - static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src) { if (!src || !*src) @@ -497,7 +487,7 @@ static void get_referenceId (char **dst, Z_ReferenceId *src) *dst = NULL; return; } - *dst = malloc (src->len+1); + *dst = ir_tcl_malloc (src->len+1); memcpy (*dst, src->buf, src->len); (*dst)[src->len] = '\0'; } @@ -513,16 +503,14 @@ static int do_init_request (void *obj, Tcl_Interp *interp, Z_APDU *apdu; IrTcl_Obj *p = obj; Z_InitRequest *req; - int r; if (argc <= 0) return TCL_OK; if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "init: not connected"; return TCL_ERROR; } - odr_reset (p->odr_out); apdu = zget_APDU (p->odr_out, Z_APDU_initRequest); req = apdu->u.initRequest; @@ -568,28 +556,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, req->implementationVersion = p->implementationVersion; req->userInformationField = 0; - if (!z_APDU (p->odr_out, &apdu, 0)) - { - Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)], - NULL); - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in init"; - do_disconnect (p, NULL, 2, NULL); - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of initializeRequest (%d bytes)", p->slen); - } - else - logf (LOG_DEBUG, "Sent whole initializeRequest (%d bytes)", p->slen); - return TCL_OK; + return ir_tcl_send_APDU (interp, p, apdu, "init", argv[0]); } /* @@ -655,6 +622,7 @@ static int do_options (void *obj, Tcl_Interp *interp, ODR_MASK_ZERO (&p->options); ODR_MASK_SET (&p->options, 0); ODR_MASK_SET (&p->options, 1); + ODR_MASK_SET (&p->options, 4); ODR_MASK_SET (&p->options, 7); ODR_MASK_SET (&p->options, 14); return TCL_OK; @@ -759,14 +727,14 @@ static int do_implementationName (void *obj, Tcl_Interp *interp, IrTcl_Obj *p = obj; if (argc == 0) - return ir_strdup (interp, &p->implementationName, + return ir_tcl_strdup (interp, &p->implementationName, "Index Data/IrTcl on YAZ"); else if (argc == -1) - return ir_strdel (interp, &p->implementationName); + return ir_tcl_strdel (interp, &p->implementationName); if (argc == 3) { free (p->implementationName); - if (ir_strdup (interp, &p->implementationName, argv[2]) + if (ir_tcl_strdup (interp, &p->implementationName, argv[2]) == TCL_ERROR) return TCL_ERROR; } @@ -783,9 +751,9 @@ static int do_implementationId (void *obj, Tcl_Interp *interp, IrTcl_Obj *p = obj; if (argc == 0) - return ir_strdup (interp, &p->implementationId, "YAZ (id=81)"); + return ir_tcl_strdup (interp, &p->implementationId, "YAZ (id=81)"); else if (argc == -1) - return ir_strdel (interp, &p->implementationId); + return ir_tcl_strdel (interp, &p->implementationId); Tcl_AppendResult (interp, p->implementationId, (char*) NULL); return TCL_OK; } @@ -799,10 +767,10 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp, IrTcl_Obj *p = obj; if (argc == 0) - return ir_strdup (interp, &p->implementationVersion, + return ir_tcl_strdup (interp, &p->implementationVersion, "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION); else if (argc == -1) - return ir_strdel (interp, &p->implementationVersion); + return ir_tcl_strdel (interp, &p->implementationVersion); Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL); return TCL_OK; } @@ -821,7 +789,7 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, return TCL_OK; } else if (argc == -1) - return ir_strdel (interp, &p->targetImplementationName); + return ir_tcl_strdel (interp, &p->targetImplementationName); Tcl_AppendResult (interp, p->targetImplementationName, (char*) NULL); return TCL_OK; } @@ -840,7 +808,7 @@ static int do_targetImplementationId (void *obj, Tcl_Interp *interp, return TCL_OK; } else if (argc == -1) - return ir_strdel (interp, &p->targetImplementationId); + return ir_tcl_strdel (interp, &p->targetImplementationId); Tcl_AppendResult (interp, p->targetImplementationId, (char*) NULL); return TCL_OK; } @@ -859,7 +827,7 @@ static int do_targetImplementationVersion (void *obj, Tcl_Interp *interp, return TCL_OK; } else if (argc == -1) - return ir_strdel (interp, &p->targetImplementationVersion); + return ir_tcl_strdel (interp, &p->targetImplementationVersion); Tcl_AppendResult (interp, p->targetImplementationVersion, (char*) NULL); return TCL_OK; } @@ -892,19 +860,19 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, { if (argc == 3) { - if (ir_strdup (interp, &p->idAuthenticationOpen, argv[2]) + if (ir_tcl_strdup (interp, &p->idAuthenticationOpen, argv[2]) == TCL_ERROR) return TCL_ERROR; } else if (argc == 5) { - if (ir_strdup (interp, &p->idAuthenticationGroupId, argv[2]) + if (ir_tcl_strdup (interp, &p->idAuthenticationGroupId, argv[2]) == TCL_ERROR) return TCL_ERROR; - if (ir_strdup (interp, &p->idAuthenticationUserId, argv[3]) + if (ir_tcl_strdup (interp, &p->idAuthenticationUserId, argv[3]) == TCL_ERROR) return TCL_ERROR; - if (ir_strdup (interp, &p->idAuthenticationPassword, argv[4]) + if (ir_tcl_strdup (interp, &p->idAuthenticationPassword, argv[4]) == TCL_ERROR) return TCL_ERROR; } @@ -939,6 +907,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); @@ -972,8 +942,6 @@ static int do_connect (void *obj, Tcl_Interp *interp, p->cs_type, NULL); 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 = "connect fail"; @@ -984,17 +952,17 @@ static int do_connect (void *obj, Tcl_Interp *interp, if (r == 1) { ir_select_add_write (cs_fileno (p->cs_link), p); - p->connectFlag = 1; + p->state = IR_TCL_R_Connecting; } else { - p->connectFlag = 0; + p->state = IR_TCL_R_Idle; if (p->callback) IrTcl_eval (p->interp, p->callback); } } - if (p->hostname) - Tcl_AppendElement (interp, p->hostname); + else + Tcl_AppendResult (interp, p->hostname, NULL); return TCL_OK; } @@ -1008,7 +976,7 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, if (argc == 0) { - p->connectFlag = 0; + p->state = IR_TCL_R_Idle; p->hostname = NULL; p->cs_link = NULL; return TCL_OK; @@ -1020,6 +988,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; @@ -1027,12 +997,14 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, ODR_MASK_ZERO (&p->options); ODR_MASK_SET (&p->options, 0); ODR_MASK_SET (&p->options, 1); + ODR_MASK_SET (&p->options, 4); ODR_MASK_SET (&p->options, 7); ODR_MASK_SET (&p->options, 14); ODR_MASK_ZERO (&p->protocolVersion); ODR_MASK_SET (&p->protocolVersion, 0); ODR_MASK_SET (&p->protocolVersion, 1); + ir_tcl_del_q (p); } assert (!p->cs_link); return TCL_OK; @@ -1047,19 +1019,36 @@ static int do_comstack (void *o, Tcl_Interp *interp, IrTcl_Obj *obj = o; if (argc == 0) - return ir_strdup (interp, &obj->cs_type, "tcpip"); + return ir_tcl_strdup (interp, &obj->cs_type, "tcpip"); else if (argc == -1) - return ir_strdel (interp, &obj->cs_type); + return ir_tcl_strdel (interp, &obj->cs_type); else if (argc == 3) { free (obj->cs_type); - if (ir_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR) + if (ir_tcl_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR) return TCL_ERROR; } Tcl_AppendElement (interp, obj->cs_type); return TCL_OK; } +/* + * do_logLevel: Set log level + */ +static int do_logLevel (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + if (argc <= 2) + return TCL_OK; + if (argc == 3) + log_init (log_mask_str (argv[2]), "", NULL); + else if (argc == 4) + log_init (log_mask_str (argv[2]), argv[3], NULL); + else if (argc == 5) + log_init (log_mask_str (argv[2]), argv[3], argv[4]); + return TCL_OK; +} + /* * do_callback: add callback @@ -1075,18 +1064,17 @@ static int do_callback (void *obj, Tcl_Interp *interp, return TCL_OK; } else if (argc == -1) - return ir_strdel (interp, &p->callback); + return ir_tcl_strdel (interp, &p->callback); if (argc == 3) { free (p->callback); if (argv[2][0]) { - if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR) + if (ir_tcl_strdup (interp, &p->callback, argv[2]) == TCL_ERROR) return TCL_ERROR; } else p->callback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1105,18 +1093,17 @@ static int do_failback (void *obj, Tcl_Interp *interp, return TCL_OK; } else if (argc == -1) - return ir_strdel (interp, &p->failback); + return ir_tcl_strdel (interp, &p->failback); else if (argc == 3) { free (p->failback); if (argv[2][0]) { - if (ir_strdup (interp, &p->failback, argv[2]) == TCL_ERROR) + if (ir_tcl_strdup (interp, &p->failback, argv[2]) == TCL_ERROR) return TCL_ERROR; } else p->failback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1167,42 +1154,22 @@ static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, IrTcl_Obj *p = obj; Z_APDU *apdu; Z_TriggerResourceControlRequest *req; - int r; + bool_t is_false = 0; if (argc <= 0) 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); req = apdu->u.triggerResourceControlRequest; + *req->requestedAction = Z_TriggerResourceCtrl_cancel; + req->resultSetWanted = &is_false; - if (!z_APDU (p->odr_out, &apdu, 0)) - { - Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)], - NULL); - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in triggerResourceControl"; - do_disconnect (p, NULL, 2, NULL); - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of triggerResourceControl (%d bytes)", - p->slen); - } - else - logf (LOG_DEBUG, "Sent whole of triggerResourceControl (%d bytes)", - p->slen); - return TCL_OK; + return ir_tcl_send_APDU (interp, p, apdu, "triggerResourceControl", + argv[0]); } /* @@ -1239,12 +1206,11 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, free (p->databaseNames); } p->num_databaseNames = argc - 2; - if (!(p->databaseNames = ir_malloc (interp, - sizeof(*p->databaseNames) * p->num_databaseNames))) - return TCL_ERROR; + p->databaseNames = + ir_tcl_malloc (sizeof(*p->databaseNames) * p->num_databaseNames); for (i=0; inum_databaseNames; i++) { - if (ir_strdup (interp, &p->databaseNames[i], argv[2+i]) + if (ir_tcl_strdup (interp, &p->databaseNames[i], argv[2+i]) == TCL_ERROR) return TCL_ERROR; } @@ -1276,13 +1242,13 @@ static int do_queryType (void *obj, Tcl_Interp *interp, IrTcl_SetCObj *p = obj; if (argc == 0) - return ir_strdup (interp, &p->queryType, "rpn"); + return ir_tcl_strdup (interp, &p->queryType, "rpn"); else if (argc == -1) - return ir_strdel (interp, &p->queryType); + return ir_tcl_strdel (interp, &p->queryType); if (argc == 3) { free (p->queryType); - if (ir_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR) + if (ir_tcl_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR) return TCL_ERROR; } Tcl_AppendResult (interp, p->queryType, NULL); @@ -1303,7 +1269,7 @@ static int do_userInformationField (void *obj, Tcl_Interp *interp, return TCL_OK; } else if (argc == -1) - return ir_strdel (interp, &p->userInformationField); + return ir_tcl_strdel (interp, &p->userInformationField); Tcl_AppendResult (interp, p->userInformationField, NULL); return TCL_OK; } @@ -1370,11 +1336,11 @@ static int do_referenceId (void *obj, Tcl_Interp *interp, return TCL_OK; } else if (argc == -1) - return ir_strdel (interp, &p->referenceId); + return ir_tcl_strdel (interp, &p->referenceId); if (argc == 3) { free (p->referenceId); - if (ir_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR) + if (ir_tcl_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR) return TCL_ERROR; } Tcl_AppendResult (interp, p->referenceId, NULL); @@ -1405,17 +1371,45 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp, free (p->preferredRecordSyntax); p->preferredRecordSyntax = NULL; if (argv[2][0] && (p->preferredRecordSyntax = - malloc (sizeof(*p->preferredRecordSyntax)))) + ir_tcl_malloc (sizeof(*p->preferredRecordSyntax)))) *p->preferredRecordSyntax = IrTcl_getRecordSyntaxVal (argv[2]); } return TCL_OK; } + +/* + * 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; +} + + static IrTcl_Method ir_method_tab[] = { { 1, "comstack", do_comstack }, { 1, "protocol", do_protocol }, { 0, "failback", do_failback }, { 0, "failInfo", do_failInfo }, +{ 0, "logLevel", do_logLevel }, { 1, "connect", do_connect }, { 0, "protocolVersion", do_protocolVersion }, @@ -1447,6 +1441,7 @@ 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, NULL, NULL} }; @@ -1484,6 +1479,7 @@ static void ir_obj_delete (ClientData clientData) return; assert (obj->ref_count == 0); + logf (LOG_DEBUG, "ir object delete"); tab[0].tab = ir_method_tab; tab[0].obj = obj; tab[1].tab = ir_set_c_method_tab; @@ -1491,11 +1487,11 @@ static void ir_obj_delete (ClientData clientData) tab[2].tab = NULL; ir_method (NULL, -1, NULL, tab); + + ir_tcl_del_q (obj); odr_destroy (obj->odr_in); odr_destroy (obj->odr_out); odr_destroy (obj->odr_pr); - free (obj->buf_out); - free (obj->buf_in); free (obj); } @@ -1516,9 +1512,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, interp->result = "wrong # args"; return TCL_ERROR; } - if (!(obj = ir_malloc (interp, sizeof(*obj)))) - return TCL_ERROR; - + obj = ir_tcl_malloc (sizeof(*obj)); obj->ref_count = 1; #if CCL2RPN obj->bibset = ccl_qual_mk (); @@ -1529,17 +1523,16 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, } #endif + logf (LOG_DEBUG, "ir object create"); obj->odr_in = odr_createmem (ODR_DECODE); obj->odr_out = odr_createmem (ODR_ENCODE); obj->odr_pr = odr_createmem (ODR_PRINT); - - obj->len_out = 10000; - if (!(obj->buf_out = ir_malloc (interp, obj->len_out))) - return TCL_ERROR; - odr_setbuf (obj->odr_out, obj->buf_out, obj->len_out, 0); + obj->state = IR_TCL_R_Idle; + obj->interp = interp; obj->len_in = 0; obj->buf_in = NULL; + obj->request_queue = NULL; tab[0].tab = ir_method_tab; tab[0].obj = obj; @@ -1573,7 +1566,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_OK; p = obj->parent; - p->set_child = o; if (argc != 3) { interp->result = "wrong # args"; @@ -1586,10 +1578,9 @@ 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; } - odr_reset (p->odr_out); apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest); req = apdu->u.searchRequest; @@ -1625,6 +1616,18 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) } else req->preferredRecordSyntax = 0; + + if (obj->set_inher.elementSetNames && *obj->set_inher.elementSetNames) + { + 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")) @@ -1679,28 +1682,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) interp->result = "unknown query method"; return TCL_ERROR; } - if (!z_APDU (p->odr_out, &apdu, 0)) - { - interp->result = odr_errlist [odr_geterror (p->odr_out)]; - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in search"; - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of searchRequest (%d bytes)", p->slen); - } - else - { - logf (LOG_DEBUG, "Whole search request (%d bytes)", p->slen); - } - return TCL_OK; + return ir_tcl_send_APDU (interp, p, apdu, "search", argv[0]); } /* @@ -1768,13 +1750,13 @@ static int do_setName (void *o, Tcl_Interp *interp, IrTcl_SetObj *obj = o; if (argc == 0) - return ir_strdup (interp, &obj->setName, "Default"); + return ir_tcl_strdup (interp, &obj->setName, "Default"); else if (argc == -1) - return ir_strdel (interp, &obj->setName); + return ir_tcl_strdel (interp, &obj->setName); if (argc == 3) { free (obj->setName); - if (ir_strdup (interp, &obj->setName, argv[2]) + if (ir_tcl_strdup (interp, &obj->setName, argv[2]) == TCL_ERROR) return TCL_ERROR; } @@ -2006,6 +1988,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, @@ -2048,8 +2065,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; @@ -2057,7 +2073,6 @@ static int do_present (void *o, Tcl_Interp *interp, Z_PresentRequest *req; int start; int number; - int r; if (argc <= 0) return TCL_OK; @@ -2075,15 +2090,13 @@ 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; - p->set_child = obj; - odr_reset (p->odr_out); obj->start = start; obj->number = number; @@ -2110,31 +2123,21 @@ static int do_present (void *o, Tcl_Interp *interp, } else req->preferredRecordSyntax = 0; - - if (!z_APDU (p->odr_out, &apdu, 0)) + if (obj->set_inher.elementSetNames && *obj->set_inher.elementSetNames) { - interp->result = odr_errlist [odr_geterror (p->odr_out)]; - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in present"; - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Part of present request, start=%d, num=%d" - " (%d bytes)", start, number, p->slen); + 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 - { - logf (LOG_DEBUG, "Whole present request, start=%d, num=%d" - " (%d bytes)", start, number, p->slen); - } - return TCL_OK; + req->recordComposition = NULL; + return ir_tcl_send_APDU (interp, p, apdu, "present", argv[0]); } /* @@ -2168,6 +2171,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, IrTcl_RecordList *rl; rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord); + rl->u.dbrec.type = VAL_USMARC; rl->u.dbrec.buf = buf; rl->u.dbrec.size = size; no++; @@ -2189,6 +2193,7 @@ 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, "diag", do_diag }, { 0, "responseStatus", do_responseStatus }, @@ -2227,6 +2232,8 @@ static void ir_set_obj_delete (ClientData clientData) IrTcl_Methods tabs[3]; IrTcl_SetObj *p = clientData; + logf (LOG_DEBUG, "ir set delete"); + tabs[0].tab = ir_set_method_tab; tabs[0].obj = p; tabs[1].tab = ir_set_c_method_tab; @@ -2252,9 +2259,9 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, interp->result = "wrong # args"; return TCL_ERROR; } - if (!(obj = ir_malloc (interp, sizeof(*obj)))) - return TCL_ERROR; - else if (argc == 3) + obj = ir_tcl_malloc (sizeof(*obj)); + logf (LOG_DEBUG, "ir set create"); + if (argc == 3) { Tcl_CmdInfo parent_info; int i; @@ -2271,28 +2278,31 @@ 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; - if (!(dst->databaseNames = - ir_malloc (interp, sizeof (*dst->databaseNames) - * dst->num_databaseNames))) - return TCL_ERROR; + 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_strdup (interp, &dst->databaseNames[i], + if (ir_tcl_strdup (interp, &dst->databaseNames[i], src->databaseNames[i]) == TCL_ERROR) return TCL_ERROR; - } - if (ir_strdup (interp, &dst->queryType, src->queryType) + if (ir_tcl_strdup (interp, &dst->queryType, src->queryType) == TCL_ERROR) return TCL_ERROR; - if (ir_strdup (interp, &dst->referenceId, src->referenceId) + if (ir_tcl_strdup (interp, &dst->referenceId, src->referenceId) + == TCL_ERROR) + return TCL_ERROR; + + if (ir_tcl_strdup (interp, &dst->elementSetNames, src->elementSetNames) == TCL_ERROR) return TCL_ERROR; if (src->preferredRecordSyntax && (dst->preferredRecordSyntax - = malloc (sizeof(*dst->preferredRecordSyntax)))) + = ir_tcl_malloc (sizeof(*dst->preferredRecordSyntax)))) *dst->preferredRecordSyntax = *src->preferredRecordSyntax; else dst->preferredRecordSyntax = NULL; @@ -2327,7 +2337,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) Z_APDU *apdu; IrTcl_ScanObj *obj = o; IrTcl_Obj *p = obj->parent; - int r; oident bib1; #if CCL2RPN struct ccl_rpn_node *rpn; @@ -2336,7 +2345,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc <= 0) return TCL_OK; - p->scan_child = o; if (argc != 3) { interp->result = "wrong # args"; @@ -2349,10 +2357,9 @@ 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; } - odr_reset (p->odr_out); bib1.proto = p->protocol_type; bib1.class = CLASS_ATTSET; @@ -2392,29 +2399,8 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) *req->numberOfTermsRequested); logf (LOG_DEBUG, "preferredPositionInResponse=%d", *req->preferredPositionInResponse); - - if (!z_APDU (p->odr_out, &apdu, 0)) - { - interp->result = odr_errlist [odr_geterror (p->odr_out)]; - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in scan"; - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of scanRequest (%d bytes)", p->slen); - } - else - { - logf (LOG_DEBUG, "Whole scan request (%d bytes)", p->slen); - } - return TCL_OK; + + return ir_tcl_send_APDU (interp, p, apdu, "scan", argv[0]); } /* @@ -2629,9 +2615,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, interp->result = "No parent"; return TCL_ERROR; } - if (!(obj = ir_malloc (interp, sizeof(*obj)))) - return TCL_ERROR; - + obj = ir_tcl_malloc (sizeof(*obj)); obj->parent = (IrTcl_Obj *) parent_info.clientData; tabs[0].tab = ir_scan_method_tab; @@ -2660,13 +2644,13 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) get_referenceId (&p->set_inher.referenceId, initrs->referenceId); free (p->targetImplementationId); - ir_strdup (p->interp, &p->targetImplementationId, + ir_tcl_strdup (p->interp, &p->targetImplementationId, initrs->implementationId); free (p->targetImplementationName); - ir_strdup (p->interp, &p->targetImplementationName, + ir_tcl_strdup (p->interp, &p->targetImplementationName, initrs->implementationName); free (p->targetImplementationVersion); - ir_strdup (p->interp, &p->targetImplementationVersion, + ir_tcl_strdup (p->interp, &p->targetImplementationVersion, initrs->implementationVersion); p->maximumRecordSize = *initrs->maximumRecordSize; @@ -2683,9 +2667,9 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) if (initrs->userInformationField->which == ODR_EXTERNAL_octet && (p->userInformationField = - malloc ((len = - initrs->userInformationField->u.octet_aligned->len) - +1))) + ir_tcl_malloc ((len = + initrs->userInformationField-> + u.octet_aligned->len) +1))) { memcpy (p->userInformationField, initrs->userInformationField->u.octet_aligned->buf, @@ -2712,12 +2696,7 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, char *addinfo; *dst_num = num; - *dst_list = malloc (sizeof(**dst_list) * num); - if (!*dst_list) - { - *dst_num = 0; - return; - } + *dst_list = ir_tcl_malloc (sizeof(**dst_list) * num); for (i = 0; iwhich) @@ -2726,7 +2705,7 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, (*dst_list)[i].condition = *list[i]->u.defaultFormat->condition; addinfo = list[i]->u.defaultFormat->addinfo; if (addinfo && - ((*dst_list)[i].addinfo = malloc (strlen(addinfo)+1))) + ((*dst_list)[i].addinfo = ir_tcl_malloc (strlen(addinfo)+1))) strcpy ((*dst_list)[i].addinfo, addinfo); break; default: @@ -2736,10 +2715,9 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, } } -static void ir_handleRecords (void *o, Z_Records *zrs) +static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) { IrTcl_Obj *p = o; - IrTcl_SetObj *setobj = p->set_child; int offset; IrTcl_RecordList *rl; @@ -2770,46 +2748,43 @@ static void ir_handleRecords (void *o, Z_Records *zrs) 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; - ident = oid_getentbyoid (oe->direct_reference); - rl->u.dbrec.type = ident->value; + 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; - if ((rl->u.dbrec.buf = malloc (rl->u.dbrec.size))) + if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size))) 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)) - { - logf (LOG_WARN, "Cannot decode SUTRS"); - rl->u.dbrec.buf = NULL; - } - else + if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1))) { - if ((rl->u.dbrec.buf = 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; @@ -2837,10 +2812,9 @@ static void ir_handleRecords (void *o, Z_Records *zrs) } } -static void ir_searchResponse (void *o, Z_SearchResponse *searchrs) +static void ir_searchResponse (void *o, Z_SearchResponse *searchrs, + IrTcl_SetObj *setobj) { - IrTcl_Obj *p = o; - IrTcl_SetObj *setobj = p->set_child; Z_Records *zrs = searchrs->records; logf (LOG_DEBUG, "Received search response"); @@ -2860,16 +2834,15 @@ 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); + ir_handleRecords (o, zrs, setobj); else setobj->recordFlag = 0; } -static void ir_presentResponse (void *o, Z_PresentResponse *presrs) +static void ir_presentResponse (void *o, Z_PresentResponse *presrs, + IrTcl_SetObj *setobj) { - IrTcl_Obj *p = o; - IrTcl_SetObj *setobj = p->set_child; Z_Records *zrs = presrs->records; logf (LOG_DEBUG, "Received present response"); @@ -2882,7 +2855,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); + ir_handleRecords (o, zrs, setobj); else { setobj->recordFlag = 0; @@ -2890,10 +2863,10 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs) } } -static void ir_scanResponse (void *o, Z_ScanResponse *scanrs) +static void ir_scanResponse (void *o, Z_ScanResponse *scanrs, + IrTcl_ScanObj *scanobj) { IrTcl_Obj *p = o; - IrTcl_ScanObj *scanobj = p->scan_child; logf (LOG_DEBUG, "Received scanResponse"); @@ -2931,7 +2904,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs) { case Z_ListEntries_entries: scanobj->num_entries = scanrs->entries->u.entries->num_entries; - scanobj->entries = malloc (scanobj->num_entries * + scanobj->entries = ir_tcl_malloc (scanobj->num_entries * sizeof(*scanobj->entries)); for (i=0; inum_entries; i++) { @@ -2943,7 +2916,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs) if (ze->u.termInfo->term->which == Z_Term_general) { int l = ze->u.termInfo->term->u.general->len; - scanobj->entries[i].u.term.buf = malloc (1+l); + scanobj->entries[i].u.term.buf = ir_tcl_malloc (1+l); memcpy (scanobj->entries[i].u.term.buf, ze->u.termInfo->term->u.general->buf, l); @@ -2988,8 +2961,11 @@ void ir_select_read (ClientData clientData) IrTcl_Obj *p = clientData; Z_APDU *apdu; int r; + IrTcl_Request *rq; + char *object_name; + Tcl_CmdInfo cmd_info; - if (p->connectFlag) + if (p->state == IR_TCL_R_Connecting) { r = cs_rcvconnect (p->cs_link); if (r == 1) @@ -2997,7 +2973,7 @@ void ir_select_read (ClientData clientData) logf (LOG_WARN, "cs_rcvconnect returned 1"); return; } - p->connectFlag = 0; + p->state = IR_TCL_R_Idle; ir_select_remove_write (cs_fileno (p->cs_link), p); if (r < 0) { @@ -3010,81 +2986,112 @@ void ir_select_read (ClientData clientData) do_disconnect (p, NULL, 2, NULL); return; } + p->state = IR_TCL_R_Idle; if (p->callback) IrTcl_eval (p->interp, p->callback); + if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle) + ir_tcl_send_q (p, p->request_queue, "x"); return; } do { /* signal one more use of ir object - callbacks must not release the ir memory (p pointer) */ + p->state = IR_TCL_R_Reading; ++(p->ref_count); + + /* read incoming APDU */ if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 0) { 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); - - /* relase ir object now if callback deleted it */ + /* release ir object now if callback deleted it */ ir_obj_delete (p); return; } if (r == 1) return ; + /* got complete APDU. Now decode */ odr_setbuf (p->odr_in, p->buf_in, r, 0); logf (LOG_DEBUG, "cs_get ok, got %d", r); 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; } - switch(apdu->which) + /* handle APDU and invoke callback */ + rq = p->request_queue; + if (!rq) { - case Z_APDU_initResponse: - ir_initResponse (p, apdu->u.initResponse); - break; - case Z_APDU_searchResponse: - ir_searchResponse (p, apdu->u.searchResponse); - break; - case Z_APDU_presentResponse: - ir_presentResponse (p, apdu->u.presentResponse); - break; - case Z_APDU_scanResponse: - ir_scanResponse (p, apdu->u.scanResponse); - break; - default: - logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); - if (p->failback) + logf (LOG_FATAL, "Internal error. No queue entry"); + 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) { - p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; - IrTcl_eval (p->interp, p->failback); + case Z_APDU_initResponse: + ir_initResponse (p, apdu->u.initResponse); + break; + case Z_APDU_searchResponse: + ir_searchResponse (p, apdu->u.searchResponse, + (IrTcl_SetObj *) cmd_info.clientData); + break; + case Z_APDU_presentResponse: + ir_presentResponse (p, apdu->u.presentResponse, + (IrTcl_SetObj *) cmd_info.clientData); + break; + case Z_APDU_scanResponse: + ir_scanResponse (p, apdu->u.scanResponse, + (IrTcl_ScanObj *) cmd_info.clientData); + break; + 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); + } + return; } - do_disconnect (p, NULL, 2, NULL); } + p->request_queue = rq->next; + p->state = IR_TCL_R_Idle; + + if (rq->callback) + IrTcl_eval (p->interp, rq->callback); + free (rq->buf_out); + free (rq->callback); + free (rq->object_name); + free (rq); odr_reset (p->odr_in); - if (p->callback) - IrTcl_eval (p->interp, p->callback); if (p->ref_count == 1) { ir_obj_delete (p); return; } --(p->ref_count); - } while (p->cs_link && cs_more (p->cs_link)); + } 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"); } /* @@ -3094,14 +3101,15 @@ void ir_select_write (ClientData clientData) { IrTcl_Obj *p = clientData; int r; + IrTcl_Request *rq; logf (LOG_DEBUG, "In write handler"); - if (p->connectFlag) + if (p->state == IR_TCL_R_Connecting) { r = cs_rcvconnect (p->cs_link); if (r == 1) return; - p->connectFlag = 0; + p->state = IR_TCL_R_Idle; if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); @@ -3119,28 +3127,35 @@ void ir_select_write (ClientData clientData) IrTcl_eval (p->interp, p->callback); return; } - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { + rq = p->request_queue; + assert (rq); + if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0) + { logf (LOG_DEBUG, "select write fail"); if (p->failback) { p->failInfo = IR_TCL_FAIL_WRITE; IrTcl_eval (p->interp, p->failback); } + free (rq->buf_out); + rq->buf_out = NULL; do_disconnect (p, NULL, 2, NULL); } else if (r == 0) /* remove select bit */ { + p->state = IR_TCL_R_Waiting; ir_select_remove_write (cs_fileno (p->cs_link), p); + free (rq->buf_out); + rq->buf_out = NULL; } } /* ------------------------------------------------------- */ /* - * 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); @@ -3148,8 +3163,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; } -