X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=ir-tcl.c;h=b28028d329c9023d2cde3cbdc7c52d145ae43700;hb=756d3de787699768bca9079be47cf0c3839e9eec;hp=8ca0a36e3f2d983ebbc14b58668be663e61f6e16;hpb=38d3a59423e91dc9c0985c678afdfba1837cdb5f;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index 8ca0a36..b28028d 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -1,10 +1,75 @@ /* * IR toolkit for tcl/tk * (c) Index Data 1995 + * See the file LICENSE for details. * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.31 1995-05-26 11:44:10 adam + * 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. + * + * Revision 1.47 1995/06/25 10:25:04 adam + * Working on triggerResourceControl. Description of compile/install + * procedure moved to ir-tcl.sgml. + * + * Revision 1.46 1995/06/22 13:15:06 adam + * Feature: SUTRS. Setting getSutrs implemented. + * Work on display formats. + * Preferred record syntax can be set by the user. + * + * Revision 1.45 1995/06/20 08:07:30 adam + * New setting: failInfo. + * Working on better cancel mechanism. + * + * Revision 1.44 1995/06/19 17:01:20 adam + * Minor changes. + * + * Revision 1.43 1995/06/19 13:06:08 adam + * New define: IR_TCL_VERSION. + * + * Revision 1.42 1995/06/19 08:08:52 adam + * client.tcl: hotTargets now contain both database and target name. + * ir-tcl.c: setting protocol edited. Errors in callbacks are logged + * by logf(LOG_WARN, ...) calls. + * + * Revision 1.41 1995/06/16 12:28:16 adam + * Implemented preferredRecordSyntax. + * Minor changes in diagnostic handling. + * Record list deleted when connection closes. + * + * Revision 1.40 1995/06/14 13:37:18 adam + * Setting recordType implemented. + * Setting implementationVersion implemented. + * Settings implementationId / implementationName edited. + * + * Revision 1.39 1995/06/08 10:26:32 adam + * Bug fix in ir_strdup. + * + * Revision 1.38 1995/06/01 16:36:47 adam + * About buttons. Minor bug fixes. + * + * Revision 1.37 1995/06/01 07:31:20 adam + * Rename of many typedefs -> IrTcl_... + * + * Revision 1.36 1995/05/31 13:09:59 adam + * Client searches/presents may be interrupted. + * New moving book-logo. + * + * Revision 1.35 1995/05/31 08:36:33 adam + * Bug fix in client.tcl: didn't save options on clientrc.tcl. + * New method: referenceId. More work on scan. + * + * Revision 1.34 1995/05/29 10:33:42 adam + * README and rename of startup script. + * + * Revision 1.33 1995/05/29 09:15:11 quinn + * Changed CS_SR to PROTO_SR, etc. + * + * Revision 1.32 1995/05/29 08:44:16 adam + * Work on delete of objects. + * + * Revision 1.31 1995/05/26 11:44:10 adam * Bugs fixed. More work on MARC utilities and queries. Test * client is up-to-date again. * @@ -83,7 +148,7 @@ * * Revision 1.8 1995/03/15 08:25:16 adam * New method presentStatus to check for error on present. Misc. cleanup - * of IRRecordList manipulations. Full MARC record presentation in + * of IrTcl_RecordList manipulations. Full MARC record presentation in * search.tcl. * * Revision 1.7 1995/03/14 17:32:29 adam @@ -114,18 +179,23 @@ typedef struct { int type; char *name; int (*method) (void *obj, Tcl_Interp *interp, int argc, char **argv); -} IRMethod; +} IrTcl_Method; typedef struct { void *obj; - IRMethod *tab; -} IRMethods; + IrTcl_Method *tab; +} IrTcl_Methods; -static int do_disconnect (void *obj,Tcl_Interp *interp, int argc, char **argv); +static Tcl_Interp *irTcl_interp; -static IRRecordList *new_IR_record (IRSetObj *setobj, int no, int which) +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) { - IRRecordList *rl; + IrTcl_RecordList *rl; for (rl = setobj->record_list; rl; rl = rl->next) { @@ -138,8 +208,8 @@ static IRRecordList *new_IR_record (IRSetObj *setobj, int no, int which) rl->u.dbrec.buf = NULL; break; case Z_NamePlusRecord_surrogateDiagnostic: - free (rl->u.diag.addinfo); - rl->u.diag.addinfo = NULL; + ir_deleteDiags (&rl->u.surrogateDiagnostics.list, + &rl->u.surrogateDiagnostics.num); break; } break; @@ -157,115 +227,158 @@ static IRRecordList *new_IR_record (IRSetObj *setobj, int no, int which) return rl; } -static IRRecordList *find_IR_record (IRSetObj *setobj, int no) +static struct { + enum oid_value value; + const char *name; +} IrTcl_recordSyntaxTab[] = { +{ VAL_UNIMARC, "UNIMARC" }, +{ VAL_INTERMARC, "INTERMARC" }, +{ VAL_CCF, "CCF" }, +{ VAL_USMARC, "USMARC" }, +{ VAL_UKMARC, "UKMARC" }, +{ VAL_NORMARC, "NORMARC" }, +{ VAL_LIBRISMARC, "LIBRISMARC" }, +{ VAL_DANMARC, "DANMARC" }, +{ VAL_FINMARC, "FINMARC" }, +{ VAL_MAB, "MAB" }, +{ VAL_CANMARC, "CANMARC" }, +{ VAL_SBN, "SBN" }, +{ VAL_PICAMARC, "PICAMARC" }, +{ VAL_AUSMARC, "AUSMARC" }, +{ VAL_IBERMARC, "IBERMARC" }, +{ VAL_SUTRS, "SUTRS" }, +{ 0, NULL } +}; + +/* + * IrTcl_eval + */ +int IrTcl_eval (Tcl_Interp *interp, const char *command) { - IRRecordList *rl; + char *tmp = malloc (strlen(command)+1); + int r; - for (rl = setobj->record_list; rl; rl = rl->next) - if (no == rl->no) - return rl; - return NULL; + 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) + logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine, + interp->result); + Tcl_FreeResult (interp); + free (tmp); + return r; } /* - * getsetint: Set/get integer value + * IrTcl_getRecordSyntaxStr: Return record syntax name of object id */ -static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) +static const char *IrTcl_getRecordSyntaxStr (enum oid_value value) { - char buf[20]; - - if (argc == 3) - { - if (Tcl_GetInt (interp, argv[2], val)==TCL_ERROR) - return TCL_ERROR; - } - sprintf (buf, "%d", *val); - Tcl_AppendResult (interp, buf, NULL); - return TCL_OK; + int i; + for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) + if (IrTcl_recordSyntaxTab[i].value == value) + return IrTcl_recordSyntaxTab[i].name; + return "USMARC"; } /* - * mk_nonSurrogateDiagnostics: Make Tcl result with diagnostic info + * IrTcl_getRecordSyntaxVal: Return record syntax value of string */ -static int mk_nonSurrogateDiagnostics (Tcl_Interp *interp, - int condition, - const char *addinfo) +static enum oid_value IrTcl_getRecordSyntaxVal (const char *name) { - char buf[20]; - const char *cp; + int i; + for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) + if (!strcmp (IrTcl_recordSyntaxTab[i].name, name)) + return IrTcl_recordSyntaxTab[i].value; + return 0; +} - Tcl_AppendElement (interp, "NSD"); - sprintf (buf, "%d", condition); - Tcl_AppendElement (interp, buf); - cp = diagbib1_str (condition); - if (cp) - Tcl_AppendElement (interp, (char*) cp); - else - Tcl_AppendElement (interp, ""); - if (addinfo) - Tcl_AppendElement (interp, (char*) addinfo); - else - Tcl_AppendElement (interp, ""); - return TCL_OK; +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) + return rl; + return NULL; } -/* - * get_parent_info: Returns information about parent object. - */ -static int get_parent_info (Tcl_Interp *interp, const char *name, - Tcl_CmdInfo *parent_info, - const char **suffix) +static void delete_IR_records (IrTcl_SetObj *setobj) { - char parent_name[128]; - const char *csep = strrchr (name, '.'); - int pos; + IrTcl_RecordList *rl, *rl1; - if (!csep) + for (rl = setobj->record_list; rl; rl = rl1) { - interp->result = "missing ."; - return TCL_ERROR; + switch (rl->which) + { + case Z_NamePlusRecord_databaseRecord: + free (rl->u.dbrec.buf); + break; + case Z_NamePlusRecord_surrogateDiagnostic: + ir_deleteDiags (&rl->u.surrogateDiagnostics.list, + &rl->u.surrogateDiagnostics.num); + break; + } + rl1 = rl->next; + free (rl); } - if (suffix) - *suffix = csep+1; - pos = csep-name; - if (pos > 127) - pos = 127; - memcpy (parent_name, name, pos); - parent_name[pos] = '\0'; - if (!Tcl_GetCommandInfo (interp, parent_name, parent_info)) + setobj->record_list = NULL; +} + +/* + * get_set_int: Set/get integer value + */ +static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) +{ + char buf[20]; + + if (argc == 3) { - interp->result = "No parent"; - return TCL_ERROR; + if (Tcl_GetInt (interp, argv[2], val)==TCL_ERROR) + return TCL_ERROR; } + sprintf (buf, "%d", *val); + Tcl_AppendResult (interp, buf, NULL); return TCL_OK; } /* * ir_method: Search for method in table and invoke method handler */ -int ir_method (Tcl_Interp *interp, int argc, char **argv, IRMethods *tab) +int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab) { - IRMethods *tab_i = tab; - IRMethod *t; + IrTcl_Methods *tab_i = tab; + IrTcl_Method *t; for (tab_i = tab; tab_i->tab; tab_i++) for (t = tab_i->tab; t->name; t++) - if (!strcmp (t->name, argv[1])) - return (*t->method)(tab_i->obj, interp, argc, argv); + if (argc <= 0) + { + if ((*t->method)(tab_i->obj, interp, argc, argv) == TCL_ERROR) + return TCL_ERROR; + } + else + if (!strcmp (t->name, argv[1])) + return (*t->method)(tab_i->obj, interp, argc, argv); + if (argc <= 0) + return TCL_OK; Tcl_AppendResult (interp, "Bad method. 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); return TCL_ERROR; - } /* * ir_method_r: Get status for all readable elements */ int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv, - IRMethod *tab) + IrTcl_Method *tab) { char *argv_n[3]; int argc_n; @@ -284,29 +397,10 @@ int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv, } /* - * ir_asc2bitmask: Ascii to ODR bitmask conversion - */ -int ir_asc2bitmask (const char *asc, Odr_bitmask *ob) -{ - const char *cp = asc + strlen(asc); - int bitno = 0; - - ODR_MASK_ZERO (ob); - do - { - if (*--cp == '1') - ODR_MASK_SET (ob, bitno); - bitno++; - } while (cp != asc); - return bitno; -} - -/* * ir_named_bits: get/set named bits */ int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, - Tcl_Interp *interp, - int argc, char **argv) + Tcl_Interp *interp, int argc, char **argv) { struct ir_named_entry *ti; if (argc > 0) @@ -340,6 +434,11 @@ int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, */ 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) { @@ -351,6 +450,16 @@ int ir_strdup (Tcl_Interp *interp, char** p, const char *s) } /* + * 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) @@ -367,31 +476,61 @@ void *ir_malloc (Tcl_Interp *interp, size_t size) return p; } +static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src) +{ + if (!src || !*src) + *dst = NULL; + else + { + *dst = odr_malloc (o, sizeof(**dst)); + (*dst)->size = (*dst)->len = strlen(src); + (*dst)->buf = odr_malloc (o, (*dst)->len); + memcpy ((*dst)->buf, src, (*dst)->len); + } +} + +static void get_referenceId (char **dst, Z_ReferenceId *src) +{ + free (*dst); + if (!src) + { + *dst = NULL; + return; + } + *dst = malloc (src->len+1); + memcpy (*dst, src->buf, src->len); + (*dst)[src->len] = '\0'; +} + /* ------------------------------------------------------- */ /* * do_init_request: init method on IR object */ static int do_init_request (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { - Z_APDU apdu, *apdup = &apdu; - IRObj *p = obj; - Z_InitRequest req; + 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"; return TCL_ERROR; } odr_reset (p->odr_out); + apdu = zget_APDU (p->odr_out, Z_APDU_initRequest); + req = apdu->u.initRequest; - req.referenceId = 0; - req.options = &p->options; - req.protocolVersion = &p->protocolVersion; - req.preferredMessageSize = &p->preferredMessageSize; - req.maximumRecordSize = &p->maximumRecordSize; + set_referenceId (p->odr_out, &req->referenceId, p->set_inher.referenceId); + req->options = &p->options; + req->protocolVersion = &p->protocolVersion; + req->preferredMessageSize = &p->preferredMessageSize; + req->maximumRecordSize = &p->maximumRecordSize; if (p->idAuthenticationGroupId) { @@ -412,27 +551,24 @@ static int do_init_request (void *obj, Tcl_Interp *interp, pass->password = p->idAuthenticationPassword; else pass->password = NULL; - req.idAuthentication = auth; + req->idAuthentication = auth; } else if (!p->idAuthenticationOpen || !*p->idAuthenticationOpen) - req.idAuthentication = NULL; + req->idAuthentication = NULL; else { Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth)); auth->which = Z_IdAuthentication_open; auth->u.open = p->idAuthenticationOpen; - req.idAuthentication = auth; + req->idAuthentication = auth; } - req.implementationId = p->implementationId; - req.implementationName = p->implementationName; - req.implementationVersion = "0.1"; - req.userInformationField = 0; + req->implementationId = p->implementationId; + req->implementationName = p->implementationName; + req->implementationVersion = p->implementationVersion; + req->userInformationField = 0; - apdu.u.initRequest = &req; - apdu.which = Z_APDU_initRequest; - - if (!z_APDU (p->odr_out, &apdup, 0)) + if (!z_APDU (p->odr_out, &apdu, 0)) { Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)], NULL); @@ -443,7 +579,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) { interp->result = "cs_put failed in init"; - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); return TCL_ERROR; } else if (r == 1) @@ -462,17 +598,31 @@ static int do_init_request (void *obj, Tcl_Interp *interp, static int do_protocolVersion (void *obj, Tcl_Interp *interp, int argc, char **argv) { - static struct ir_named_entry version_tab[] = { - { "1", 0 }, - { "2", 1 }, - { "3", 2 }, - { "4", 3 }, - { NULL,0} - }; - IRObj *p = obj; + int version, i; + char buf[10]; + IrTcl_Obj *p = obj; - return ir_named_bits (version_tab, &p->protocolVersion, - interp, argc-2, argv+2); + if (argc <= 0) + { + ODR_MASK_ZERO (&p->protocolVersion); + ODR_MASK_SET (&p->protocolVersion, 0); + ODR_MASK_SET (&p->protocolVersion, 1); + return TCL_OK; + } + if (argc == 3) + { + if (Tcl_GetInt (interp, argv[2], &version)==TCL_ERROR) + return TCL_ERROR; + ODR_MASK_ZERO (&p->protocolVersion); + for (i = 0; iprotocolVersion, i); + } + for (i = 4; --i >= 0; ) + if (ODR_MASK_GET (&p->protocolVersion, i)) + break; + sprintf (buf, "%d", i+1); + interp->result = buf; + return TCL_OK; } /* @@ -491,25 +641,82 @@ static int do_options (void *obj, Tcl_Interp *interp, { "accessCtrl", 6}, { "scan", 7}, { "sort", 8}, - { "extentedServices", 10}, + { "extendedServices", 10}, { "level-1Segmentation", 11}, { "level-2Segmentation", 12}, { "concurrentOperations", 13}, { "namedResultSets", 14}, { NULL, 0} }; - IRObj *p = obj; + IrTcl_Obj *p = obj; + if (argc <= 0) + { + ODR_MASK_ZERO (&p->options); + ODR_MASK_SET (&p->options, 0); + ODR_MASK_SET (&p->options, 1); + ODR_MASK_SET (&p->options, 7); + ODR_MASK_SET (&p->options, 14); + return TCL_OK; + } return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2); } /* + * do_failInfo: Get fail information + */ +static int do_failInfo (void *obj, Tcl_Interp *interp, int argc, char **argv) +{ + char buf[16], *cp; + IrTcl_Obj *p = obj; + + if (argc <= 0) + { + p->failInfo = 0; + return TCL_OK; + } + sprintf (buf, "%d", p->failInfo); + switch (p->failInfo) + { + case 0: + cp = "ok"; + break; + case IR_TCL_FAIL_CONNECT: + cp = "connect failed"; + break; + case IR_TCL_FAIL_READ: + cp = "connection closed"; + break; + case IR_TCL_FAIL_WRITE: + cp = "connection closed"; + break; + case IR_TCL_FAIL_IN_APDU: + cp = "failed to decode incoming APDU"; + break; + case IR_TCL_FAIL_UNKNOWN_APDU: + cp = "unknown APDU"; + break; + default: + cp = ""; + } + Tcl_AppendElement (interp, buf); + Tcl_AppendElement (interp, cp); + return TCL_OK; +} + +/* * do_preferredMessageSize: Set/get preferred message size */ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; + IrTcl_Obj *p = obj; + + if (argc <= 0) + { + p->preferredMessageSize = 30000; + return TCL_OK; + } return get_set_int (&p->preferredMessageSize, interp, argc, argv); } @@ -517,9 +724,15 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp, * do_maximumRecordSize: Set/get maximum record size */ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { - IRObj *p = obj; + IrTcl_Obj *p = obj; + + if (argc <= 0) + { + p->maximumRecordSize = 30000; + return TCL_OK; + } return get_set_int (&p->maximumRecordSize, interp, argc, argv); } @@ -529,8 +742,10 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp, static int do_initResult (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; - + IrTcl_Obj *p = obj; + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->initResult, interp, argc, argv); } @@ -541,35 +756,54 @@ static int do_initResult (void *obj, Tcl_Interp *interp, static int do_implementationName (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; + IrTcl_Obj *p = obj; + if (argc == 0) + return ir_strdup (interp, &p->implementationName, + "Index Data/IrTcl on YAZ"); + else if (argc == -1) + return ir_strdel (interp, &p->implementationName); if (argc == 3) { - free (((IRObj*)obj)->implementationName); + free (p->implementationName); if (ir_strdup (interp, &p->implementationName, argv[2]) == TCL_ERROR) return TCL_ERROR; } - Tcl_AppendResult (interp, p->implementationName, - (char*) NULL); + Tcl_AppendResult (interp, p->implementationName, (char*) NULL); return TCL_OK; } /* - * do_implementationId: Set/get Implementation Id. + * do_implementationId: Get Implementation Id. */ static int do_implementationId (void *obj, Tcl_Interp *interp, int argc, char **argv) { - if (argc == 3) - { - free (((IRObj*)obj)->implementationId); - if (ir_strdup (interp, &((IRObj*) obj)->implementationId, argv[2]) - == TCL_ERROR) - return TCL_ERROR; - } - Tcl_AppendResult (interp, ((IRObj*)obj)->implementationId, - (char*) NULL); + IrTcl_Obj *p = obj; + + if (argc == 0) + return ir_strdup (interp, &p->implementationId, "YAZ (id=81)"); + else if (argc == -1) + return ir_strdel (interp, &p->implementationId); + Tcl_AppendResult (interp, p->implementationId, (char*) NULL); + return TCL_OK; +} + +/* + * do_implementationVersion: get Implementation Version. + */ +static int do_implementationVersion (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + + if (argc == 0) + return ir_strdup (interp, &p->implementationVersion, + "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION); + else if (argc == -1) + return ir_strdel (interp, &p->implementationVersion); + Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL); return TCL_OK; } @@ -577,12 +811,18 @@ static int do_implementationId (void *obj, Tcl_Interp *interp, * do_targetImplementationName: Get Implementation Name of target. */ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { - IRObj *p = obj; - - Tcl_AppendResult (interp, p->targetImplementationName, - (char*) NULL); + IrTcl_Obj *p = obj; + + if (argc == 0) + { + p->targetImplementationName = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->targetImplementationName); + Tcl_AppendResult (interp, p->targetImplementationName, (char*) NULL); return TCL_OK; } @@ -592,8 +832,16 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, static int do_targetImplementationId (void *obj, Tcl_Interp *interp, int argc, char **argv) { - Tcl_AppendResult (interp, ((IRObj*)obj)->targetImplementationId, - (char*) NULL); + IrTcl_Obj *p = obj; + + if (argc == 0) + { + p->targetImplementationId = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->targetImplementationId); + Tcl_AppendResult (interp, p->targetImplementationId, (char*) NULL); return TCL_OK; } @@ -603,8 +851,16 @@ static int do_targetImplementationId (void *obj, Tcl_Interp *interp, static int do_targetImplementationVersion (void *obj, Tcl_Interp *interp, int argc, char **argv) { - Tcl_AppendResult (interp, ((IRObj*)obj)->targetImplementationVersion, - (char*) NULL); + IrTcl_Obj *p = obj; + + if (argc == 0) + { + p->targetImplementationVersion = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->targetImplementationVersion); + Tcl_AppendResult (interp, p->targetImplementationVersion, (char*) NULL); return TCL_OK; } @@ -614,19 +870,26 @@ static int do_targetImplementationVersion (void *obj, Tcl_Interp *interp, static int do_idAuthentication (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; + IrTcl_Obj *p = obj; - if (argc >= 3) + if (argc >= 3 || argc == -1) { free (p->idAuthenticationOpen); free (p->idAuthenticationGroupId); free (p->idAuthenticationUserId); free (p->idAuthenticationPassword); + } + if (argc >= 3 || argc <= 0) + { p->idAuthenticationOpen = NULL; p->idAuthenticationGroupId = NULL; p->idAuthenticationUserId = NULL; p->idAuthenticationPassword = NULL; - + } + if (argc <= 0) + return TCL_OK; + if (argc >= 3) + { if (argc == 3) { if (ir_strdup (interp, &p->idAuthenticationOpen, argv[2]) @@ -648,14 +911,11 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, } if (p->idAuthenticationOpen) Tcl_AppendElement (interp, p->idAuthenticationOpen); - else + else if (p->idAuthenticationGroupId) { - Tcl_AppendElement (interp, p->idAuthenticationGroupId ? - p->idAuthenticationGroupId : ""); - Tcl_AppendElement (interp, p->idAuthenticationUserId ? - p->idAuthenticationUserId : ""); - Tcl_AppendElement (interp, p->idAuthenticationPassword ? - p->idAuthenticationPassword : ""); + Tcl_AppendElement (interp, p->idAuthenticationGroupId); + Tcl_AppendElement (interp, p->idAuthenticationUserId); + Tcl_AppendElement (interp, p->idAuthenticationPassword); } return TCL_OK; } @@ -667,10 +927,11 @@ static int do_connect (void *obj, Tcl_Interp *interp, int argc, char **argv) { void *addr; - IRObj *p = obj; + IrTcl_Obj *p = obj; int r; - int protocol_type = CS_Z3950; + if (argc <= 0) + return TCL_OK; if (argc == 3) { if (p->hostname) @@ -678,18 +939,9 @@ static int do_connect (void *obj, Tcl_Interp *interp, interp->result = "already connected"; return TCL_ERROR; } - if (!strcmp (p->protocol_type, "Z3950")) - protocol_type = CS_Z3950; - else if (!strcmp (p->protocol_type, "SR")) - protocol_type = CS_SR; - else - { - interp->result = "bad protocol type"; - return TCL_ERROR; - } if (!strcmp (p->cs_type, "tcpip")) { - p->cs_link = cs_create (tcpip_type, CS_BLOCK, protocol_type); + p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type); addr = tcpip_strtoaddr (argv[2]); if (!addr) { @@ -698,10 +950,10 @@ static int do_connect (void *obj, Tcl_Interp *interp, } logf (LOG_DEBUG, "tcp/ip connect %s", argv[2]); } -#if MOSI else if (!strcmp (p->cs_type, "mosi")) { - p->cs_link = cs_create (mosi_type, CS_BLOCK, protocol_type); +#if MOSI + p->cs_link = cs_create (mosi_type, CS_BLOCK, p->protocol_type); addr = mosi_strtoaddr (argv[2]); if (!addr) { @@ -709,19 +961,23 @@ static int do_connect (void *obj, Tcl_Interp *interp, return TCL_ERROR; } logf (LOG_DEBUG, "mosi connect %s", argv[2]); - } +#else + interp->result = "MOSI support not there"; + return TCL_ERROR; #endif + } else { - interp->result = "unknown comstack type"; + Tcl_AppendResult (interp, "Bad comstack type: ", + 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 = "cs_connect fail"; - do_disconnect (p, NULL, 0, NULL); + interp->result = "connect fail"; + do_disconnect (p, NULL, 2, NULL); return TCL_ERROR; } ir_select_add (cs_fileno (p->cs_link), p); @@ -734,7 +990,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, { p->connectFlag = 0; if (p->callback) - Tcl_Eval (p->interp, p->callback); + IrTcl_eval (p->interp, p->callback); } } if (p->hostname) @@ -748,8 +1004,15 @@ static int do_connect (void *obj, Tcl_Interp *interp, static int do_disconnect (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; + IrTcl_Obj *p = obj; + if (argc == 0) + { + p->connectFlag = 0; + p->hostname = NULL; + p->cs_link = NULL; + return TCL_OK; + } if (p->hostname) { free (p->hostname); @@ -760,6 +1023,16 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, assert (p->cs_link); cs_close (p->cs_link); p->cs_link = NULL; + + ODR_MASK_ZERO (&p->options); + ODR_MASK_SET (&p->options, 0); + ODR_MASK_SET (&p->options, 1); + 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); } assert (!p->cs_link); return TCL_OK; @@ -771,9 +1044,13 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, static int do_comstack (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRObj *obj = o; + IrTcl_Obj *obj = o; - if (argc == 3) + if (argc == 0) + return ir_strdup (interp, &obj->cs_type, "tcpip"); + else if (argc == -1) + return ir_strdel (interp, &obj->cs_type); + else if (argc == 3) { free (obj->cs_type); if (ir_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR) @@ -783,57 +1060,148 @@ static int do_comstack (void *o, Tcl_Interp *interp, return TCL_OK; } + /* - * do_protocol: Set/get protocol method on IR object + * do_callback: add callback */ -static int do_protocol (void *o, Tcl_Interp *interp, - int argc, char **argv) +static int do_callback (void *obj, Tcl_Interp *interp, + int argc, char **argv) { - IRObj *obj = o; + IrTcl_Obj *p = obj; + if (argc == 0) + { + p->callback = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->callback); if (argc == 3) { - free (obj->protocol_type); - if (ir_strdup (interp, &obj->protocol_type, argv[2]) == TCL_ERROR) - return TCL_ERROR; + free (p->callback); + if (argv[2][0]) + { + if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + else + p->callback = NULL; + p->interp = interp; } - Tcl_AppendElement (interp, obj->protocol_type); return TCL_OK; } /* - * do_callback: add callback + * do_failback: add error handle callback */ -static int do_callback (void *obj, Tcl_Interp *interp, +static int do_failback (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; + IrTcl_Obj *p = obj; - if (argc == 3) + if (argc == 0) { - free (p->callback); - if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR) - return TCL_ERROR; + p->failback = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_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) + return TCL_ERROR; + } + else + p->failback = NULL; p->interp = interp; } return TCL_OK; } /* - * do_failback: add error handle callback + * do_protocol: Set/get protocol method on IR object */ -static int do_failback (void *obj, Tcl_Interp *interp, - int argc, char **argv) +static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; + IrTcl_Obj *p = o; - if (argc == 3) + if (argc <= 0) { - free (p->failback); - if (ir_strdup (interp, &p->failback, argv[2]) == TCL_ERROR) + p->protocol_type = PROTO_Z3950; + return TCL_OK; + } + else if (argc == 3) + { + if (!strcmp (argv[2], "Z39")) + p->protocol_type = PROTO_Z3950; + else if (!strcmp (argv[2], "SR")) + p->protocol_type = PROTO_SR; + else + { + Tcl_AppendResult (interp, "Bad protocol: ", argv[2], NULL); return TCL_ERROR; - p->interp = interp; + } + return TCL_OK; + } + switch (p->protocol_type) + { + case PROTO_Z3950: + Tcl_AppendElement (interp, "Z39"); + break; + case PROTO_SR: + Tcl_AppendElement (interp, "SR"); + break; + } + return TCL_OK; +} + +/* + * do_triggerResourceControl: + */ +static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + Z_APDU *apdu; + Z_TriggerResourceControlRequest *req; + int r; + + if (argc <= 0) + return TCL_OK; + if (!p->cs_link) + { + interp->result = "not connected"; + return TCL_ERROR; + } + apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest); + req = apdu->u.triggerResourceControlRequest; + + 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; } @@ -841,11 +1209,23 @@ static int do_failback (void *obj, Tcl_Interp *interp, * do_databaseNames: specify database names */ static int do_databaseNames (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { int i; - IRSetCObj *p = obj; + IrTcl_SetCObj *p = obj; + if (argc == -1) + { + for (i=0; inum_databaseNames; i++) + free (p->databaseNames[i]); + free (p->databaseNames); + } + if (argc <= 0) + { + p->num_databaseNames = 0; + p->databaseNames = NULL; + return TCL_OK; + } if (argc < 3) { for (i=0; inum_databaseNames; i++) @@ -877,8 +1257,13 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, static int do_replaceIndicator (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *p = obj; + IrTcl_SetCObj *p = obj; + if (argc <= 0) + { + p->replaceIndicator = 1; + return TCL_OK; + } return get_set_int (&p->replaceIndicator, interp, argc, argv); } @@ -888,8 +1273,12 @@ static int do_replaceIndicator (void *obj, Tcl_Interp *interp, static int do_queryType (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *p = obj; + IrTcl_SetCObj *p = obj; + if (argc == 0) + return ir_strdup (interp, &p->queryType, "rpn"); + else if (argc == -1) + return ir_strdel (interp, &p->queryType); if (argc == 3) { free (p->queryType); @@ -906,8 +1295,15 @@ static int do_queryType (void *obj, Tcl_Interp *interp, static int do_userInformationField (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRObj *p = obj; - + IrTcl_Obj *p = obj; + + if (argc == 0) + { + p->userInformationField = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->userInformationField); Tcl_AppendResult (interp, p->userInformationField, NULL); return TCL_OK; } @@ -918,9 +1314,14 @@ static int do_userInformationField (void *obj, Tcl_Interp *interp, static int do_smallSetUpperBound (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *obj = o; + IrTcl_SetCObj *p = o; - return get_set_int (&obj->smallSetUpperBound, interp, argc, argv); + if (argc <= 0) + { + p->smallSetUpperBound = 0; + return TCL_OK; + } + return get_set_int (&p->smallSetUpperBound, interp, argc, argv); } /* @@ -929,9 +1330,14 @@ static int do_smallSetUpperBound (void *o, Tcl_Interp *interp, static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *obj = o; + IrTcl_SetCObj *p = o; - return get_set_int (&obj->largeSetLowerBound, interp, argc, argv); + if (argc <= 0) + { + p->largeSetLowerBound = 2; + return TCL_OK; + } + return get_set_int (&p->largeSetLowerBound, interp, argc, argv); } /* @@ -940,16 +1346,76 @@ static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *obj = o; - - return get_set_int (&obj->mediumSetPresentNumber, interp, argc, argv); + IrTcl_SetCObj *p = o; + + if (argc <= 0) + { + p->mediumSetPresentNumber = 0; + return TCL_OK; + } + return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); +} + +/* + * do_referenceId: Set/Get referenceId + */ +static int do_referenceId (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; + + if (argc == 0) + { + p->referenceId = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->referenceId); + if (argc == 3) + { + free (p->referenceId); + if (ir_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->referenceId, NULL); + return TCL_OK; } +/* + * do_preferredRecordSyntax: Set/get preferred record syntax + */ +static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; -static IRMethod ir_method_tab[] = { + if (argc == 0) + { + p->preferredRecordSyntax = NULL; + return TCL_OK; + } + else if (argc == -1) + { + free (p->preferredRecordSyntax); + p->preferredRecordSyntax = NULL; + return TCL_OK; + } + if (argc == 3) + { + free (p->preferredRecordSyntax); + p->preferredRecordSyntax = NULL; + if (argv[2][0] && (p->preferredRecordSyntax = + malloc (sizeof(*p->preferredRecordSyntax)))) + *p->preferredRecordSyntax = IrTcl_getRecordSyntaxVal (argv[2]); + } + 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 }, { 1, "connect", do_connect }, { 0, "protocolVersion", do_protocolVersion }, @@ -957,6 +1423,7 @@ static IRMethod ir_method_tab[] = { { 1, "maximumRecordSize", do_maximumRecordSize }, { 1, "implementationName", do_implementationName }, { 1, "implementationId", do_implementationId }, +{ 1, "implementationVersion", do_implementationVersion }, { 0, "targetImplementationName", do_targetImplementationName }, { 0, "targetImplementationId", do_targetImplementationId }, { 0, "targetImplementationVersion", do_targetImplementationVersion }, @@ -967,16 +1434,19 @@ static IRMethod ir_method_tab[] = { { 0, "initResult", do_initResult }, { 0, "disconnect", do_disconnect }, { 0, "callback", do_callback }, +{ 0, "triggerResourceControl", do_triggerResourceControl }, { 0, NULL, NULL} }; -static IRMethod ir_set_c_method_tab[] = { +static IrTcl_Method ir_set_c_method_tab[] = { { 0, "databaseNames", do_databaseNames}, { 0, "replaceIndicator", do_replaceIndicator}, { 0, "queryType", do_queryType }, +{ 0, "preferredRecordSyntax", do_preferredRecordSyntax }, { 0, "smallSetUpperBound", do_smallSetUpperBound}, { 0, "largeSetLowerBound", do_largeSetLowerBound}, { 0, "mediumSetPresentNumber", do_mediumSetPresentNumber}, +{ 0, "referenceId", do_referenceId }, { 0, NULL, NULL} }; @@ -984,10 +1454,10 @@ static IRMethod ir_set_c_method_tab[] = { * ir_obj_method: IR Object methods */ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, -int argc, char **argv) + int argc, char **argv) { - IRMethods tab[3]; - IRObj *p = clientData; + IrTcl_Methods tab[3]; + IrTcl_Obj *p = clientData; if (argc < 2) return ir_method_r (clientData, interp, argc, argv, ir_method_tab); @@ -1006,39 +1476,37 @@ int argc, char **argv) */ static void ir_obj_delete (ClientData clientData) { - free ( (void*) clientData); -} + IrTcl_Obj *obj = clientData; + IrTcl_Methods tab[3]; -static int ir_reset_inher (Tcl_Interp *interp, IRSetCObj *o) -{ - o->smallSetUpperBound = 0; - o->largeSetLowerBound = 2; - o->mediumSetPresentNumber = 0; - o->replaceIndicator = 1; -#if 0 - obj->databaseNames = NULL; - obj->num_databaseNames = 0; -#else - o->num_databaseNames = 1; - if (!(o->databaseNames = - ir_malloc (interp, sizeof(*o->databaseNames)))) - return TCL_ERROR; - if (ir_strdup (interp, &o->databaseNames[0], "Default") - == TCL_ERROR) - return TCL_ERROR; -#endif - if (ir_strdup (interp, &o->queryType, "rpn") == TCL_ERROR) - return TCL_ERROR; - return TCL_OK; + --(obj->ref_count); + if (obj->ref_count > 0) + return; + assert (obj->ref_count == 0); + + tab[0].tab = ir_method_tab; + tab[0].obj = obj; + tab[1].tab = ir_set_c_method_tab; + tab[1].obj = &obj->set_inher; + tab[2].tab = NULL; + + ir_method (NULL, -1, NULL, tab); + 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); } /* * ir_obj_mk: IR Object creation */ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { - IRObj *obj; + IrTcl_Methods tab[3]; + IrTcl_Obj *obj; #if CCL2RPN FILE *inf; #endif @@ -1050,39 +1518,8 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, } if (!(obj = ir_malloc (interp, sizeof(*obj)))) return TCL_ERROR; - if (ir_strdup (interp, &obj->cs_type, "tcpip") == TCL_ERROR) - return TCL_ERROR; - if (ir_strdup (interp, &obj->protocol_type, "Z3950") == TCL_ERROR) - return TCL_ERROR; - obj->cs_link = NULL; - obj->bib1.proto = PROTO_Z3950; - obj->bib1.class = CLASS_ATTSET; - obj->bib1.value = VAL_BIB1; - - obj->maximumRecordSize = 32768; - obj->preferredMessageSize = 4096; - obj->connectFlag = 0; - - obj->idAuthenticationOpen = NULL; - obj->idAuthenticationGroupId = NULL; - obj->idAuthenticationUserId = NULL; - obj->idAuthenticationPassword = NULL; - - if (ir_strdup (interp, &obj->implementationName, "TCL/TK on YAZ") - == TCL_ERROR) - return TCL_ERROR; - - if (ir_strdup (interp, &obj->implementationId, "TCL/TK/YAZ") - == TCL_ERROR) - return TCL_ERROR; - - obj->targetImplementationName = NULL; - obj->targetImplementationId = NULL; - obj->targetImplementationVersion = NULL; - obj->userInformationField = NULL; - - obj->hostname = NULL; + obj->ref_count = 1; #if CCL2RPN obj->bibset = ccl_qual_mk (); if ((inf = fopen ("default.bib", "r"))) @@ -1091,15 +1528,6 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, fclose (inf); } #endif - ODR_MASK_ZERO (&obj->protocolVersion); - ODR_MASK_SET (&obj->protocolVersion, 0); - ODR_MASK_SET (&obj->protocolVersion, 1); - - ODR_MASK_ZERO (&obj->options); - ODR_MASK_SET (&obj->options, 0); - ODR_MASK_SET (&obj->options, 1); - ODR_MASK_SET (&obj->options, 7); - ODR_MASK_SET (&obj->options, 14); obj->odr_in = odr_createmem (ODR_DECODE); obj->odr_out = odr_createmem (ODR_ENCODE); @@ -1113,10 +1541,13 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->len_in = 0; obj->buf_in = NULL; - obj->callback = NULL; - obj->failback = NULL; + tab[0].tab = ir_method_tab; + tab[0].obj = obj; + tab[1].tab = ir_set_c_method_tab; + tab[1].obj = &obj->set_inher; + tab[2].tab = NULL; - if (ir_reset_inher (interp, &obj->set_inher) == TCL_ERROR) + if (ir_method (interp, 0, NULL, tab) == TCL_ERROR) return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_obj_method, (ClientData) obj, ir_obj_delete); @@ -1127,24 +1558,28 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, /* * do_search: Do search request */ -static int do_search (void *o, Tcl_Interp *interp, - int argc, char **argv) +static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) { - Z_SearchRequest req; + Z_SearchRequest *req; Z_Query query; - Z_APDU apdu, *apdup = &apdu; + Z_APDU *apdu; Odr_oct ccl_query; - IRSetObj *obj = o; - IRObj *p = obj->parent; + IrTcl_SetObj *obj = o; + IrTcl_Obj *p; int r; + oident bib1; + + if (argc <= 0) + return TCL_OK; + p = obj->parent; p->set_child = o; if (argc != 3) { interp->result = "wrong # args"; return TCL_ERROR; } - if (!p->set_inher.num_databaseNames) + if (!obj->set_inher.num_databaseNames) { interp->result = "no databaseNames"; return TCL_ERROR; @@ -1155,26 +1590,44 @@ static int do_search (void *o, Tcl_Interp *interp, return TCL_ERROR; } odr_reset (p->odr_out); - apdu.which = Z_APDU_searchRequest; - apdu.u.searchRequest = &req; - - req.referenceId = 0; - req.smallSetUpperBound = &p->set_inher.smallSetUpperBound; - req.largeSetLowerBound = &p->set_inher.largeSetLowerBound; - req.mediumSetPresentNumber = &p->set_inher.mediumSetPresentNumber; - req.replaceIndicator = &p->set_inher.replaceIndicator; - req.resultSetName = obj->setName ? obj->setName : "Default"; - logf (LOG_DEBUG, "Search, resultSetName %s", req.resultSetName); - req.num_databaseNames = p->set_inher.num_databaseNames; - req.databaseNames = p->set_inher.databaseNames; - for (r=0; r < p->set_inher.num_databaseNames; r++) - logf (LOG_DEBUG, " Database %s", p->set_inher.databaseNames[r]); - req.smallSetElementSetNames = 0; - req.mediumSetElementSetNames = 0; - req.preferredRecordSyntax = 0; - req.query = &query; - - if (!strcmp (p->set_inher.queryType, "rpn")) + apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest); + req = apdu->u.searchRequest; + + bib1.proto = p->protocol_type; + bib1.class = CLASS_ATTSET; + bib1.value = VAL_BIB1; + + set_referenceId (p->odr_out, &req->referenceId, + obj->set_inher.referenceId); + + req->smallSetUpperBound = &obj->set_inher.smallSetUpperBound; + req->largeSetLowerBound = &obj->set_inher.largeSetLowerBound; + req->mediumSetPresentNumber = &obj->set_inher.mediumSetPresentNumber; + req->replaceIndicator = &obj->set_inher.replaceIndicator; + req->resultSetName = obj->setName ? obj->setName : "Default"; + logf (LOG_DEBUG, "Search, resultSetName %s", req->resultSetName); + req->num_databaseNames = obj->set_inher.num_databaseNames; + 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; + + ident.proto = p->protocol_type; + ident.class = CLASS_RECSYN; + ident.value = *obj->set_inher.preferredRecordSyntax; + logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value); + req->preferredRecordSyntax = odr_oiddup (p->odr_out, + oid_getoidbyent (&ident)); + } + else + req->preferredRecordSyntax = 0; + req->query = &query; + + if (!strcmp (obj->set_inher.queryType, "rpn")) { Z_RPNQuery *RPNquery; @@ -1184,13 +1637,13 @@ static int do_search (void *o, Tcl_Interp *interp, Tcl_AppendResult (interp, "Syntax error in query", NULL); return TCL_ERROR; } - RPNquery->attributeSetId = oid_getoidbyent (&p->bib1); + RPNquery->attributeSetId = oid_getoidbyent (&bib1); query.which = Z_Query_type_1; query.u.type_1 = RPNquery; logf (LOG_DEBUG, "RPN"); } #if CCL2RPN - else if (!strcmp (p->set_inher.queryType, "cclrpn")) + else if (!strcmp (obj->set_inher.queryType, "cclrpn")) { int error; int pos; @@ -1200,19 +1653,20 @@ static int do_search (void *o, Tcl_Interp *interp, rpn = ccl_find_str(p->bibset, argv[2], &error, &pos); if (error) { - Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg(error),NULL); + Tcl_AppendResult (interp, "CCL error: ", + ccl_err_msg(error), NULL); return TCL_ERROR; } ccl_pr_tree (rpn, stderr); fprintf (stderr, "\n"); assert((RPNquery = ccl_rpn_query(rpn))); - RPNquery->attributeSetId = oid_getoidbyent (&p->bib1); + RPNquery->attributeSetId = oid_getoidbyent (&bib1); query.which = Z_Query_type_1; query.u.type_1 = RPNquery; logf (LOG_DEBUG, "CCLRPN"); } #endif - else if (!strcmp (p->set_inher.queryType, "ccl")) + else if (!strcmp (obj->set_inher.queryType, "ccl")) { query.which = Z_Query_type_2; query.u.type_2 = &ccl_query; @@ -1225,7 +1679,7 @@ static int do_search (void *o, Tcl_Interp *interp, interp->result = "unknown query method"; return TCL_ERROR; } - if (!z_APDU (p->odr_out, &apdup, 0)) + if (!z_APDU (p->odr_out, &apdu, 0)) { interp->result = odr_errlist [odr_geterror (p->odr_out)]; odr_reset (p->odr_out); @@ -1255,8 +1709,10 @@ static int do_search (void *o, Tcl_Interp *interp, static int do_resultCount (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; + if (argc <= 0) + return TCL_OK; return get_set_int (&obj->resultCount, interp, argc, argv); } @@ -1266,8 +1722,10 @@ static int do_resultCount (void *o, Tcl_Interp *interp, static int do_searchStatus (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; + if (argc <= 0) + return TCL_OK; return get_set_int (&obj->searchStatus, interp, argc, argv); } @@ -1277,8 +1735,10 @@ static int do_searchStatus (void *o, Tcl_Interp *interp, static int do_presentStatus (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; + if (argc <= 0) + return TCL_OK; return get_set_int (&obj->presentStatus, interp, argc, argv); } @@ -1289,8 +1749,13 @@ static int do_presentStatus (void *o, Tcl_Interp *interp, static int do_nextResultSetPosition (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; + if (argc <= 0) + { + obj->nextResultSetPosition = 0; + return TCL_OK; + } return get_set_int (&obj->nextResultSetPosition, interp, argc, argv); } @@ -1300,8 +1765,12 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp, static int do_setName (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; + if (argc == 0) + return ir_strdup (interp, &obj->setName, "Default"); + else if (argc == -1) + return ir_strdel (interp, &obj->setName); if (argc == 3) { free (obj->setName); @@ -1317,22 +1786,37 @@ static int do_setName (void *o, Tcl_Interp *interp, * do_numberOfRecordsReturned: Get number of records returned */ static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; + if (argc <= 0) + { + obj->numberOfRecordsReturned = 0; + return TCL_OK; + } return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv); } /* - * do_recordType: Return record type (if any) at position. + * do_type: Return type (if any) at position. */ -static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) +static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; int offset; - IRRecordList *rl; + IrTcl_RecordList *rl; + if (argc == 0) + { + obj->record_list = NULL; + return TCL_OK; + } + else if (argc == -1) + { + delete_IR_records (obj); + return TCL_OK; + } if (argc < 3) { sprintf (interp->result, "wrong # args"); @@ -1346,25 +1830,91 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) switch (rl->which) { case Z_NamePlusRecord_databaseRecord: - interp->result = "databaseRecord"; + interp->result = "DB"; break; case Z_NamePlusRecord_surrogateDiagnostic: - interp->result = "surrogateDiagnostic"; + interp->result = "SD"; break; } return TCL_OK; } + /* - * do_recordDiag: Return diagnostic record info + * do_recordType: Return record type (if any) at position. */ -static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv) +static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; int offset; - IRRecordList *rl; + IrTcl_RecordList *rl; + + if (argc == 0) + { + return TCL_OK; + } + else if (argc == -1) + { + 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) + return TCL_OK; + if (rl->which != Z_NamePlusRecord_databaseRecord) + { + Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL); + return TCL_ERROR; + } + Tcl_AppendElement (interp, (char*) + IrTcl_getRecordSyntaxStr (rl->u.dbrec.type)); + return TCL_OK; +} + +/* + * ir_diagResult + */ +static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num) +{ char buf[20]; + int i; + const char *cp; + + for (i = 0; iresult, "wrong # args"); @@ -1383,11 +1933,8 @@ static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv) Tcl_AppendResult (interp, "No Diagnostic record at #", argv[2], NULL); return TCL_ERROR; } - sprintf (buf, "%d", rl->u.diag.condition); - Tcl_AppendResult (interp, buf, " {", - (rl->u.diag.addinfo ? rl->u.diag.addinfo : ""), - "}", NULL); - return TCL_OK; + return ir_diagResult (interp, rl->u.surrogateDiagnostics.list, + rl->u.surrogateDiagnostics.num); } /* @@ -1395,11 +1942,13 @@ static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv) */ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; int offset; - IRRecordList *rl; + IrTcl_RecordList *rl; - if (argc < 4) + if (argc <= 0) + return TCL_OK; + if (argc < 7) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1414,12 +1963,47 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv) } if (rl->which != Z_NamePlusRecord_databaseRecord) { - Tcl_AppendResult (interp, "No MARC record at #", argv[2], NULL); + Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL); return TCL_ERROR; } return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv); } +/* + * do_getSutrs: Get SUTRS Record + */ +static int do_getSutrs (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_SUTRS) + return TCL_OK; + Tcl_AppendElement (interp, rl->u.dbrec.buf); + return TCL_OK; +} + /* * do_responseStatus: Return response status (present or search) @@ -1427,8 +2011,21 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv) static int do_responseStatus (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; + IrTcl_SetObj *obj = o; + if (argc == 0) + { + obj->recordFlag = 0; + obj->nonSurrogateDiagnosticNum = 0; + obj->nonSurrogateDiagnosticList = NULL; + return TCL_OK; + } + else if (argc == -1) + { + ir_deleteDiags (&obj->nonSurrogateDiagnosticList, + &obj->nonSurrogateDiagnosticNum); + return TCL_OK; + } if (!obj->recordFlag) { Tcl_AppendElement (interp, "OK"); @@ -1440,8 +2037,9 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, Tcl_AppendElement (interp, "DBOSD"); break; case Z_Records_NSD: - return mk_nonSurrogateDiagnostics (interp, obj->condition, - obj->addinfo); + Tcl_AppendElement (interp, "NSD"); + return ir_diagResult (interp, obj->nonSurrogateDiagnosticList, + obj->nonSurrogateDiagnosticNum); } return TCL_OK; } @@ -1453,14 +2051,16 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *obj = o; - IRObj *p = obj->parent; - Z_APDU apdu, *apdup = &apdu; - Z_PresentRequest req; + IrTcl_SetObj *obj = o; + IrTcl_Obj *p; + Z_APDU *apdu; + Z_PresentRequest *req; int start; int number; int r; + if (argc <= 0) + return TCL_OK; if (argc >= 3) { if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR) @@ -1480,23 +2080,38 @@ static int do_present (void *o, Tcl_Interp *interp, interp->result = "not connected"; return TCL_ERROR; } + p = obj->parent; + p->set_child = obj; + odr_reset (p->odr_out); obj->start = start; obj->number = number; - apdu.which = Z_APDU_presentRequest; - apdu.u.presentRequest = &req; - req.referenceId = 0; - /* sprintf(setstring, "%d", setnumber); */ + apdu = zget_APDU (p->odr_out, Z_APDU_presentRequest); + req = apdu->u.presentRequest; - req.resultSetId = obj->setName ? obj->setName : "Default"; + set_referenceId (p->odr_out, &req->referenceId, + obj->set_inher.referenceId); + + req->resultSetId = obj->setName ? obj->setName : "Default"; - req.resultSetStartPoint = &start; - req.numberOfRecordsRequested = &number; - req.elementSetNames = 0; - req.preferredRecordSyntax = 0; + req->resultSetStartPoint = &start; + req->numberOfRecordsRequested = &number; + if (obj->set_inher.preferredRecordSyntax) + { + struct oident ident; - if (!z_APDU (p->odr_out, &apdup, 0)) + ident.proto = p->protocol_type; + ident.class = CLASS_RECSYN; + ident.value = *obj->set_inher.preferredRecordSyntax; + logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value); + req->preferredRecordSyntax = odr_oiddup (p->odr_out, + oid_getoidbyent (&ident)); + } + else + req->preferredRecordSyntax = 0; + + if (!z_APDU (p->odr_out, &apdu, 0)) { interp->result = odr_errlist [odr_geterror (p->odr_out)]; odr_reset (p->odr_out); @@ -1529,12 +2144,14 @@ static int do_present (void *o, Tcl_Interp *interp, static int do_loadFile (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetObj *setobj = o; + IrTcl_SetObj *setobj = o; FILE *inf; size_t size; int no = 1; char *buf; + if (argc <= 0) + return TCL_OK; if (argc < 3) { interp->result = "wrong # args"; @@ -1548,7 +2165,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, } while ((buf = ir_tcl_fread_marc (inf, &size))) { - IRRecordList *rl; + IrTcl_RecordList *rl; rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord); rl->u.dbrec.buf = buf; @@ -1560,13 +2177,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, return TCL_OK; } -/* - * ir_set_obj_method: IR Set Object methods - */ -static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) -{ - static IRMethod tab[] = { +static IrTcl_Method ir_set_method_tab[] = { { 0, "search", do_search }, { 0, "searchStatus", do_searchStatus }, { 0, "presentStatus", do_presentStatus }, @@ -1575,22 +2186,31 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, { 0, "resultCount", do_resultCount }, { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned }, { 0, "present", do_present }, - { 0, "recordType", do_recordType }, + { 0, "type", do_type }, { 0, "getMarc", do_getMarc }, - { 0, "Diag", do_recordDiag }, + { 0, "getSutrs", do_getSutrs }, + { 0, "recordType", do_recordType }, + { 0, "diag", do_diag }, { 0, "responseStatus", do_responseStatus }, { 0, "loadFile", do_loadFile }, { 0, NULL, NULL} - }; - IRMethods tabs[3]; - IRSetObj *p = clientData; +}; + +/* + * ir_set_obj_method: IR Set Object methods + */ +static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Methods tabs[3]; + IrTcl_SetObj *p = clientData; if (argc < 2) { interp->result = "wrong # args"; return TCL_ERROR; } - tabs[0].tab = tab; + tabs[0].tab = ir_set_method_tab; tabs[0].obj = p; tabs[1].tab = ir_set_c_method_tab; tabs[1].obj = &p->set_inher; @@ -1604,37 +2224,49 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, */ static void ir_set_obj_delete (ClientData clientData) { - free ( (void*) clientData); + IrTcl_Methods tabs[3]; + IrTcl_SetObj *p = clientData; + + tabs[0].tab = ir_set_method_tab; + tabs[0].obj = p; + tabs[1].tab = ir_set_c_method_tab; + tabs[1].obj = &p->set_inher; + tabs[2].tab = NULL; + + ir_method (NULL, -1, NULL, tabs); + + free (p); } /* * ir_set_obj_mk: IR Set Object creation */ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { - IRSetObj *obj; + IrTcl_Methods tabs[3]; + IrTcl_SetObj *obj; if (argc < 2 || argc > 3) { interp->result = "wrong # args"; return TCL_ERROR; } + if (!(obj = ir_malloc (interp, sizeof(*obj)))) + return TCL_ERROR; else if (argc == 3) { Tcl_CmdInfo parent_info; int i; - IRSetCObj *dst; - IRSetCObj *src; + IrTcl_SetCObj *dst; + IrTcl_SetCObj *src; if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) { interp->result = "No parent"; return TCL_ERROR; } - if (!(obj = ir_malloc (interp, sizeof(*obj)))) - return TCL_ERROR; - obj->parent = (IRObj *) parent_info.clientData; + obj->parent = (IrTcl_Obj *) parent_info.clientData; dst = &obj->set_inher; src = &obj->parent->set_inher; @@ -1653,17 +2285,32 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, if (ir_strdup (interp, &dst->queryType, src->queryType) == TCL_ERROR) return TCL_ERROR; - + + if (ir_strdup (interp, &dst->referenceId, src->referenceId) + == TCL_ERROR) + return TCL_ERROR; + + if (src->preferredRecordSyntax && + (dst->preferredRecordSyntax + = malloc (sizeof(*dst->preferredRecordSyntax)))) + *dst->preferredRecordSyntax = *src->preferredRecordSyntax; + else + dst->preferredRecordSyntax = NULL; + dst->replaceIndicator = src->replaceIndicator; dst->smallSetUpperBound = src->smallSetUpperBound; dst->largeSetLowerBound = src->largeSetLowerBound; dst->mediumSetPresentNumber = src->mediumSetPresentNumber; } else obj->parent = NULL; - if (ir_strdup (interp, &obj->setName, argv[2]) == TCL_ERROR) + + tabs[0].tab = ir_set_method_tab; + tabs[0].obj = obj; + tabs[1].tab = NULL; + + if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) return TCL_ERROR; - obj->record_list = NULL; - obj->addinfo = NULL; + Tcl_CreateCommand (interp, argv[1], ir_set_obj_method, (ClientData) obj, ir_set_obj_delete); return TCL_OK; @@ -1676,16 +2323,19 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, */ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) { - Z_ScanRequest req; - Z_APDU apdu, *apdup = &apdu; - IRScanObj *obj = o; - IRObj *p = obj->parent; + Z_ScanRequest *req; + Z_APDU *apdu; + IrTcl_ScanObj *obj = o; + IrTcl_Obj *p = obj->parent; int r; + oident bib1; #if CCL2RPN struct ccl_rpn_node *rpn; int pos; #endif + if (argc <= 0) + return TCL_OK; p->scan_child = o; if (argc != 3) { @@ -1703,15 +2353,21 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_ERROR; } odr_reset (p->odr_out); - apdu.which = Z_APDU_scanRequest; - apdu.u.scanRequest = &req; - req.referenceId = NULL; - req.num_databaseNames = p->set_inher.num_databaseNames; - req.databaseNames = p->set_inher.databaseNames; - req.attributeSet = oid_getoidbyent (&p->bib1); + + bib1.proto = p->protocol_type; + bib1.class = CLASS_ATTSET; + bib1.value = VAL_BIB1; + + apdu = zget_APDU (p->odr_out, Z_APDU_scanRequest); + req = apdu->u.scanRequest; + + set_referenceId (p->odr_out, &req->referenceId, p->set_inher.referenceId); + req->num_databaseNames = p->set_inher.num_databaseNames; + req->databaseNames = p->set_inher.databaseNames; + req->attributeSet = oid_getoidbyent (&bib1); #if !CCL2RPN - if (!(req.termListAndStartPoint = p_query_scan (p->odr_out, argv[2]))) + if (!(req->termListAndStartPoint = p_query_scan (p->odr_out, argv[2]))) { Tcl_AppendResult (interp, "Syntax error in query", NULL); return TCL_ERROR; @@ -1725,19 +2381,19 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) } ccl_pr_tree (rpn, stderr); fprintf (stderr, "\n"); - if (!(req.termListAndStartPoint = ccl_scan_query (rpn))) + if (!(req->termListAndStartPoint = ccl_scan_query (rpn))) return TCL_ERROR; #endif - req.stepSize = &obj->stepSize; - req.numberOfTermsRequested = &obj->numberOfTermsRequested; - req.preferredPositionInResponse = &obj->preferredPositionInResponse; - logf (LOG_DEBUG, "stepSize=%d", *req.stepSize); + req->stepSize = &obj->stepSize; + req->numberOfTermsRequested = &obj->numberOfTermsRequested; + req->preferredPositionInResponse = &obj->preferredPositionInResponse; + logf (LOG_DEBUG, "stepSize=%d", *req->stepSize); logf (LOG_DEBUG, "numberOfTermsRequested=%d", - *req.numberOfTermsRequested); + *req->numberOfTermsRequested); logf (LOG_DEBUG, "preferredPositionInResponse=%d", - *req.preferredPositionInResponse); + *req->preferredPositionInResponse); - if (!z_APDU (p->odr_out, &apdup, 0)) + if (!z_APDU (p->odr_out, &apdu, 0)) { interp->result = odr_errlist [odr_geterror (p->odr_out)]; odr_reset (p->odr_out); @@ -1767,7 +2423,12 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) static int do_stepSize (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRScanObj *p = obj; + IrTcl_ScanObj *p = obj; + if (argc <= 0) + { + p->stepSize = 0; + return TCL_OK; + } return get_set_int (&p->stepSize, interp, argc, argv); } @@ -1777,7 +2438,13 @@ static int do_stepSize (void *obj, Tcl_Interp *interp, static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRScanObj *p = obj; + IrTcl_ScanObj *p = obj; + + if (argc <= 0) + { + p->numberOfTermsRequested = 20; + return TCL_OK; + } return get_set_int (&p->numberOfTermsRequested, interp, argc, argv); } @@ -1788,7 +2455,13 @@ static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp, static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRScanObj *p = obj; + IrTcl_ScanObj *p = obj; + + if (argc <= 0) + { + p->preferredPositionInResponse = 1; + return TCL_OK; + } return get_set_int (&p->preferredPositionInResponse, interp, argc, argv); } @@ -1798,7 +2471,10 @@ static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp, static int do_scanStatus (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRScanObj *p = obj; + IrTcl_ScanObj *p = obj; + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->scanStatus, interp, argc, argv); } @@ -1808,7 +2484,10 @@ static int do_scanStatus (void *obj, Tcl_Interp *interp, static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRScanObj *p = obj; + IrTcl_ScanObj *p = obj; + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv); } @@ -1818,7 +2497,10 @@ static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp, static int do_positionOfTerm (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRScanObj *p = obj; + IrTcl_ScanObj *p = obj; + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->positionOfTerm, interp, argc, argv); } @@ -1827,10 +2509,28 @@ static int do_positionOfTerm (void *obj, Tcl_Interp *interp, */ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv) { - IRScanObj *p = obj; + IrTcl_ScanObj *p = obj; int i; char numstr[20]; + if (argc == 0) + { + p->entries_flag = 0; + p->entries = NULL; + p->nonSurrogateDiagnosticNum = 0; + p->nonSurrogateDiagnosticList = 0; + return TCL_OK; + } + else if (argc == -1) + { + p->entries_flag = 0; + /* release entries */ + p->entries = NULL; + + ir_deleteDiags (&p->nonSurrogateDiagnosticList, + &p->nonSurrogateDiagnosticNum); + return TCL_OK; + } if (argc != 3) { interp->result = "wrong # args"; @@ -1853,21 +2553,15 @@ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv) Tcl_AppendElement (interp, numstr); break; case Z_Entry_surrogateDiagnostic: - return - mk_nonSurrogateDiagnostics (interp, p->entries[i].u.diag.condition, - p->entries[i].u.diag.addinfo); + Tcl_AppendElement (interp, "SD"); + return ir_diagResult (interp, p->entries[i].u.diag.list, + p->entries[i].u.diag.num); break; } return TCL_OK; } -/* - * ir_scan_obj_method: IR Scan Object methods - */ -static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) -{ - static IRMethod tab[] = { +static IrTcl_Method ir_scan_method_tab[] = { { 0, "scan", do_scan }, { 0, "stepSize", do_stepSize }, { 0, "numberOfTermsRequested", do_numberOfTermsRequested }, @@ -1877,16 +2571,22 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, { 0, "positionOfTerm", do_positionOfTerm }, { 0, "scanLine", do_scanLine }, { 0, NULL, NULL} - }; - IRMethods tabs[3]; +}; + +/* + * ir_scan_obj_method: IR Scan Object methods + */ +static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Methods tabs[2]; if (argc < 2) { interp->result = "wrong # args"; return TCL_ERROR; } - - tabs[0].tab = tab; + tabs[0].tab = ir_scan_method_tab; tabs[0].obj = clientData; tabs[1].tab = NULL; @@ -1898,7 +2598,15 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, */ static void ir_scan_obj_delete (ClientData clientData) { - free ( (void*) clientData); + IrTcl_Methods tabs[2]; + IrTcl_ScanObj *obj = clientData; + + tabs[0].tab = ir_scan_method_tab; + tabs[0].obj = obj; + tabs[1].tab = NULL; + + ir_method (NULL, -1, NULL, tabs); + free (obj); } /* @@ -1908,26 +2616,30 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { Tcl_CmdInfo parent_info; - IRScanObj *obj; + IrTcl_ScanObj *obj; + IrTcl_Methods tabs[2]; - if (argc != 2) + if (argc != 3) { interp->result = "wrong # args"; return TCL_ERROR; } - if (get_parent_info (interp, argv[1], &parent_info, NULL) == TCL_ERROR) - return TCL_ERROR; + if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) + { + interp->result = "No parent"; + return TCL_ERROR; + } if (!(obj = ir_malloc (interp, sizeof(*obj)))) return TCL_ERROR; - obj->stepSize = 0; - obj->numberOfTermsRequested = 20; - obj->preferredPositionInResponse = 1; + obj->parent = (IrTcl_Obj *) parent_info.clientData; - obj->entries = NULL; - obj->nonSurrogateDiagnostics = NULL; + tabs[0].tab = ir_scan_method_tab; + tabs[0].obj = obj; + tabs[1].tab = NULL; - obj->parent = (IRObj *) parent_info.clientData; + if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) + return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method, (ClientData) obj, ir_scan_obj_delete); return TCL_OK; @@ -1937,7 +2649,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, static void ir_initResponse (void *obj, Z_InitResponse *initrs) { - IRObj *p = obj; + IrTcl_Obj *p = obj; p->initResult = *initrs->result ? 1 : 0; if (!*initrs->result) @@ -1945,6 +2657,8 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) else logf (LOG_DEBUG, "Connection accepted by target"); + get_referenceId (&p->set_inher.referenceId, initrs->referenceId); + free (p->targetImplementationId); ir_strdup (p->interp, &p->targetImplementationId, initrs->implementationId); @@ -1981,34 +2695,62 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) } } +static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num) +{ + int i; + for (i = 0; i<*dst_num; i++) + free (dst_list[i]->addinfo); + free (*dst_list); + *dst_list = NULL; + *dst_num = 0; +} + +static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, + Z_DiagRec **list, int num) +{ + int i; + char *addinfo; + + *dst_num = num; + *dst_list = malloc (sizeof(**dst_list) * num); + if (!*dst_list) + { + *dst_num = 0; + return; + } + for (i = 0; iwhich) + { + case Z_DiagRec_defaultFormat: + (*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))) + strcpy ((*dst_list)[i].addinfo, addinfo); + break; + default: + (*dst_list)[i].addinfo = NULL; + (*dst_list)[i].condition = 0; + } + } +} + static void ir_handleRecords (void *o, Z_Records *zrs) { - IRObj *p = o; - IRSetObj *setobj = p->set_child; + IrTcl_Obj *p = o; + IrTcl_SetObj *setobj = p->set_child; + + int offset; + IrTcl_RecordList *rl; setobj->which = zrs->which; setobj->recordFlag = 1; - if (zrs->which == Z_Records_NSD) - { - const char *addinfo; - - setobj->numberOfRecordsReturned = 0; - setobj->condition = *zrs->u.nonSurrogateDiagnostic->condition; - free (setobj->addinfo); - setobj->addinfo = NULL; - addinfo = zrs->u.nonSurrogateDiagnostic->addinfo; - if (addinfo && (setobj->addinfo = malloc (strlen(addinfo) + 1))) - strcpy (setobj->addinfo, addinfo); - logf (LOG_DEBUG, "Diagnostic response. %s (%d): %s", - diagbib1_str (setobj->condition), - setobj->condition, - setobj->addinfo ? setobj->addinfo : ""); - } - else + + ir_deleteDiags (&setobj->nonSurrogateDiagnosticList, + &setobj->nonSurrogateDiagnosticNum); + if (zrs->which == Z_Records_DBOSD) { - int offset; - IRRecordList *rl; - setobj->numberOfRecordsReturned = zrs->u.databaseOrSurDiagnostics->num_records; logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned); @@ -2019,73 +2761,125 @@ static void ir_handleRecords (void *o, Z_Records *zrs) records[offset]->which); if (rl->which == Z_NamePlusRecord_surrogateDiagnostic) { - Z_DiagRec *diagrec; - - diagrec = zrs->u.databaseOrSurDiagnostics-> - records[offset]->u.surrogateDiagnostic; - - rl->u.diag.condition = *diagrec->condition; - if (diagrec->addinfo && (rl->u.diag.addinfo = - malloc (strlen (diagrec->addinfo)+1))) - strcpy (rl->u.diag.addinfo, diagrec->addinfo); - } + ir_handleDiags (&rl->u.surrogateDiagnostics.list, + &rl->u.surrogateDiagnostics.num, + &zrs->u.databaseOrSurDiagnostics-> + records[offset]->u.surrogateDiagnostic, + 1); + } else { Z_DatabaseRecord *zr; Odr_external *oe; + struct oident *ident; zr = zrs->u.databaseOrSurDiagnostics->records[offset] ->u.databaseRecord; oe = (Odr_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 (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0) { - const char *buf = (char*) zr->u.octet_aligned->buf; + char *buf = (char*) zr->u.octet_aligned->buf; if ((rl->u.dbrec.buf = 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) + { + 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 = 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; + } + } else rl->u.dbrec.buf = NULL; } } } + else if (zrs->which == Z_Records_multipleNSD) + { + logf (LOG_DEBUG, "multipleNonSurrogateDiagnostic %d", + zrs->u.multipleNonSurDiagnostics->num_diagRecs); + setobj->numberOfRecordsReturned = 0; + ir_handleDiags (&setobj->nonSurrogateDiagnosticList, + &setobj->nonSurrogateDiagnosticNum, + zrs->u.multipleNonSurDiagnostics->diagRecs, + zrs->u.multipleNonSurDiagnostics->num_diagRecs); + } + else + { + logf (LOG_DEBUG, "NonSurrogateDiagnostic"); + setobj->numberOfRecordsReturned = 0; + ir_handleDiags (&setobj->nonSurrogateDiagnosticList, + &setobj->nonSurrogateDiagnosticNum, + &zrs->u.nonSurrogateDiagnostic, + 1); + } } static void ir_searchResponse (void *o, Z_SearchResponse *searchrs) { - IRObj *p = o; - IRSetObj *setobj = p->set_child; + IrTcl_Obj *p = o; + IrTcl_SetObj *setobj = p->set_child; Z_Records *zrs = searchrs->records; - if (setobj) + logf (LOG_DEBUG, "Received search response"); + if (!setobj) { - setobj->searchStatus = searchrs->searchStatus ? 1 : 0; - setobj->resultCount = *searchrs->resultCount; - if (searchrs->presentStatus) - setobj->presentStatus = *searchrs->presentStatus; - if (searchrs->nextResultSetPosition) - setobj->nextResultSetPosition = *searchrs->nextResultSetPosition; - - logf (LOG_DEBUG, "Search response %d, %d hits", - setobj->searchStatus, setobj->resultCount); - if (zrs) - ir_handleRecords (o, zrs); - else - setobj->recordFlag = 0; - } - else logf (LOG_DEBUG, "Search response, no object!"); + return; + } + setobj->searchStatus = searchrs->searchStatus ? 1 : 0; + get_referenceId (&setobj->set_inher.referenceId, searchrs->referenceId); + setobj->resultCount = *searchrs->resultCount; + if (searchrs->presentStatus) + setobj->presentStatus = *searchrs->presentStatus; + if (searchrs->nextResultSetPosition) + setobj->nextResultSetPosition = *searchrs->nextResultSetPosition; + + logf (LOG_DEBUG, "Search response %d, %d hits", + setobj->searchStatus, setobj->resultCount); + if (zrs) + ir_handleRecords (o, zrs); + else + setobj->recordFlag = 0; } static void ir_presentResponse (void *o, Z_PresentResponse *presrs) { - IRObj *p = o; - IRSetObj *setobj = p->set_child; + IrTcl_Obj *p = o; + IrTcl_SetObj *setobj = p->set_child; Z_Records *zrs = presrs->records; - logf (LOG_DEBUG, "Received presentResponse"); + logf (LOG_DEBUG, "Received present response"); + if (!setobj) + { + logf (LOG_DEBUG, "Present response, no object!"); + return; + } setobj->presentStatus = *presrs->presentStatus; + get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId); setobj->nextResultSetPosition = *presrs->nextResultSetPosition; if (zrs) ir_handleRecords (o, zrs); @@ -2098,11 +2892,12 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs) static void ir_scanResponse (void *o, Z_ScanResponse *scanrs) { - IRObj *p = o; - IRScanObj *scanobj = p->scan_child; + IrTcl_Obj *p = o; + IrTcl_ScanObj *scanobj = p->scan_child; logf (LOG_DEBUG, "Received scanResponse"); + get_referenceId (&p->set_inher.referenceId, scanrs->referenceId); scanobj->scanStatus = *scanrs->scanStatus; logf (LOG_DEBUG, "scanStatus=%d", scanobj->scanStatus); @@ -2122,9 +2917,9 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs) free (scanobj->entries); scanobj->entries = NULL; - free (scanobj->nonSurrogateDiagnostics); - scanobj->nonSurrogateDiagnostics = NULL; + ir_deleteDiags (&scanobj->nonSurrogateDiagnosticList, + &scanobj->nonSurrogateDiagnosticNum); if (scanrs->entries) { int i; @@ -2163,22 +2958,21 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs) scanobj->entries[i].u.term.globalOccurrences = 0; break; case Z_Entry_surrogateDiagnostic: - scanobj->entries[i].u.diag.addinfo = - malloc (1+strlen(ze->u.surrogateDiagnostic-> - addinfo)); - strcpy (scanobj->entries[i].u.diag.addinfo, - ze->u.surrogateDiagnostic->addinfo); - scanobj->entries[i].u.diag.condition = - *ze->u.surrogateDiagnostic->condition; + ir_handleDiags (&scanobj->entries[i].u.diag.list, + &scanobj->entries[i].u.diag.num, + &ze->u.surrogateDiagnostic, + 1); break; } } break; case Z_ListEntries_nonSurrogateDiagnostics: - scanobj->num_diagRecs = scanrs->entries-> - u.nonSurrogateDiagnostics->num_diagRecs; - scanobj->nonSurrogateDiagnostics = malloc (scanobj->num_diagRecs * - sizeof(*scanobj->nonSurrogateDiagnostics)); + ir_handleDiags (&scanobj->nonSurrogateDiagnosticList, + &scanobj->nonSurrogateDiagnosticNum, + scanrs->entries->u.nonSurrogateDiagnostics-> + diagRecs, + scanrs->entries->u.nonSurrogateDiagnostics-> + num_diagRecs); break; } } @@ -2191,7 +2985,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs) */ void ir_select_read (ClientData clientData) { - IRObj *p = clientData; + IrTcl_Obj *p = clientData; Z_APDU *apdu; int r; @@ -2199,30 +2993,45 @@ void ir_select_read (ClientData clientData) { r = cs_rcvconnect (p->cs_link); if (r == 1) + { + logf (LOG_WARN, "cs_rcvconnect returned 1"); return; + } p->connectFlag = 0; ir_select_remove_write (cs_fileno (p->cs_link), p); if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); if (p->failback) - Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + { + p->failInfo = IR_TCL_FAIL_CONNECT; + IrTcl_eval (p->interp, p->failback); + } + do_disconnect (p, NULL, 2, NULL); return; } if (p->callback) - Tcl_Eval (p->interp, p->callback); + IrTcl_eval (p->interp, p->callback); return; } do { + /* signal one more use of ir object - callbacks must not + release the ir memory (p pointer) */ + ++(p->ref_count); 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); if (p->failback) - Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + { + 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 */ + ir_obj_delete (p); return; } if (r == 1) @@ -2233,8 +3042,14 @@ void ir_select_read (ClientData clientData) { logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]); if (p->failback) - Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + { + 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) @@ -2254,12 +3069,21 @@ void ir_select_read (ClientData clientData) default: logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); if (p->failback) - Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + { + p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; + IrTcl_eval (p->interp, p->failback); + } + do_disconnect (p, NULL, 2, NULL); } odr_reset (p->odr_in); if (p->callback) - Tcl_Eval (p->interp, 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)); } @@ -2268,7 +3092,7 @@ void ir_select_read (ClientData clientData) */ void ir_select_write (ClientData clientData) { - IRObj *p = clientData; + IrTcl_Obj *p = clientData; int r; logf (LOG_DEBUG, "In write handler"); @@ -2283,21 +3107,27 @@ void ir_select_write (ClientData clientData) logf (LOG_DEBUG, "cs_rcvconnect error"); ir_select_remove_write (cs_fileno (p->cs_link), p); if (p->failback) - Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + { + p->failInfo = IR_TCL_FAIL_CONNECT; + IrTcl_eval (p->interp, p->failback); + } + do_disconnect (p, NULL, 2, NULL); return; } ir_select_remove_write (cs_fileno (p->cs_link), p); if (p->callback) - Tcl_Eval (p->interp, p->callback); + IrTcl_eval (p->interp, p->callback); return; } if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) { logf (LOG_DEBUG, "select write fail"); if (p->failback) - Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + { + p->failInfo = IR_TCL_FAIL_WRITE; + IrTcl_eval (p->interp, p->failback); + } + do_disconnect (p, NULL, 2, NULL); } else if (r == 0) /* remove select bit */ { @@ -2318,6 +3148,7 @@ 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; }