X-Git-Url: http://git.indexdata.com/?p=ir-tcl-moved-to-github.git;a=blobdiff_plain;f=ir-tcl.c;h=9b4ee5c20e39476407ab2f9d8f96457f6f809ebb;hp=06dc10b6cc41f8aa4fbc422a02d0e3f1dc0ec17c;hb=HEAD;hpb=f92ed5da17ea50c93bc34a1d523e67e4c569af82 diff --git a/ir-tcl.c b/ir-tcl.c index 06dc10b..9b4ee5c 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -1,11 +1,227 @@ /* * IR toolkit for tcl/tk - * (c) Index Data 1995 + * (c) Index Data 1995-2003 * See the file LICENSE for details. - * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.64 1995-11-13 15:39:18 adam + * Revision 1.128 2005-03-10 13:54:56 adam + * Remove CCL support for scan + * + * Revision 1.127 2004/05/10 08:38:45 adam + * Do not use obsolete YAZ defines + * + * Revision 1.126 2003/11/29 17:24:09 adam + * Added getXml method (Franck Falcoz) + * + * Revision 1.125 2003/04/29 10:51:23 adam + * Null terminate octet aligned records + * + * Revision 1.124 2003/03/05 22:02:47 adam + * Add Tcl_InitStubs + * + * Revision 1.123 2003/03/05 21:21:41 adam + * APDU log. default largeSetLowerBound changed from 2 to 1 + * + * Revision 1.122 2003/03/05 18:02:08 adam + * Fix bug with idAuthentication that didn't work for empty group. + * + * Revision 1.121 2003/01/30 13:27:07 adam + * Changed version to 1.4.1. Added WIN32 version resource. + * IrTcl ignores unexpected PDU's, rather than die. + * + * Revision 1.120 2002/03/20 14:48:54 adam + * implemented USR.1 SearchResult-1 + * + * Revision 1.119 2001/12/03 00:31:06 adam + * Towards 1.4. Configure updates. + * + * Revision 1.118 2001/03/27 16:27:21 adam + * Fixed bug in do_responseStatus. + * + * Revision 1.117 2001/03/26 11:39:34 adam + * Fixed bug in ir_deleteDiags - crash when receiving multiple diags. + * + * Revision 1.116 2001/02/09 11:58:04 adam + * Updated for Tcl8.1 and higher where internal encoding is UTF-8. + * + * Revision 1.115 2000/09/13 12:18:49 adam + * Logging utility patch (YAZ version 1.7). + * + * Revision 1.114 1999/05/17 20:37:41 adam + * Fixed problem with ASN code. + * + * Revision 1.113 1999/04/20 10:01:46 adam + * Modified calls to ODR encoders/decoders (name argument). + * + * Revision 1.112 1999/03/22 06:51:34 adam + * Implemented sort. + * + * Revision 1.111 1999/02/11 11:30:09 adam + * Updated for WIN32. + * + * Revision 1.110 1998/10/20 15:15:31 adam + * Changed scan response handler. + * + * Revision 1.109 1998/10/13 21:23:26 adam + * Fixed searchStatus method. + * + * Revision 1.108 1998/10/12 11:48:08 adam + * Removed printf call. + * + * Revision 1.107 1998/06/10 13:00:46 adam + * Added ir-version command. + * + * Revision 1.106 1998/05/20 12:25:35 adam + * Fixed bug that occurred in rare cases when encoding of incoming + * records failed. + * + * Revision 1.105 1998/04/02 14:31:08 adam + * This version works with compiled ASN.1 code. + * + * Revision 1.104 1998/02/27 14:26:07 adam + * Changed client so that it still works if target sets numberOfRecords + * in response to an illegal value. + * + * Revision 1.103 1997/11/19 11:22:10 adam + * Object identifiers can be accessed in GRS-1 records. + * + * Revision 1.102 1997/09/17 12:22:40 adam + * Changed to use YAZ version 1.4. The new comstack utility, cs_straddr, + * is used. + * + * Revision 1.101 1997/09/09 10:19:53 adam + * New MSV5.0 port with fewer warnings. + * + * Revision 1.100 1997/05/01 15:04:05 adam + * Added ir-log command. + * + * Revision 1.99 1997/04/30 07:24:47 adam + * Spell fix of an error message. + * + * Revision 1.98 1997/04/13 18:57:20 adam + * Better error reporting and aligned with Tcl/Tk style. + * Rework of notifier code with Tcl_File handles. + * + * Revision 1.97 1996/11/14 17:11:07 adam + * Added Explain documentaion. + * + * Revision 1.96 1996/10/08 13:02:50 adam + * When dealing with records, odr_choice_enable_bias function is used to + * prevent decoding of externals. + * + * Revision 1.95 1996/09/13 10:51:49 adam + * Bug fix: ir_tcl_select_set called Tcl_GetFile at disconnect. + * + * Revision 1.94 1996/08/21 13:32:53 adam + * Implemented saveFile method and extended loadFile method to work with it. + * + * Revision 1.93 1996/08/16 15:07:45 adam + * First work on Explain. + * + * Revision 1.92 1996/08/09 15:33:07 adam + * Modified the code to use tk4.1/tcl7.5 patch level 1. The time-driven + * polling is no longer activated on Windows since asynchrounous I/O works + * better. + * + * Revision 1.91 1996/07/03 13:31:11 adam + * The xmalloc/xfree functions from YAZ are used to manage memory. + * + * Revision 1.90 1996/06/27 14:21:00 adam + * Yet another Windows port. + * + * Revision 1.89 1996/06/11 15:27:15 adam + * Event type set to connect a little earlier in the do_connect function. + * + * Revision 1.88 1996/06/03 09:04:22 adam + * Changed a few logf calls. + * + * Revision 1.87 1996/05/29 06:37:51 adam + * Function ir_tcl_get_grs_r enhanced so that specific elements can be + * extracted. + * + * Revision 1.86 1996/03/20 13:54:04 adam + * The Tcl_File structure is only manipulated in the Tk-event interface + * in tkinit.c. + * + * Revision 1.85 1996/03/15 11:15:48 adam + * Modified to use new prototypes for p_query_rpn and p_query_scan. + * + * Revision 1.84 1996/03/07 12:42:49 adam + * Better logging when callback is invoked. + * + * Revision 1.83 1996/03/05 09:21:09 adam + * Bug fix: memory used by GRS records wasn't freed. + * Rewrote some of the error handling code - the connection is always + * closed before failback is called. + * If failback is defined the send APDU methods (init, search, ...) will + * return OK but invoke failback (as is the case if the write operation + * fails). + * Bug fix: ref_count in assoc object could grow if fraction of PDU was + * read. + * + * Revision 1.82 1996/02/29 15:30:21 adam + * Export of IrTcl functionality to extensions. + * + * Revision 1.81 1996/02/26 18:38:32 adam + * Work on export of set methods. + * + * Revision 1.80 1996/02/23 17:31:39 adam + * More functions made available to the wais tcl extension. + * + * Revision 1.79 1996/02/23 13:41:38 adam + * Work on public access to simple ir class system. + * + * Revision 1.78 1996/02/21 10:16:08 adam + * Simplified select handling. Only one function ir_tcl_select_set has + * to be externally defined. + * + * Revision 1.77 1996/02/20 17:52:58 adam + * Uses the YAZ oid system to name record syntax object identifiers. + * + * Revision 1.76 1996/02/20 16:09:51 adam + * Bug fix: didn't set element set names stamp correctly on result + * set records when element set names were set to the empty string. + * + * Revision 1.75 1996/02/19 15:41:53 adam + * Better log messages. + * Minor improvement of connect method. + * + * Revision 1.74 1996/02/05 17:58:03 adam + * Ported ir-tcl to use the beta releases of tcl7.5/tk4.1. + * + * Revision 1.73 1996/01/29 11:35:19 adam + * Bug fix: cs_type member renamed to comstackType to avoid conflict with + * cs_type macro defined by YAZ. + * + * Revision 1.72 1996/01/19 17:45:34 quinn + * Added debugging output + * + * Revision 1.71 1996/01/19 16:22:38 adam + * New method: apduDump - returns information about last incoming APDU. + * + * Revision 1.70 1996/01/10 09:18:34 adam + * PDU specific callbacks implemented: initRespnse, searchResponse, + * presentResponse and scanResponse. + * Bug fix in the command line shell (tclmain.c) - discovered on OSF/1. + * + * Revision 1.69 1996/01/04 16:12:12 adam + * Setting PDUType renamed to eventType. + * + * Revision 1.68 1996/01/04 11:05:22 adam + * New setting: PDUType - returns type of last PDU returned from the target. + * Fixed a bug in configure/Makefile. + * + * Revision 1.67 1996/01/03 09:00:51 adam + * Updated to use new version of Yaz (names changed to avoid C++ conflict). + * + * Revision 1.66 1995/11/28 17:26:39 adam + * Removed Carriage return from ir-tcl.c! + * Removed misc. debug logs. + * + * Revision 1.65 1995/11/28 13:53:00 quinn + * Windows port. + * + * Revision 1.64 1995/11/13 15:39:18 adam * Bug fix: {small,medium}SetElementSetNames weren't set correctly. * Bug fix: idAuthentication weren't set correctly. * @@ -229,51 +445,129 @@ #include #include -#include +#ifdef WIN32 + +#else +#include +#endif +#include #include #define CS_BLOCK 0 #include "ir-tclp.h" -typedef struct { - int type; - char *name; - int (*method) (void *obj, Tcl_Interp *interp, int argc, char **argv); -} IrTcl_Method; +#if defined(__WIN32__) +# define WIN32_LEAN_AND_MEAN +# include +# undef WIN32_LEAN_AND_MEAN + +/* + * VC++ has an alternate entry point called DllMain, so we need to rename + * our entry point. + */ + +# if defined(_MSC_VER) +# define EXPORT(a,b) __declspec(dllexport) a b +# define DllEntryPoint DllMain +# else +# if defined(__BORLANDC__) +# define EXPORT(a,b) a _export b +# else +# define EXPORT(a,b) a b +# endif +# endif +#else +# define EXPORT(a,b) a b +#endif + +static char *wrongArgs = "wrong # args: should be \""; +static FILE *odr_print_file = 0; + +static int ir_tcl_error_exec (Tcl_Interp *interp, int argc, char **argv) +{ + int i; + Tcl_AppendResult (interp, " while executing ", NULL); + for (i = 0; iwhich) + { + case Z_NamePlusRecord_databaseRecord: + switch (rl->u.dbrec.type) + { + case VAL_GRS1: + ir_tcl_grs_del (&rl->u.dbrec.u.grs1); + break; + default: + break; + } + xfree (rl->u.dbrec.buf); + rl->u.dbrec.buf = NULL; + break; + case Z_NamePlusRecord_surrogateDiagnostic: + ir_deleteDiags (&rl->u.surrogateDiagnostics.list, + &rl->u.surrogateDiagnostics.num); + break; + } + xfree (rl->elements); +} + +static void purge_IR_records (IrTcl_SetObj *setobj) +{ + IrTcl_RecordList *rl; + while ((rl = setobj->record_list)) + { + setobj->record_list = rl->next; + delete_IR_record (rl); + xfree (rl); + } +} static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, int no, int which, - const char *elements) + const char *elements) { IrTcl_RecordList *rl; + if (elements && !*elements) + elements = NULL; for (rl = setobj->record_list; rl; rl = rl->next) { if (no == rl->no && (!rl->elements || !elements || !strcmp(elements, rl->elements))) { - free (rl->elements); - switch (rl->which) - { - case Z_NamePlusRecord_databaseRecord: - free (rl->u.dbrec.buf); - rl->u.dbrec.buf = NULL; - break; - case Z_NamePlusRecord_surrogateDiagnostic: - ir_deleteDiags (&rl->u.surrogateDiagnostics.list, - &rl->u.surrogateDiagnostics.num); - break; - } + delete_IR_record (rl); break; } } @@ -289,58 +583,46 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, return rl; } -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" }, -{ VAL_GRS1, "GRS1" }, -{ 0, NULL } -}; - /* - * IrTcl_eval + * ir_tcl_eval */ -int IrTcl_eval (Tcl_Interp *interp, const char *command) +int ir_tcl_eval (Tcl_Interp *interp, const char *command) { char *tmp = ir_tcl_malloc (strlen(command)+1); int r; + logf (LOG_DEBUG, "Invoking %.23s ...", command); 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); + { + const char *errorInfo = Tcl_GetVar (interp, "errorInfo", 0); + logf (LOG_WARN, "Tcl error in line %d: %s\n%s", interp->errorLine, + interp->result, errorInfo ? errorInfo : ""); + } Tcl_FreeResult (interp); - free (tmp); + xfree (tmp); return r; } /* * IrTcl_getRecordSyntaxStr: Return record syntax name of object id */ -static const char *IrTcl_getRecordSyntaxStr (enum oid_value value) +static char *IrTcl_getRecordSyntaxStr (enum oid_value value) { - int i; - for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) - if (IrTcl_recordSyntaxTab[i].value == value) - return IrTcl_recordSyntaxTab[i].name; - return "USMARC"; + int *o; + struct oident ent, *entp; + + ent.proto = PROTO_Z3950; + ent.oclass = CLASS_RECSYN; + ent.value = value; + + o = oid_getoidbyent (&ent); + entp = oid_getentbyoid (o); + + if (!entp) + return ""; + return entp->desc; } /* @@ -348,11 +630,7 @@ static const char *IrTcl_getRecordSyntaxStr (enum oid_value value) */ static enum oid_value IrTcl_getRecordSyntaxVal (const char *name) { - int i; - for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) - if (!strcmp (IrTcl_recordSyntaxTab[i].name, name)) - return IrTcl_recordSyntaxTab[i].value; - return 0; + return oid_getvalbyname (name); } static IrTcl_RecordList *find_IR_record (IrTcl_SetObj *setobj, int no) @@ -373,26 +651,17 @@ static void delete_IR_records (IrTcl_SetObj *setobj) for (rl = setobj->record_list; rl; rl = rl1) { - 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); + delete_IR_record (rl); + rl1 = rl->next; + xfree (rl); } setobj->record_list = NULL; } /* - * get_set_int: Set/get integer value + * ir_tcl_get_set_int: Set/get integer value */ -static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) +int ir_tcl_get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) { char buf[20]; @@ -406,29 +675,18 @@ static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) return TCL_OK; } + /* - * ir_method: Search for method in table and invoke method handler + * ir_tcl_method_error */ -int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab) +int ir_tcl_method_error (Tcl_Interp *interp, int argc, char **argv, + IrTcl_Methods *tab) { 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 (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: ", argv[1], - ". Possible methods:", NULL); + Tcl_AppendResult (interp, "bad method: \"", *argv, " ", argv[1], + "\"\nmethod should be of:", NULL); for (tab_i = tab; tab_i->tab; tab_i++) for (t = tab_i->tab; t->name; t++) Tcl_AppendResult (interp, " ", t->name, NULL); @@ -436,32 +694,39 @@ int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab) } /* - * ir_method_r: Get status for all readable elements + * ir_tcl_method: Search for method in table and invoke method handler */ -int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv, - IrTcl_Method *tab) +int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, + IrTcl_Methods *tab, int *ret) { - char *argv_n[3]; - int argc_n; + IrTcl_Methods *tab_i = tab; + IrTcl_Method *t; - argv_n[0] = argv[0]; - argc_n = 2; - for (; tab->name; tab++) - if (tab->type) - { - argv_n[1] = tab->name; - Tcl_AppendResult (interp, "{", NULL); - (*tab->method)(obj, interp, argc_n, argv_n); - Tcl_AppendResult (interp, "} ", NULL); - } - return TCL_OK; + for (tab_i = tab; tab_i->tab; tab_i++) + for (t = tab_i->tab; t->name; t++) + if (argc <= 0) + { + if ((*t->method)(tab_i->obj, interp, argc, argv) == TCL_ERROR) + return TCL_ERROR; + } + else + if (!strcmp (t->name, argv[1])) + { + *ret = (*t->method)(tab_i->obj, interp, argc, argv); + return TCL_OK; + } + + if (argc <= 0) + return TCL_OK; + *ret = TCL_ERROR; + return TCL_ERROR; } /* - * ir_named_bits: get/set named bits + * ir_tcl_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) +int ir_tcl_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, + Tcl_Interp *interp, int argc, char **argv) { struct ir_named_entry *ti; if (argc > 0) @@ -470,16 +735,17 @@ int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, ODR_MASK_ZERO (ob); for (no = 0; no < argc; no++) { + int ok = 0; for (ti = tab; ti->name; ti++) - if (!strcmp (argv[no], ti->name)) + if (!strcmp(argv[no], "@all") || !strcmp (argv[no], ti->name)) { ODR_MASK_SET (ob, ti->pos); - break; + ok = 1; } - if (!ti->name) + if (!ok) { - Tcl_AppendResult (interp, "Bad bit mask: ", argv[no], NULL); - return TCL_ERROR; + Tcl_AppendResult (interp, "bad bit mask ", argv[no], NULL); + return ir_tcl_error_exec (interp, argc, argv); } } return TCL_OK; @@ -497,19 +763,19 @@ static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src) 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); + (*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); + xfree (*dst); if (!src) { *dst = NULL; - return; + return; } *dst = ir_tcl_malloc (src->len+1); memcpy (*dst, src->buf, src->len); @@ -530,10 +796,11 @@ static int do_init_request (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; + logf (LOG_DEBUG, "init %s", *argv); if (!p->cs_link) { - interp->result = "init: not connected"; - return TCL_ERROR; + Tcl_AppendResult (interp, "not connected", NULL); + return ir_tcl_error_exec (interp, argc, argv); } apdu = zget_APDU (p->odr_out, Z_APDU_initRequest); req = apdu->u.initRequest; @@ -544,7 +811,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, req->preferredMessageSize = &p->preferredMessageSize; req->maximumRecordSize = &p->maximumRecordSize; - if (p->idAuthenticationGroupId) + if (p->idAuthenticationGroupId || p->idAuthenticationUserId) { Z_IdPass *pass = odr_malloc (p->odr_out, sizeof(*pass)); Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth)); @@ -567,9 +834,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, pass->password = NULL; req->idAuthentication = auth; } - else if (!p->idAuthenticationOpen || !*p->idAuthenticationOpen) - req->idAuthentication = NULL; - else + else if (p->idAuthenticationOpen && *p->idAuthenticationOpen) { Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth)); @@ -578,12 +843,14 @@ static int do_init_request (void *obj, Tcl_Interp *interp, auth->u.open = p->idAuthenticationOpen; req->idAuthentication = auth; } + else + req->idAuthentication = NULL; req->implementationId = p->implementationId; req->implementationName = p->implementationName; req->implementationVersion = p->implementationVersion; req->userInformationField = 0; - return ir_tcl_send_APDU (interp, p, apdu, "init", argv[0]); + return ir_tcl_send_APDU (interp, p, apdu, "init", *argv); } /* @@ -599,8 +866,8 @@ static int do_protocolVersion (void *obj, Tcl_Interp *interp, if (argc <= 0) { ODR_MASK_ZERO (&p->protocolVersion); - ODR_MASK_SET (&p->protocolVersion, 0); - ODR_MASK_SET (&p->protocolVersion, 1); + ODR_MASK_SET (&p->protocolVersion, 0); + ODR_MASK_SET (&p->protocolVersion, 1); return TCL_OK; } if (argc == 3) @@ -647,14 +914,62 @@ static int do_options (void *obj, Tcl_Interp *interp, 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, 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; + ODR_MASK_SET (&p->options, 7); + ODR_MASK_SET (&p->options, 14); + return TCL_OK; + } + return ir_tcl_named_bits (options_tab, &p->options, interp, argc-2, argv+2); +} + +/* + * do_apduInfo: Get APDU information + */ +static int do_apduInfo (void *obj, Tcl_Interp *interp, int argc, char **argv) +{ + char buf[16]; + FILE *apduf; + IrTcl_Obj *p = obj; + + if (argc <= 0) + return TCL_OK; + sprintf (buf, "%d", p->apduLen); + Tcl_AppendElement (interp, buf); + sprintf (buf, "%d", p->apduOffset); + Tcl_AppendElement (interp, buf); + if (!p->buf_in) + { + Tcl_AppendElement (interp, ""); + return TCL_OK; + } + apduf = fopen ("apdu.tmp", "w"); + if (!apduf) + { + Tcl_AppendElement (interp, ""); + return TCL_OK; + } + odr_dumpBER (apduf, p->buf_in, p->apduLen); + fclose (apduf); + if (!(apduf = fopen ("apdu.tmp", "r"))) + Tcl_AppendElement (interp, ""); + else + { + int c; + + Tcl_AppendResult (interp, " {", NULL); + while ((c = getc (apduf)) != EOF) + { + buf[0] = c; + buf[1] = '\0'; + Tcl_AppendResult (interp, buf, NULL); + } + fclose (apduf); + Tcl_AppendResult (interp, "}", NULL); } - return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2); + unlink ("apdu.tmp"); + return TCL_OK; } /* @@ -668,7 +983,7 @@ static int do_failInfo (void *obj, Tcl_Interp *interp, int argc, char **argv) if (argc <= 0) { p->failInfo = 0; - return TCL_OK; + return TCL_OK; } sprintf (buf, "%d", p->failInfo); switch (p->failInfo) @@ -710,9 +1025,9 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp, if (argc <= 0) { p->preferredMessageSize = 30000; - return TCL_OK; + return TCL_OK; } - return get_set_int (&p->preferredMessageSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->preferredMessageSize, interp, argc, argv); } /* @@ -726,9 +1041,9 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp, if (argc <= 0) { p->maximumRecordSize = 30000; - return TCL_OK; + return TCL_OK; } - return get_set_int (&p->maximumRecordSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->maximumRecordSize, interp, argc, argv); } /* @@ -741,7 +1056,7 @@ static int do_initResult (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->initResult, interp, argc, argv); + return ir_tcl_get_set_int (&p->initResult, interp, argc, argv); } @@ -755,12 +1070,12 @@ static int do_implementationName (void *obj, Tcl_Interp *interp, if (argc == 0) return ir_tcl_strdup (interp, &p->implementationName, - "Index Data/IrTcl on YAZ"); + "IrTcl/YAZ"); else if (argc == -1) return ir_tcl_strdel (interp, &p->implementationName); if (argc == 3) { - free (p->implementationName); + xfree (p->implementationName); if (ir_tcl_strdup (interp, &p->implementationName, argv[2]) == TCL_ERROR) return TCL_ERROR; @@ -778,7 +1093,7 @@ static int do_implementationId (void *obj, Tcl_Interp *interp, IrTcl_Obj *p = obj; if (argc == 0) - return ir_tcl_strdup (interp, &p->implementationId, "YAZ (id=81)"); + return ir_tcl_strdup (interp, &p->implementationId, "81"); else if (argc == -1) return ir_tcl_strdel (interp, &p->implementationId); Tcl_AppendResult (interp, p->implementationId, (char*) NULL); @@ -795,7 +1110,11 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp, if (argc == 0) return ir_tcl_strdup (interp, &p->implementationVersion, - "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION); +#ifdef IR_TCL_VERSION + IR_TCL_VERSION "/" +#endif + YAZ_VERSION + ); else if (argc == -1) return ir_tcl_strdel (interp, &p->implementationVersion); Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL); @@ -813,7 +1132,7 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, if (argc == 0) { p->targetImplementationName = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) return ir_tcl_strdel (interp, &p->targetImplementationName); @@ -832,7 +1151,7 @@ static int do_targetImplementationId (void *obj, Tcl_Interp *interp, if (argc == 0) { p->targetImplementationId = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) return ir_tcl_strdel (interp, &p->targetImplementationId); @@ -851,7 +1170,7 @@ static int do_targetImplementationVersion (void *obj, Tcl_Interp *interp, if (argc == 0) { p->targetImplementationVersion = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) return ir_tcl_strdel (interp, &p->targetImplementationVersion); @@ -869,10 +1188,10 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, if (argc >= 3 || argc == -1) { - free (p->idAuthenticationOpen); - free (p->idAuthenticationGroupId); - free (p->idAuthenticationUserId); - free (p->idAuthenticationPassword); + xfree (p->idAuthenticationOpen); + xfree (p->idAuthenticationGroupId); + xfree (p->idAuthenticationUserId); + xfree (p->idAuthenticationPassword); } if (argc >= 3 || argc <= 0) { @@ -887,6 +1206,12 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, { if (argc == 3) { + xfree (p->idAuthenticationGroupId); + xfree (p->idAuthenticationUserId); + xfree (p->idAuthenticationPassword); + p->idAuthenticationGroupId = NULL; + p->idAuthenticationUserId = NULL; + p->idAuthenticationPassword = NULL; if (argv[2][0] && ir_tcl_strdup (interp, &p->idAuthenticationOpen, argv[2]) == TCL_ERROR) @@ -894,6 +1219,8 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, } else if (argc == 5) { + xfree (p->idAuthenticationOpen); + p->idAuthenticationOpen = NULL; if (argv[2][0] && ir_tcl_strdup (interp, &p->idAuthenticationGroupId, argv[2]) == TCL_ERROR) @@ -910,7 +1237,7 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, } if (p->idAuthenticationOpen) Tcl_AppendElement (interp, p->idAuthenticationOpen); - else if (p->idAuthenticationGroupId) + else if (p->idAuthenticationGroupId || p->idAuthenticationUserId) { Tcl_AppendElement (interp, p->idAuthenticationGroupId); Tcl_AppendElement (interp, p->idAuthenticationUserId); @@ -923,7 +1250,7 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, * do_connect: connect method on IR object */ static int do_connect (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { void *addr; IrTcl_Obj *p = obj; @@ -931,137 +1258,156 @@ static int do_connect (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - if (argc == 3) + if (argc > 3) + { + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " ?hostname?\"", NULL); + return TCL_ERROR; + } + else if (argc < 3) + { + Tcl_AppendResult (interp, p->hostname, NULL); + } + else { + logf (LOG_DEBUG, "connect %s %s", *argv, argv[2]); if (p->hostname) { - interp->result = "already connected"; - return TCL_ERROR; + Tcl_AppendResult (interp, "already connected", NULL); + return ir_tcl_error_exec (interp, argc, argv); } - if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) - return TCL_ERROR; - if (!strcmp (p->cs_type, "tcpip")) + if (!strcmp (p->comstackType, "tcpip")) { p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type); - addr = tcpip_strtoaddr (argv[2]); - if (!addr) - { - interp->result = "tcpip_strtoaddr fail"; - return TCL_ERROR; - } logf (LOG_DEBUG, "tcp/ip connect %s", argv[2]); } - else if (!strcmp (p->cs_type, "mosi")) + else if (!strcmp (p->comstackType, "mosi")) { #if MOSI p->cs_link = cs_create (mosi_type, CS_BLOCK, p->protocol_type); - addr = mosi_strtoaddr (argv[2]); - if (!addr) - { - interp->result = "mosi_strtoaddr fail"; - return TCL_ERROR; - } logf (LOG_DEBUG, "mosi connect %s", argv[2]); #else - interp->result = "MOSI support not there"; - return TCL_ERROR; + Tcl_AppendResult (interp, "mosi not supported", NULL); + return ir_tcl_error_exec (interp, argc, argv); #endif } else { - Tcl_AppendResult (interp, "Bad comstack type: ", - p->cs_type, NULL); - return TCL_ERROR; + Tcl_AppendResult (interp, "bad comstack type ", + p->comstackType, NULL); + return ir_tcl_error_exec (interp, argc, argv); } + if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) + return TCL_ERROR; + p->eventType = "connect"; + addr = cs_straddr (p->cs_link, argv[2]); + if (!addr) + { + ir_tcl_disconnect (p); + Tcl_AppendResult (interp, "cs_straddr fail", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } if ((r=cs_connect (p->cs_link, addr)) < 0) { - interp->result = "connect fail"; - do_disconnect (p, NULL, 2, NULL); - return TCL_ERROR; + ir_tcl_disconnect (p); + Tcl_AppendResult (interp, "connect fail", NULL); + return ir_tcl_error_exec (interp, argc, argv); } ir_select_add (cs_fileno (p->cs_link), p); if (r == 1) { + logf (LOG_DEBUG, "connect pending fd=%d", cs_fileno(p->cs_link)); ir_select_add_write (cs_fileno (p->cs_link), p); p->state = IR_TCL_R_Connecting; } else { + logf (LOG_DEBUG, "connect ok fd=%d", cs_fileno(p->cs_link)); p->state = IR_TCL_R_Idle; if (p->callback) - IrTcl_eval (p->interp, p->callback); + ir_tcl_eval (p->interp, p->callback); } } - else - Tcl_AppendResult (interp, p->hostname, NULL); return TCL_OK; } -/* - * do_disconnect: disconnect method on IR object +/* + * ir_tcl_disconnect: close connection */ -static int do_disconnect (void *obj, Tcl_Interp *interp, - int argc, char **argv) +void ir_tcl_disconnect (IrTcl_Obj *p) { - IrTcl_Obj *p = obj; - - if (argc == 0) - { - p->state = IR_TCL_R_Idle; - p->hostname = NULL; - p->cs_link = NULL; - return TCL_OK; - } if (p->hostname) { - free (p->hostname); + logf(LOG_DEBUG, "Closing connection to %s", p->hostname); + xfree (p->hostname); p->hostname = NULL; - ir_select_remove_write (cs_fileno (p->cs_link), p); + assert (p->cs_link); ir_select_remove (cs_fileno (p->cs_link), p); odr_reset (p->odr_in); - assert (p->cs_link); +#if TCL_MAJOR_VERSION == 8 + cs_fileno(p->cs_link) = -1; +#endif 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, 4); - ODR_MASK_SET (&p->options, 7); - ODR_MASK_SET (&p->options, 14); + 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); + ODR_MASK_SET (&p->protocolVersion, 0); + ODR_MASK_SET (&p->protocolVersion, 1); ir_tcl_del_q (p); } assert (!p->cs_link); - return TCL_OK; } /* - * do_comstack: Set/get comstack method on IR object + * do_disconnect: disconnect method on IR object */ -static int do_comstack (void *o, Tcl_Interp *interp, - int argc, char **argv) +static int do_disconnect (void *obj, Tcl_Interp *interp, + int argc, char **argv) { - IrTcl_Obj *obj = o; + IrTcl_Obj *p = obj; if (argc == 0) - return ir_tcl_strdup (interp, &obj->cs_type, "tcpip"); - else if (argc == -1) - return ir_tcl_strdel (interp, &obj->cs_type); - else if (argc == 3) { - free (obj->cs_type); - if (ir_tcl_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR) - return TCL_ERROR; - } - Tcl_AppendElement (interp, obj->cs_type); - return TCL_OK; -} + p->state = IR_TCL_R_Idle; + p->eventType = NULL; + p->hostname = NULL; + p->cs_link = NULL; + return TCL_OK; + } + ir_tcl_disconnect (p); + return TCL_OK; +} + +/* + * do_comstack: Set/get comstack method on IR object + */ +static int do_comstack (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *obj = o; + + if (argc == 0) + return ir_tcl_strdup (interp, &obj->comstackType, "tcpip"); + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->comstackType); + else if (argc == 3) + { + xfree (obj->comstackType); + if (ir_tcl_strdup (interp, &obj->comstackType, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendElement (interp, obj->comstackType); + return TCL_OK; +} /* * do_logLevel: Set log level @@ -1072,11 +1418,29 @@ static int do_logLevel (void *o, Tcl_Interp *interp, if (argc <= 2) return TCL_OK; if (argc == 3) - log_init (log_mask_str (argv[2]), "", NULL); + yaz_log_init (yaz_log_mask_str (argv[2]), "", NULL); else if (argc == 4) - log_init (log_mask_str (argv[2]), argv[3], NULL); + yaz_log_init (yaz_log_mask_str (argv[2]), argv[3], NULL); else if (argc == 5) - log_init (log_mask_str (argv[2]), argv[3], argv[4]); + yaz_log_init (yaz_log_mask_str (argv[2]), argv[3], argv[4]); + return TCL_OK; +} + + +/* + * do_eventType: Return type of last event + */ +static int do_eventType (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + + if (argc <= 0) + { + p->eventType = NULL; + return TCL_OK; + } + Tcl_AppendElement (interp, p->eventType ? p->eventType : ""); return TCL_OK; } @@ -1085,27 +1449,27 @@ static int do_logLevel (void *o, Tcl_Interp *interp, * do_callback: add callback */ static int do_callback (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { IrTcl_Obj *p = obj; if (argc == 0) { p->callback = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) return ir_tcl_strdel (interp, &p->callback); if (argc == 3) { - free (p->callback); - if (argv[2][0]) - { + xfree (p->callback); + if (argv[2][0]) + { if (ir_tcl_strdup (interp, &p->callback, argv[2]) == TCL_ERROR) return TCL_ERROR; - } - else - p->callback = NULL; + } + else + p->callback = NULL; } return TCL_OK; } @@ -1121,25 +1485,53 @@ static int do_failback (void *obj, Tcl_Interp *interp, if (argc == 0) { p->failback = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) return ir_tcl_strdel (interp, &p->failback); else if (argc == 3) { - free (p->failback); - if (argv[2][0]) - { + xfree (p->failback); + if (argv[2][0]) + { if (ir_tcl_strdup (interp, &p->failback, argv[2]) == TCL_ERROR) return TCL_ERROR; - } - else - p->failback = NULL; + } + else + p->failback = NULL; } return TCL_OK; } /* + * do_initResponse: add init response handler + */ +static int do_initResponse (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + + if (argc == 0) + { + p->initResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->initResponse); + if (argc == 3) + { + xfree (p->initResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &p->initResponse, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + else + p->initResponse = NULL; + } + return TCL_OK; +} +/* * do_protocol: Set/get protocol method on IR object */ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv) @@ -1159,8 +1551,8 @@ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv) p->protocol_type = PROTO_SR; else { - Tcl_AppendResult (interp, "Bad protocol: ", argv[2], NULL); - return TCL_ERROR; + Tcl_AppendResult (interp, "bad protocol ", argv[2], NULL); + return ir_tcl_error_exec (interp, argc, argv); } return TCL_OK; } @@ -1191,12 +1583,12 @@ static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, return TCL_OK; if (!p->cs_link) { - interp->result = "triggerResourceControl: not connected"; - return TCL_ERROR; + Tcl_AppendResult (interp, "not connected", NULL); + return ir_tcl_error_exec (interp, argc, argv); } apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest); req = apdu->u.triggerResourceControlRequest; - *req->requestedAction = Z_TriggerResourceCtrl_cancel; + *req->requestedAction = Z_TriggerResourceControlRequest_cancel; req->resultSetWanted = &is_false; return ir_tcl_send_APDU (interp, p, apdu, "triggerResourceControl", @@ -1215,14 +1607,14 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, if (argc == -1) { for (i=0; inum_databaseNames; i++) - free (p->databaseNames[i]); - free (p->databaseNames); + xfree (p->databaseNames[i]); + xfree (p->databaseNames); } if (argc <= 0) { p->num_databaseNames = 0; - p->databaseNames = NULL; - return TCL_OK; + p->databaseNames = NULL; + return TCL_OK; } if (argc < 3) { @@ -1233,18 +1625,19 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, if (p->databaseNames) { for (i=0; inum_databaseNames; i++) - free (p->databaseNames[i]); - free (p->databaseNames); + xfree (p->databaseNames[i]); + xfree (p->databaseNames); } p->num_databaseNames = argc - 2; p->databaseNames = - ir_tcl_malloc (sizeof(*p->databaseNames) * p->num_databaseNames); + ir_tcl_malloc (sizeof(*p->databaseNames) * (1+p->num_databaseNames)); for (i=0; inum_databaseNames; i++) { if (ir_tcl_strdup (interp, &p->databaseNames[i], argv[2+i]) == TCL_ERROR) return TCL_ERROR; } + p->databaseNames[i] = NULL; return TCL_OK; } @@ -1259,16 +1652,16 @@ static int do_replaceIndicator (void *obj, Tcl_Interp *interp, if (argc <= 0) { p->replaceIndicator = 1; - return TCL_OK; + return TCL_OK; } - return get_set_int (&p->replaceIndicator, interp, argc, argv); + return ir_tcl_get_set_int (&p->replaceIndicator, interp, argc, argv); } /* * do_queryType: Set/Get query method */ static int do_queryType (void *obj, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { IrTcl_SetCObj *p = obj; @@ -1278,7 +1671,7 @@ static int do_queryType (void *obj, Tcl_Interp *interp, return ir_tcl_strdel (interp, &p->queryType); if (argc == 3) { - free (p->queryType); + xfree (p->queryType); if (ir_tcl_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR) return TCL_ERROR; } @@ -1297,7 +1690,7 @@ static int do_userInformationField (void *obj, Tcl_Interp *interp, if (argc == 0) { p->userInformationField = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) return ir_tcl_strdel (interp, &p->userInformationField); @@ -1309,16 +1702,16 @@ static int do_userInformationField (void *obj, Tcl_Interp *interp, * do_smallSetUpperBound: Set/get small set upper bound */ static int do_smallSetUpperBound (void *o, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { IrTcl_SetCObj *p = o; if (argc <= 0) { p->smallSetUpperBound = 0; - return TCL_OK; + return TCL_OK; } - return get_set_int (&p->smallSetUpperBound, interp, argc, argv); + return ir_tcl_get_set_int (&p->smallSetUpperBound, interp, argc, argv); } /* @@ -1331,10 +1724,10 @@ static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, if (argc <= 0) { - p->largeSetLowerBound = 2; - return TCL_OK; + p->largeSetLowerBound = 1; + return TCL_OK; } - return get_set_int (&p->largeSetLowerBound, interp, argc, argv); + return ir_tcl_get_set_int (&p->largeSetLowerBound, interp, argc, argv); } /* @@ -1348,16 +1741,16 @@ static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp, if (argc <= 0) { p->mediumSetPresentNumber = 0; - return TCL_OK; + return TCL_OK; } - return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); + return ir_tcl_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) + int argc, char **argv) { IrTcl_SetCObj *p = obj; @@ -1370,7 +1763,7 @@ static int do_referenceId (void *obj, Tcl_Interp *interp, return ir_tcl_strdel (interp, &p->referenceId); if (argc == 3) { - free (p->referenceId); + xfree (p->referenceId); if (ir_tcl_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR) return TCL_ERROR; } @@ -1393,18 +1786,24 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp, } else if (argc == -1) { - free (p->preferredRecordSyntax); + xfree (p->preferredRecordSyntax); p->preferredRecordSyntax = NULL; return TCL_OK; } if (argc == 3) { - free (p->preferredRecordSyntax); + xfree (p->preferredRecordSyntax); p->preferredRecordSyntax = NULL; if (argv[2][0] && (p->preferredRecordSyntax = ir_tcl_malloc (sizeof(*p->preferredRecordSyntax)))) *p->preferredRecordSyntax = IrTcl_getRecordSyntaxVal (argv[2]); } + else if (argc == 2) + { + Tcl_AppendElement + (interp,!p->preferredRecordSyntax ? "" : + IrTcl_getRecordSyntaxStr(*p->preferredRecordSyntax)); + } return TCL_OK; } @@ -1426,7 +1825,7 @@ static int do_elementSetNames (void *obj, Tcl_Interp *interp, return ir_tcl_strdel (interp, &p->elementSetNames); if (argc == 3) { - free (p->elementSetNames); + xfree (p->elementSetNames); if (ir_tcl_strdup (interp, &p->elementSetNames, argv[2]) == TCL_ERROR) return TCL_ERROR; } @@ -1451,7 +1850,7 @@ static int do_smallSetElementSetNames (void *obj, Tcl_Interp *interp, return ir_tcl_strdel (interp, &p->smallSetElementSetNames); if (argc == 3) { - free (p->smallSetElementSetNames); + xfree (p->smallSetElementSetNames); if (ir_tcl_strdup (interp, &p->smallSetElementSetNames, argv[2]) == TCL_ERROR) return TCL_ERROR; @@ -1477,7 +1876,7 @@ static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp, return ir_tcl_strdel (interp, &p->mediumSetElementSetNames); if (argc == 3) { - free (p->mediumSetElementSetNames); + xfree (p->mediumSetElementSetNames); if (ir_tcl_strdup (interp, &p->mediumSetElementSetNames, argv[2]) == TCL_ERROR) return TCL_ERROR; @@ -1486,48 +1885,51 @@ static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp, 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 }, -{ 1, "preferredMessageSize", do_preferredMessageSize }, -{ 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 }, -{ 0, "userInformationField", do_userInformationField }, -{ 1, "idAuthentication", do_idAuthentication }, -{ 0, "options", do_options }, -{ 0, "init", do_init_request }, -{ 0, "initResult", do_initResult }, -{ 0, "disconnect", do_disconnect }, -{ 0, "callback", do_callback }, -{ 0, "triggerResourceControl", do_triggerResourceControl }, -{ 0, NULL, NULL} +{ "comstack", do_comstack, NULL }, +{ "protocol", do_protocol, NULL }, +{ "failback", do_failback, NULL }, +{ "failInfo", do_failInfo, NULL }, +{ "apduInfo", do_apduInfo, NULL }, +{ "logLevel", do_logLevel, NULL }, + +{ "eventType", do_eventType, NULL }, +{ "connect", do_connect, NULL }, +{ "protocolVersion", do_protocolVersion, NULL }, +{ "preferredMessageSize", do_preferredMessageSize, NULL }, +{ "maximumRecordSize", do_maximumRecordSize, NULL }, +{ "implementationName", do_implementationName, NULL }, +{ "implementationId", do_implementationId, NULL }, +{ "implementationVersion", do_implementationVersion, NULL }, +{ "targetImplementationName", do_targetImplementationName, NULL }, +{ "targetImplementationId", do_targetImplementationId, NULL }, +{ "targetImplementationVersion", do_targetImplementationVersion, NULL}, +{ "userInformationField", do_userInformationField, NULL}, +{ "idAuthentication", do_idAuthentication, NULL}, +{ "options", do_options, NULL}, +{ "init", do_init_request, NULL}, +{ "initResult", do_initResult, NULL}, +{ "disconnect", do_disconnect, NULL}, +{ "callback", do_callback, NULL}, +{ "initResponse", do_initResponse, NULL}, +{ "triggerResourceControl", do_triggerResourceControl, NULL}, +{ "initResponse", do_initResponse, NULL}, +{ NULL, NULL} }; 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, "elementSetNames", do_elementSetNames }, -{ 0, "smallSetElementSetNames", do_smallSetElementSetNames }, -{ 0, "mediumSetElementSetNames", do_mediumSetElementSetNames }, -{ 0, NULL, NULL} +{ "databaseNames", do_databaseNames, NULL}, +{ "replaceIndicator", do_replaceIndicator, NULL}, +{ "queryType", do_queryType, NULL}, +{ "preferredRecordSyntax", do_preferredRecordSyntax, NULL}, +{ "smallSetUpperBound", do_smallSetUpperBound, NULL}, +{ "largeSetLowerBound", do_largeSetLowerBound, NULL}, +{ "mediumSetPresentNumber", do_mediumSetPresentNumber, NULL}, +{ "referenceId", do_referenceId, NULL}, +{ "elementSetNames", do_elementSetNames, NULL}, +{ "smallSetElementSetNames", do_smallSetElementSetNames, NULL}, +{ "mediumSetElementSetNames", do_mediumSetElementSetNames, NULL}, +{ NULL, NULL} }; /* @@ -1537,18 +1939,24 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Methods tab[3]; - IrTcl_Obj *p = clientData; + IrTcl_Obj *p = (IrTcl_Obj *) clientData; + int r; if (argc < 2) - return ir_method_r (clientData, interp, argc, argv, ir_method_tab); - + { + Tcl_AppendResult (interp, wrongArgs, *argv, "method args...\"", NULL); + return TCL_ERROR; + } + tab[0].tab = ir_method_tab; tab[0].obj = p; tab[1].tab = ir_set_c_method_tab; tab[1].obj = &p->set_inher; tab[2].tab = NULL; - - return ir_method (interp, argc, argv, tab); + + if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR) + return ir_tcl_method_error (interp, argc, argv, tab); + return r; } /* @@ -1556,7 +1964,7 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, */ static void ir_obj_delete (ClientData clientData) { - IrTcl_Obj *obj = clientData; + IrTcl_Obj *obj = (IrTcl_Obj *) clientData; IrTcl_Methods tab[3]; --(obj->ref_count); @@ -1571,20 +1979,25 @@ static void ir_obj_delete (ClientData clientData) tab[1].obj = &obj->set_inher; tab[2].tab = NULL; - ir_method (NULL, -1, NULL, tab); + ir_tcl_method (NULL, -1, NULL, tab, NULL); ir_tcl_del_q (obj); odr_destroy (obj->odr_in); odr_destroy (obj->odr_out); - odr_destroy (obj->odr_pr); - free (obj); + if (obj->odr_pr) + { + obj->odr_pr->print = 0; + odr_destroy (obj->odr_pr); + } + xfree (obj); } /* - * ir_obj_mk: IR Object creation + * ir_obj_init: IR Object initialization */ -static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +int ir_obj_init (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv, ClientData *subData, + ClientData parentData) { IrTcl_Methods tab[3]; IrTcl_Obj *obj; @@ -1594,7 +2007,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, if (argc != 2) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, " objName\"", NULL); return TCL_ERROR; } obj = ir_tcl_malloc (sizeof(*obj)); @@ -1603,15 +2016,21 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->bibset = ccl_qual_mk (); if ((inf = fopen ("default.bib", "r"))) { - ccl_qual_file (obj->bibset, inf); - fclose (inf); + ccl_qual_file (obj->bibset, inf); + fclose (inf); } #endif - logf (LOG_DEBUG, "ir object create"); + logf (LOG_DEBUG, "ir object create %s", argv[1]); obj->odr_in = odr_createmem (ODR_DECODE); + odr_choice_enable_bias (obj->odr_in, 0); obj->odr_out = odr_createmem (ODR_ENCODE); - obj->odr_pr = odr_createmem (ODR_PRINT); + obj->odr_pr = 0; + if (odr_print_file) + { + obj->odr_pr = odr_createmem (ODR_PRINT); + odr_setprint(obj->odr_pr, odr_print_file); + } obj->state = IR_TCL_R_Idle; obj->interp = interp; @@ -1625,13 +2044,40 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, tab[1].obj = &obj->set_inher; tab[2].tab = NULL; - if (ir_method (interp, 0, NULL, tab) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR) + { + Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL); + return TCL_ERROR; + } + *subData = (ClientData) obj; + return TCL_OK; +} + + +/* + * ir_obj_mk: IR Object creation + */ +static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + ClientData subData; + int r = ir_obj_init (clientData, interp, argc, argv, &subData, 0); + + if (r == TCL_ERROR) return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_obj_method, - (ClientData) obj, ir_obj_delete); + subData, ir_obj_delete); return TCL_OK; } +IrTcl_Class ir_obj_class = { + "ir", + ir_obj_init, + ir_obj_method, + ir_obj_delete +}; + + /* ------------------------------------------------------- */ /* * do_search: Do search request @@ -1644,37 +2090,46 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) Odr_oct ccl_query; IrTcl_SetObj *obj = o; IrTcl_Obj *p; - int r; - oident bib1; + int r, code; +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) + Tcl_DString ds; +#endif + char *query_str; if (argc <= 0) return TCL_OK; p = obj->parent; + assert (argc > 1); if (argc != 3) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], "query\"", + NULL); return TCL_ERROR; } +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) + query_str = Tcl_UtfToExternalDString(0, argv[2], -1, &ds); +#else + query_str = argv[2]; +#endif + logf (LOG_DEBUG, "search %s %s", *argv, query_str); if (!obj->set_inher.num_databaseNames) { - interp->result = "no databaseNames"; - return TCL_ERROR; + Tcl_AppendResult (interp, "no databaseNames", NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; } if (!p->cs_link) { - interp->result = "search: not connected"; - return TCL_ERROR; + Tcl_AppendResult (interp, "not connected", NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; } apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest); req = apdu->u.searchRequest; obj->start = 1; - bib1.proto = p->protocol_type; - bib1.class = CLASS_ATTSET; - bib1.value = VAL_BIB1; - set_referenceId (p->odr_out, &req->referenceId, obj->set_inher.referenceId); @@ -1682,7 +2137,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) 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"; + 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; @@ -1693,7 +2148,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) struct oident ident; ident.proto = p->protocol_type; - ident.class = CLASS_RECSYN; + ident.oclass = 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, @@ -1727,21 +2182,21 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) req->mediumSetElementSetNames = NULL; req->query = &query; - + + logf (LOG_DEBUG, "queryType %s", obj->set_inher.queryType); if (!strcmp (obj->set_inher.queryType, "rpn")) { Z_RPNQuery *RPNquery; - RPNquery = p_query_rpn (p->odr_out, argv[2]); - if (!RPNquery) - { - Tcl_AppendResult (interp, "Syntax error in query", NULL); - return TCL_ERROR; + RPNquery = p_query_rpn (p->odr_out, p->protocol_type, query_str); + if (!RPNquery) + { + Tcl_AppendResult (interp, "query syntax error", NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; } - 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 (obj->set_inher.queryType, "cclrpn")) @@ -1750,76 +2205,259 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) int pos; struct ccl_rpn_node *rpn; Z_RPNQuery *RPNquery; + oident bib1; - rpn = ccl_find_str(p->bibset, argv[2], &error, &pos); + bib1.proto = p->protocol_type; + bib1.oclass = CLASS_ATTSET; + bib1.value = VAL_BIB1; + + rpn = ccl_find_str(p->bibset, query_str, &error, &pos); if (error) { - Tcl_AppendResult (interp, "CCL error: ", - ccl_err_msg(error), NULL); - return TCL_ERROR; + Tcl_AppendResult (interp, "ccl syntax error ", ccl_err_msg(error), + NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; } +#if 0 ccl_pr_tree (rpn, stderr); fprintf (stderr, "\n"); - assert((RPNquery = ccl_rpn_query(rpn))); +#endif + RPNquery = ccl_rpn_query(p->odr_out, rpn); RPNquery->attributeSetId = oid_getoidbyent (&bib1); query.which = Z_Query_type_1; query.u.type_1 = RPNquery; - logf (LOG_DEBUG, "CCLRPN"); } #endif else if (!strcmp (obj->set_inher.queryType, "ccl")) { query.which = Z_Query_type_2; query.u.type_2 = &ccl_query; - ccl_query.buf = (unsigned char *) argv[2]; - ccl_query.len = strlen (argv[2]); - logf (LOG_DEBUG, "CCL"); + ccl_query.buf = (unsigned char *) query_str; + ccl_query.len = strlen (query_str); } else { - interp->result = "unknown query method"; - return TCL_ERROR; + Tcl_AppendResult (interp, "invalid query method ", + obj->set_inher.queryType, NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; + } + code = ir_tcl_send_APDU (interp, p, apdu, "search", *argv); + out: +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) + Tcl_DStringFree (&ds); +#endif + return code; +} + +/* + * do_searchResponse: add search response handler + */ +static int do_searchResponse (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc == 0) + { + obj->searchResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->searchResponse); + if (argc == 3) + { + xfree (obj->searchResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &obj->searchResponse, argv[2]) + == TCL_ERROR) + return TCL_ERROR; + } + else + obj->searchResponse = NULL; + } + return TCL_OK; +} + +/* + * do_presentResponse: add present response handler + */ +static int do_presentResponse (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc == 0) + { + obj->presentResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->presentResponse); + if (argc == 3) + { + xfree (obj->presentResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &obj->presentResponse, argv[2]) + == TCL_ERROR) + return TCL_ERROR; + } + else + obj->presentResponse = NULL; + } + return TCL_OK; +} + +/* + * do_sortResponse: add sort response handler + */ +static int do_sortResponse (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc == 0) + { + obj->sortResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->sortResponse); + if (argc == 3) + { + xfree (obj->sortResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &obj->sortResponse, argv[2]) + == TCL_ERROR) + return TCL_ERROR; + } + else + obj->sortResponse = NULL; } - return ir_tcl_send_APDU (interp, p, apdu, "search", argv[0]); + return TCL_OK; } /* * do_resultCount: Get number of hits */ static int do_resultCount (void *o, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { IrTcl_SetObj *obj = o; if (argc <= 0) + { + obj->resultCount = 0; return TCL_OK; - return get_set_int (&obj->resultCount, interp, argc, argv); + } + return ir_tcl_get_set_int (&obj->resultCount, interp, argc, argv); } /* * do_searchStatus: Get search status (after search response) */ static int do_searchStatus (void *o, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { IrTcl_SetObj *obj = o; if (argc <= 0) return TCL_OK; - return get_set_int (&obj->searchStatus, interp, argc, argv); + return ir_tcl_get_set_int (&obj->searchStatus, interp, argc, argv); +} + +static void reset_searchResult (IrTcl_SetObj *setobj) +{ + int i; + for (i = 0; isearchResult_num; i++) + xfree (setobj->searchResult_terms[i]); + xfree (setobj->searchResult_terms); + xfree (setobj->searchResult_count); + setobj->searchResult_terms = 0; + setobj->searchResult_num = 0; +} + + +/* + * do_searchResult Get USR:Search-Result1 (after search response) + */ +static int do_searchResult (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + int i; + + if (argc == 0) + { + obj->searchResult_num = 0; + obj->searchResult_terms = 0; + obj->searchResult_count = 0; + return TCL_OK; + } + else if (argc == -1) + { + reset_searchResult (obj); + return TCL_OK; + } + for (i = 0; isearchResult_num; i++) + { + char str[40]; + sprintf (str, "%d", obj->searchResult_count[i]); + Tcl_AppendResult (interp, "{", NULL); + if (obj->searchResult_terms[i]) + Tcl_AppendElement (interp, obj->searchResult_terms[i]); + else + Tcl_AppendElement (interp, ""); + Tcl_AppendElement (interp, str); + Tcl_AppendResult (interp, "} ", NULL); + } + return TCL_OK; } /* * do_presentStatus: Get search status (after search/present response) */ static int do_presentStatus (void *o, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc <= 0) + return TCL_OK; + return ir_tcl_get_set_int (&obj->presentStatus, interp, argc, argv); +} + +/* + * do_sortStatus: Get sort status (after sort response) + */ +static int do_sortStatus (void *o, Tcl_Interp *interp, + int argc, char **argv) { IrTcl_SetObj *obj = o; + char *res; if (argc <= 0) + { + obj->sortStatus = Z_SortResponse_failure; return TCL_OK; - return get_set_int (&obj->presentStatus, interp, argc, argv); + } + switch (obj->sortStatus) + { + case Z_SortResponse_success: + res = "success"; break; + case Z_SortResponse_partial_1: + res = "partial"; break; + case Z_SortResponse_failure: + res = "failure"; break; + default: + res = "unknown"; break; + } + Tcl_AppendElement (interp, res); + return TCL_OK; } /* @@ -1836,14 +2474,15 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp, obj->nextResultSetPosition = 0; return TCL_OK; } - return get_set_int (&obj->nextResultSetPosition, interp, argc, argv); + return ir_tcl_get_set_int (&obj->nextResultSetPosition, interp, + argc, argv); } /* * do_setName: Set result Set name */ static int do_setName (void *o, Tcl_Interp *interp, - int argc, char **argv) + int argc, char **argv) { IrTcl_SetObj *obj = o; @@ -1853,7 +2492,7 @@ static int do_setName (void *o, Tcl_Interp *interp, return ir_tcl_strdel (interp, &obj->setName); if (argc == 3) { - free (obj->setName); + xfree (obj->setName); if (ir_tcl_strdup (interp, &obj->setName, argv[2]) == TCL_ERROR) return TCL_ERROR; @@ -1875,7 +2514,8 @@ static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp, obj->numberOfRecordsReturned = 0; return TCL_OK; } - return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv); + return ir_tcl_get_set_int (&obj->numberOfRecordsReturned, interp, + argc, argv); } /* @@ -1890,16 +2530,17 @@ static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc == 0) { obj->record_list = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) { delete_IR_records (obj); - return TCL_OK; + return TCL_OK; } if (argc != 3) { - sprintf (interp->result, "wrong # args"); + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position\"", NULL); return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) @@ -1907,7 +2548,7 @@ static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) rl = find_IR_record (obj, offset); if (!rl) { - logf (LOG_DEBUG, "No record at position %d", offset); + logf (LOG_DEBUG, "%s %s %s: no record", argv[0], argv[1], argv[2]); return TCL_OK; } switch (rl->which) @@ -1934,22 +2575,26 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc == 0) { - return TCL_OK; + return TCL_OK; } else if (argc == -1) { - return TCL_OK; + return TCL_OK; } if (argc != 3) { - sprintf (interp->result, "wrong # args"); + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position\"", NULL); return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) return TCL_ERROR; rl = find_IR_record (obj, offset); if (!rl) + { + logf (LOG_DEBUG, "%s %s %s: no record", argv[0], argv[1], argv[2]); return TCL_OK; + } if (rl->which != Z_NamePlusRecord_databaseRecord) { Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL); @@ -1971,18 +2616,19 @@ static int do_recordElements (void *o, Tcl_Interp *interp, if (argc == 0) { obj->recordElements = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) return ir_tcl_strdel (NULL, &obj->recordElements); if (argc > 3) { - sprintf (interp->result, "wrong # args"); + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " ?position?\"", NULL); return TCL_ERROR; } if (argc == 3) { - free (obj->recordElements); + xfree (obj->recordElements); return ir_tcl_strdup (NULL, &obj->recordElements, (*argv[2] ? argv[2] : NULL)); } @@ -2001,7 +2647,6 @@ static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num) for (i = 0; iresult, "wrong # args"); + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position\"", NULL); return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) @@ -2063,7 +2709,8 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_OK; if (argc < 7) { - sprintf (interp->result, "wrong # args"); + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position line|field tag ind field\"", NULL); return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) @@ -2095,7 +2742,8 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_OK; if (argc != 3) { - sprintf (interp->result, "wrong # args"); + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position\"", NULL); return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) @@ -2111,15 +2759,50 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL); return TCL_ERROR; } - if (rl->u.dbrec.type != VAL_SUTRS) + if (!rl->u.dbrec.buf || rl->u.dbrec.type != VAL_SUTRS) return TCL_OK; Tcl_AppendElement (interp, rl->u.dbrec.buf); return TCL_OK; } +/* + * do_getXml: Get XML Record + */ +static int do_getXml (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) + { + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position\"", NULL); + 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.buf || rl->u.dbrec.type != VAL_TEXT_XML) + return TCL_OK; + Tcl_AppendElement (interp, rl->u.dbrec.buf); + return TCL_OK; +} /* - * do_getGrs: Get a GRS1 Record + * do_getGrs: Get a GRS-1 Record */ static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv) { @@ -2131,7 +2814,8 @@ static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_OK; if (argc < 3) { - sprintf (interp->result, "wrong # args"); + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position ?(set,tag) (set,tag) ...?\"", NULL); return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) @@ -2154,6 +2838,55 @@ static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv) /* + * do_getExplain: Get an Explain Record + */ +static int do_getExplain (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + IrTcl_Obj *p = obj->parent; + void *rr; + Z_ext_typeent *etype; + int offset; + IrTcl_RecordList *rl; + + if (argc <= 0) + return TCL_OK; + if (argc < 3) + { + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position ?mask? ...\"", NULL); + 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.buf || rl->u.dbrec.type != VAL_EXPLAIN) + return TCL_OK; + + if (!(etype = z_ext_getentbyref (VAL_EXPLAIN))) + return TCL_OK; + assert (rl->u.dbrec.buf); + odr_setbuf (p->odr_in, rl->u.dbrec.buf, rl->u.dbrec.size, 0); + if (!(*etype->fun)(p->odr_in, (char **) &rr, 0, 0)) + return TCL_OK; + + if (etype->what != Z_External_explainRecord) + return TCL_OK; + + return ir_tcl_get_explain (interp, rr, argc, argv); +} + +/* * do_responseStatus: Return response status (present or search) */ static int do_responseStatus (void *o, Tcl_Interp *interp, @@ -2166,7 +2899,7 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, obj->recordFlag = 0; obj->nonSurrogateDiagnosticNum = 0; obj->nonSurrogateDiagnosticList = NULL; - return TCL_OK; + return TCL_OK; } else if (argc == -1) { @@ -2182,12 +2915,16 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, switch (obj->which) { case Z_Records_DBOSD: - Tcl_AppendElement (interp, "DBOSD"); + Tcl_AppendElement (interp, "DBOSD"); break; case Z_Records_NSD: Tcl_AppendElement (interp, "NSD"); return ir_diagResult (interp, obj->nonSurrogateDiagnosticList, obj->nonSurrogateDiagnosticNum); + case Z_Records_multipleNSD: + Tcl_AppendElement (interp, "NSD"); + return ir_diagResult (interp, obj->nonSurrogateDiagnosticList, + obj->nonSurrogateDiagnosticNum); } return TCL_OK; } @@ -2221,13 +2958,13 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) } else number = 10; + logf (LOG_DEBUG, "present %s %d %d", *argv, start, number); p = obj->parent; if (!p->cs_link) { - interp->result = "present: not connected"; - return TCL_ERROR; + Tcl_AppendResult (interp, "not connected", NULL); + return ir_tcl_error_exec (interp, argc, argv); } - obj->start = start; obj->number = number; @@ -2246,7 +2983,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) struct oident ident; ident.proto = p->protocol_type; - ident.class = CLASS_RECSYN; + ident.oclass = 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, @@ -2269,69 +3006,361 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) } else req->recordComposition = NULL; - return ir_tcl_send_APDU (interp, p, apdu, "present", argv[0]); + return ir_tcl_send_APDU (interp, p, apdu, "present", *argv); } +#define IR_TCL_RECORD_ENCODING_ISO2709 1 +#define IR_TCL_RECORD_ENCODING_RAW 2 + +typedef struct { + int encoding; + int syntax; + size_t size; +} IrTcl_FileRecordHead; + /* * do_loadFile: Load result set from file */ - static int do_loadFile (void *o, Tcl_Interp *interp, int argc, char **argv) { IrTcl_SetObj *setobj = o; FILE *inf; size_t size; - int no = 1; + int offset; + int start = 1; + int number = 30000; char *buf; - + if (argc <= 0) return TCL_OK; - if (argc != 3) + if (argc < 3) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " filename ?start? ?number?\"", NULL); return TCL_ERROR; } + if (argc > 3) + start = atoi (argv[3]); + if (argc > 4) + number = atoi (argv[4]); + offset = start; + inf = fopen (argv[2], "r"); if (!inf) { Tcl_AppendResult (interp, "Cannot open ", argv[2], NULL); - return TCL_ERROR; + return ir_tcl_error_exec (interp, argc, argv); } - while ((buf = ir_tcl_fread_marc (inf, &size))) + while (offset < (start+number)) { + IrTcl_FileRecordHead head; IrTcl_RecordList *rl; - rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord, "F"); - rl->u.dbrec.type = VAL_USMARC; - rl->u.dbrec.buf = buf; - rl->u.dbrec.size = size; - no++; + if (fread (&head, sizeof(head), 1, inf) < 1) + break; + rl = new_IR_record (setobj, offset, + Z_NamePlusRecord_databaseRecord, + (argc > 5) ? argv[5] : NULL); + rl->u.dbrec.type = head.syntax; + if (head.encoding == IR_TCL_RECORD_ENCODING_ISO2709) + { + if (!(buf = ir_tcl_fread_marc (inf, &size))) + break; + rl->u.dbrec.buf = buf; + rl->u.dbrec.size = size; + if (size != head.size) + { + fclose (inf); + Tcl_AppendResult (interp, "bad ISO2709 encoding", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + } + else if (head.encoding == IR_TCL_RECORD_ENCODING_RAW) + { + rl->u.dbrec.size = head.size; + rl->u.dbrec.buf = ir_tcl_malloc (head.size + 1); + if (fread (rl->u.dbrec.buf, rl->u.dbrec.size, 1, inf) < 1) + { + fclose (inf); + Tcl_AppendResult (interp, "bad raw encoding", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + rl->u.dbrec.buf[rl->u.dbrec.size] = '\0'; + } + else + { + rl->u.dbrec.buf = NULL; + rl->u.dbrec.size = 0; + fclose (inf); + Tcl_AppendResult (interp, "bad encoding", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + offset++; } - setobj->numberOfRecordsReturned = no-1; + setobj->numberOfRecordsReturned = offset - start; fclose (inf); return TCL_OK; } +/* + * do_saveFile: Save result set on file + */ +static int do_saveFile (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *setobj = o; + FILE *outf; + int offset; + int start = 1; + int number = 30000; + IrTcl_RecordList *rl; + + if (argc <= 0) + return TCL_OK; + if (argc < 3) + { + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " filename ?start? ?number?\"", NULL); + return TCL_ERROR; + } + if (argc > 3) + start = atoi (argv[3]); + if (argc > 4) + number = atoi (argv[4]); + offset = start; + + outf = fopen (argv[2], "w"); + if (!outf) + { + Tcl_AppendResult (interp, "cannot open file", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + while (offset < (start+number) && (rl = find_IR_record (setobj, offset))) + { + if (rl->which == Z_NamePlusRecord_databaseRecord && + rl->u.dbrec.buf && rl->u.dbrec.size) + { + IrTcl_FileRecordHead head; + + head.encoding = IR_TCL_RECORD_ENCODING_RAW; + head.syntax = rl->u.dbrec.type; + head.size = rl->u.dbrec.size; + if (fwrite (&head, sizeof(head), 1, outf) < 1) + { + Tcl_AppendResult (interp, "cannot write", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + if (fwrite (rl->u.dbrec.buf, rl->u.dbrec.size, 1, outf) < 1) + { + Tcl_AppendResult (interp, "cannot write", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + } + offset++; + } + if (fclose (outf)) + { + Tcl_AppendResult (interp, "cannot write ", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + return TCL_OK; +} + + +/* ------------------------------------------------------- */ +/* + * do_sort: Do sort request + */ +static int do_sort (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + Z_SortRequest *req; + Z_APDU *apdu; + IrTcl_SetObj *obj = o; + IrTcl_Obj *p; + char sort_string[64], sort_flags[64]; + char *arg; + int off; + Z_SortKeySpecList *sksl; + int oid[OID_SIZE]; + oident bib1; + + if (argc <= 0) + return TCL_OK; + + p = obj->parent; + assert (argc > 1); + if (argc != 3) + { + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], "query\"", + NULL); + return TCL_ERROR; + } + logf (LOG_DEBUG, "sort %s %s", *argv, argv[2]); + if (!p->cs_link) + { + Tcl_AppendResult (interp, "not connected", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + apdu = zget_APDU (p->odr_out, Z_APDU_sortRequest); + sksl = (Z_SortKeySpecList *) odr_malloc (p->odr_out, sizeof(*sksl)); + req = apdu->u.sortRequest; + + set_referenceId (p->odr_out, &req->referenceId, + obj->set_inher.referenceId); + +#ifdef ASN_COMPILED + req->num_inputResultSetNames = 1; + req->inputResultSetNames = (Z_InternationalString **) + odr_malloc (p->odr_out, sizeof(*req->inputResultSetNames)); + req->inputResultSetNames[0] = obj->setName; +#else + req->inputResultSetNames = + (Z_StringList *)odr_malloc (p->odr_out, + sizeof(*req->inputResultSetNames)); + req->inputResultSetNames->num_strings = 1; + req->inputResultSetNames->strings = + (char **)odr_malloc (p->odr_out, + sizeof(*req->inputResultSetNames->strings)); + req->inputResultSetNames->strings[0] = obj->setName; +#endif + + req->sortedResultSetName = (char *) obj->setName; + + + req->sortSequence = sksl; + sksl->num_specs = 0; + sksl->specs = (Z_SortKeySpec **) + odr_malloc (p->odr_out, sizeof(sksl->specs) * 20); + + bib1.proto = PROTO_Z3950; + bib1.oclass = CLASS_ATTSET; + bib1.value = VAL_BIB1; + arg = argv[2]; + while ((sscanf (arg, "%63s %63s%n", sort_string, sort_flags, &off)) == 2 + && off > 1) + { + int i; + char *sort_string_sep; + Z_SortKeySpec *sks = (Z_SortKeySpec *) + odr_malloc (p->odr_out, sizeof(*sks)); + Z_SortKey *sk = (Z_SortKey *) + odr_malloc (p->odr_out, sizeof(*sk)); + + arg += off; + sksl->specs[sksl->num_specs++] = sks; + sks->sortElement = (Z_SortElement *) + odr_malloc (p->odr_out, sizeof(*sks->sortElement)); + sks->sortElement->which = Z_SortElement_generic; + sks->sortElement->u.generic = sk; + + if ((sort_string_sep = strchr (sort_string, '='))) + { + Z_AttributeElement *el = (Z_AttributeElement *) + odr_malloc (p->odr_out, sizeof(*el)); + sk->which = Z_SortKey_sortAttributes; + sk->u.sortAttributes = + (Z_SortAttributes *) + odr_malloc (p->odr_out, sizeof(*sk->u.sortAttributes)); + sk->u.sortAttributes->id = oid_ent_to_oid(&bib1, oid); + sk->u.sortAttributes->list = + (Z_AttributeList *) + odr_malloc (p->odr_out, sizeof(*sk->u.sortAttributes->list)); + sk->u.sortAttributes->list->num_attributes = 1; + sk->u.sortAttributes->list->attributes = + (Z_AttributeElement **)odr_malloc (p->odr_out, + sizeof(*sk->u.sortAttributes->list->attributes)); + sk->u.sortAttributes->list->attributes[0] = el; + el->attributeSet = 0; + el->attributeType = (int *) + odr_malloc (p->odr_out, sizeof(*el->attributeType)); + *el->attributeType = atoi (sort_string); + el->which = Z_AttributeValue_numeric; + el->value.numeric = (int *) + odr_malloc (p->odr_out, sizeof(*el->value.numeric)); + *el->value.numeric = atoi (sort_string_sep + 1); + } + else + { + sk->which = Z_SortKey_sortField; + sk->u.sortField = (char *)odr_malloc (p->odr_out, strlen(sort_string)+1); + strcpy (sk->u.sortField, sort_string); + } + sks->sortRelation = (int *) + odr_malloc (p->odr_out, sizeof(*sks->sortRelation)); + *sks->sortRelation = Z_SortKeySpec_ascending; + sks->caseSensitivity = (int *) + odr_malloc (p->odr_out, sizeof(*sks->caseSensitivity)); + *sks->caseSensitivity = Z_SortKeySpec_caseSensitive; + +#ifdef ASN_COMPILED + sks->which = Z_SortKeySpec_null; + sks->u.null = odr_nullval (); +#else + sks->missingValueAction = NULL; +#endif + + for (i = 0; sort_flags[i]; i++) + { + switch (sort_flags[i]) + { + case 'a': + case 'A': + case '>': + *sks->sortRelation = Z_SortKeySpec_descending; + break; + case 'd': + case 'D': + case '<': + *sks->sortRelation = Z_SortKeySpec_ascending; + break; + case 'i': + case 'I': + *sks->caseSensitivity = Z_SortKeySpec_caseInsensitive; + break; + case 'S': + case 's': + *sks->caseSensitivity = Z_SortKeySpec_caseSensitive; + break; + } + } + } + if (!sksl->num_specs) + { + printf ("Missing sort specifications\n"); + return -1; + } + return ir_tcl_send_APDU (interp, p, apdu, "sort", *argv); +} + static IrTcl_Method ir_set_method_tab[] = { - { 0, "search", do_search }, - { 0, "searchStatus", do_searchStatus }, - { 0, "presentStatus", do_presentStatus }, - { 0, "nextResultSetPosition", do_nextResultSetPosition }, - { 0, "setName", do_setName }, - { 0, "resultCount", do_resultCount }, - { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned }, - { 0, "present", do_present }, - { 0, "type", do_type }, - { 0, "getMarc", do_getMarc }, - { 0, "getSutrs", do_getSutrs }, - { 0, "getGrs", do_getGrs }, - { 0, "recordType", do_recordType }, - { 0, "recordElements", do_recordElements }, - { 0, "diag", do_diag }, - { 0, "responseStatus", do_responseStatus }, - { 0, "loadFile", do_loadFile }, - { 0, NULL, NULL} + { "search", do_search, NULL}, + { "searchResponse", do_searchResponse, NULL}, + { "presentResponse", do_presentResponse, NULL}, + { "searchStatus", do_searchStatus, NULL}, + { "presentStatus", do_presentStatus, NULL}, + { "nextResultSetPosition", do_nextResultSetPosition, NULL}, + { "setName", do_setName, NULL}, + { "resultCount", do_resultCount, NULL}, + { "numberOfRecordsReturned", do_numberOfRecordsReturned, NULL}, + { "present", do_present, NULL}, + { "type", do_type, NULL}, + { "getMarc", do_getMarc, NULL}, + { "getSutrs", do_getSutrs, NULL}, + { "getXml", do_getXml, NULL}, + { "getGrs", do_getGrs, NULL}, + { "getExplain", do_getExplain, NULL}, + { "recordType", do_recordType, NULL}, + { "recordElements", do_recordElements, NULL}, + { "diag", do_diag, NULL}, + { "responseStatus", do_responseStatus, NULL}, + { "loadFile", do_loadFile, NULL}, + { "saveFile", do_saveFile, NULL}, + { "sort", do_sort, NULL }, + { "sortResponse", do_sortResponse, NULL}, + { "sortStatus", do_sortStatus, NULL}, + { "searchResult", do_searchResult, NULL}, + { NULL, NULL} }; /* @@ -2341,11 +3370,12 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Methods tabs[3]; - IrTcl_SetObj *p = clientData; + IrTcl_SetObj *p = (IrTcl_SetObj *) clientData; + int r; if (argc < 2) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, " method args...\"", NULL); return TCL_ERROR; } tabs[0].tab = ir_set_method_tab; @@ -2354,7 +3384,9 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, tabs[1].obj = &p->set_inher; tabs[2].tab = NULL; - return ir_method (interp, argc, argv, tabs); + if (ir_tcl_method (interp, argc, argv, tabs, &r) == TCL_ERROR) + return ir_tcl_method_error (interp, argc, argv, tabs); + return r; } /* @@ -2363,7 +3395,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, static void ir_set_obj_delete (ClientData clientData) { IrTcl_Methods tabs[3]; - IrTcl_SetObj *p = clientData; + IrTcl_SetObj *p = (IrTcl_SetObj *) clientData; logf (LOG_DEBUG, "ir set delete"); @@ -2373,54 +3405,53 @@ static void ir_set_obj_delete (ClientData clientData) tabs[1].obj = &p->set_inher; tabs[2].tab = NULL; - ir_method (NULL, -1, NULL, tabs); + ir_tcl_method (NULL, -1, NULL, tabs, NULL); - free (p); + xfree (p); } /* - * ir_set_obj_mk: IR Set Object creation + * ir_set_obj_init: IR Set Object initialization */ -static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv, ClientData *subData, + ClientData parentData) { IrTcl_Methods tabs[3]; IrTcl_SetObj *obj; if (argc < 2 || argc > 3) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, + " objSetName ?objParent?\"", NULL); return TCL_ERROR; } obj = ir_tcl_malloc (sizeof(*obj)); - logf (LOG_DEBUG, "ir set create"); - if (argc == 3) + logf (LOG_DEBUG, "ir set create %s", argv[1]); + if (parentData) { - Tcl_CmdInfo parent_info; int i; IrTcl_SetCObj *dst; IrTcl_SetCObj *src; - if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) - { - interp->result = "No parent"; - return TCL_ERROR; - } - obj->parent = (IrTcl_Obj *) parent_info.clientData; + obj->parent = (IrTcl_Obj *) parentData; dst = &obj->set_inher; src = &obj->parent->set_inher; if ((dst->num_databaseNames = src->num_databaseNames)) + { dst->databaseNames = ir_tcl_malloc (sizeof (*dst->databaseNames) - * dst->num_databaseNames); + * (1+dst->num_databaseNames)); + for (i = 0; i < dst->num_databaseNames; i++) + if (ir_tcl_strdup (interp, &dst->databaseNames[i], + src->databaseNames[i]) == TCL_ERROR) + return TCL_ERROR; + dst->databaseNames[i] = NULL; + } else dst->databaseNames = NULL; - for (i = 0; i < dst->num_databaseNames; i++) - if (ir_tcl_strdup (interp, &dst->databaseNames[i], - src->databaseNames[i]) == TCL_ERROR) - return TCL_ERROR; if (ir_tcl_strdup (interp, &dst->queryType, src->queryType) == TCL_ERROR) return TCL_ERROR; @@ -2461,14 +3492,48 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = obj; tabs[1].tab = NULL; - if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR) return TCL_ERROR; + *subData = (ClientData) obj; + return TCL_OK; +} + +/* + * ir_set_obj_mk: IR Set Object creation + */ +static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + ClientData subData; + ClientData parentData = 0; + int r; + + if (argc == 3) + { + Tcl_CmdInfo parent_info; + if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) + { + Tcl_AppendResult (interp, "no object parent", NULL); + return ir_tcl_error_exec (interp, argc, argv); + } + parentData = parent_info.clientData; + } + r = ir_set_obj_init (clientData, interp, argc, argv, &subData, parentData); + if (r == TCL_ERROR) + return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_set_obj_method, - (ClientData) obj, ir_set_obj_delete); + subData, ir_set_obj_delete); return TCL_OK; } +IrTcl_Class ir_set_obj_class = { + "ir-set", + ir_set_obj_init, + ir_set_obj_method, + ir_set_obj_delete +}; + /* ------------------------------------------------------- */ /* @@ -2480,60 +3545,60 @@ 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; - oident bib1; + char *start_term; + int code; #if CCL2RPN + oident bib1; struct ccl_rpn_node *rpn; int pos; + int r; +#endif +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) + Tcl_DString ds; #endif if (argc <= 0) return TCL_OK; if (argc != 3) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " scanQuery\"", NULL); return TCL_ERROR; } +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) + start_term = Tcl_UtfToExternalDString(0, argv[2], -1, &ds); +#else + start_term = argv[2]; +#endif + logf (LOG_DEBUG, "scan %s %s", *argv, start_term); if (!p->set_inher.num_databaseNames) { - interp->result = "no databaseNames"; - return TCL_ERROR; + Tcl_AppendResult (interp, "no databaseNames", NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; } if (!p->cs_link) { - interp->result = "scan: not connected"; - return TCL_ERROR; + Tcl_AppendResult (interp, "not connected", NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; } - 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, p->protocol_type, + &req->attributeSet, start_term))) { - Tcl_AppendResult (interp, "Syntax error in query", NULL); - return TCL_ERROR; + Tcl_AppendResult (interp, "query syntax error", NULL); + code = ir_tcl_error_exec (interp, argc, argv); + goto out; } -#else - rpn = ccl_find_str(p->bibset, argv[2], &r, &pos); - if (r) - { - Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg (r), NULL); - return TCL_ERROR; - } - ccl_pr_tree (rpn, stderr); - fprintf (stderr, "\n"); - if (!(req->termListAndStartPoint = ccl_scan_query (rpn))) - return TCL_ERROR; -#endif req->stepSize = &obj->stepSize; req->numberOfTermsRequested = &obj->numberOfTermsRequested; req->preferredPositionInResponse = &obj->preferredPositionInResponse; @@ -2543,7 +3608,42 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) logf (LOG_DEBUG, "preferredPositionInResponse=%d", *req->preferredPositionInResponse); - return ir_tcl_send_APDU (interp, p, apdu, "scan", argv[0]); + code = ir_tcl_send_APDU (interp, p, apdu, "scan", *argv); + out: +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) + Tcl_DStringFree (&ds); +#endif + return code; +} + +/* + * do_scanResponse: add scan response handler + */ +static int do_scanResponse (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_ScanObj *obj = o; + + if (argc == 0) + { + obj->scanResponse = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &obj->scanResponse); + if (argc == 3) + { + xfree (obj->scanResponse); + if (argv[2][0]) + { + if (ir_tcl_strdup (interp, &obj->scanResponse, argv[2]) + == TCL_ERROR) + return TCL_ERROR; + } + else + obj->scanResponse = NULL; + } + return TCL_OK; } /* @@ -2558,7 +3658,7 @@ static int do_stepSize (void *obj, Tcl_Interp *interp, p->stepSize = 0; return TCL_OK; } - return get_set_int (&p->stepSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->stepSize, interp, argc, argv); } /* @@ -2574,7 +3674,7 @@ static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp, p->numberOfTermsRequested = 20; return TCL_OK; } - return get_set_int (&p->numberOfTermsRequested, interp, argc, argv); + return ir_tcl_get_set_int (&p->numberOfTermsRequested, interp, argc, argv); } @@ -2591,7 +3691,8 @@ static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp, p->preferredPositionInResponse = 1; return TCL_OK; } - return get_set_int (&p->preferredPositionInResponse, interp, argc, argv); + return ir_tcl_get_set_int (&p->preferredPositionInResponse, interp, + argc, argv); } /* @@ -2604,7 +3705,7 @@ static int do_scanStatus (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->scanStatus, interp, argc, argv); + return ir_tcl_get_set_int (&p->scanStatus, interp, argc, argv); } /* @@ -2617,7 +3718,8 @@ static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv); + return ir_tcl_get_set_int (&p->numberOfEntriesReturned, interp, + argc, argv); } /* @@ -2630,7 +3732,7 @@ static int do_positionOfTerm (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->positionOfTerm, interp, argc, argv); + return ir_tcl_get_set_int (&p->positionOfTerm, interp, argc, argv); } /* @@ -2645,61 +3747,62 @@ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv) if (argc == 0) { p->entries_flag = 0; - p->entries = NULL; - p->nonSurrogateDiagnosticNum = 0; + p->entries = NULL; + p->nonSurrogateDiagnosticNum = 0; p->nonSurrogateDiagnosticList = 0; - return TCL_OK; + return TCL_OK; } else if (argc == -1) { p->entries_flag = 0; - /* release entries */ + /* release entries */ p->entries = NULL; ir_deleteDiags (&p->nonSurrogateDiagnosticList, &p->nonSurrogateDiagnosticNum); - return TCL_OK; + return TCL_OK; } if (argc != 3) { - interp->result = "wrong # args"; - return TCL_ERROR; + Tcl_AppendResult (interp, wrongArgs, *argv, " ", argv[1], + " position\"", NULL); + return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &i) == TCL_ERROR) return TCL_ERROR; - if (!p->entries_flag || p->which != Z_ListEntries_entries || !p->entries - || i >= p->num_entries || i < 0) + if (!p->entries_flag || !p->entries || i >= p->num_entries || i < 0) return TCL_OK; switch (p->entries[i].which) { case Z_Entry_termInfo: Tcl_AppendElement (interp, "T"); - if (p->entries[i].u.term.buf) - Tcl_AppendElement (interp, p->entries[i].u.term.buf); - else - Tcl_AppendElement (interp, ""); - sprintf (numstr, "%d", p->entries[i].u.term.globalOccurrences); - Tcl_AppendElement (interp, numstr); - break; + if (p->entries[i].u.term.buf) + Tcl_AppendElement (interp, p->entries[i].u.term.buf); + else + Tcl_AppendElement (interp, ""); + sprintf (numstr, "%d", p->entries[i].u.term.globalOccurrences); + Tcl_AppendElement (interp, numstr); + break; case Z_Entry_surrogateDiagnostic: Tcl_AppendElement (interp, "SD"); return ir_diagResult (interp, p->entries[i].u.diag.list, p->entries[i].u.diag.num); - break; + break; } return TCL_OK; } static IrTcl_Method ir_scan_method_tab[] = { - { 0, "scan", do_scan }, - { 0, "stepSize", do_stepSize }, - { 0, "numberOfTermsRequested", do_numberOfTermsRequested }, - { 0, "preferredPositionInResponse", do_preferredPositionInResponse }, - { 0, "scanStatus", do_scanStatus }, - { 0, "numberOfEntriesReturned", do_numberOfEntriesReturned }, - { 0, "positionOfTerm", do_positionOfTerm }, - { 0, "scanLine", do_scanLine }, - { 0, NULL, NULL} + { "scan", do_scan, NULL}, + { "scanResponse", do_scanResponse, NULL}, + { "stepSize", do_stepSize, NULL}, + { "numberOfTermsRequested", do_numberOfTermsRequested, NULL}, + { "preferredPositionInResponse", do_preferredPositionInResponse, NULL}, + { "scanStatus", do_scanStatus, NULL}, + { "numberOfEntriesReturned", do_numberOfEntriesReturned, NULL}, + { "positionOfTerm", do_positionOfTerm, NULL}, + { "scanLine", do_scanLine, NULL}, + { NULL, NULL} }; /* @@ -2709,17 +3812,20 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Methods tabs[2]; + int r; if (argc < 2) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, " method args...\"", NULL); return TCL_ERROR; } tabs[0].tab = ir_scan_method_tab; tabs[0].obj = clientData; tabs[1].tab = NULL; - return ir_method (interp, argc, argv, tabs); + if (ir_tcl_method (interp, argc, argv, tabs, &r) == TCL_ERROR) + return ir_tcl_method_error (interp, argc, argv, tabs); + return r; } /* @@ -2728,14 +3834,14 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, static void ir_scan_obj_delete (ClientData clientData) { IrTcl_Methods tabs[2]; - IrTcl_ScanObj *obj = clientData; + IrTcl_ScanObj *obj = (IrTcl_ScanObj *) clientData; tabs[0].tab = ir_scan_method_tab; tabs[0].obj = obj; tabs[1].tab = NULL; - ir_method (NULL, -1, NULL, tabs); - free (obj); + ir_tcl_method (NULL, -1, NULL, tabs, NULL); + xfree (obj); } /* @@ -2750,13 +3856,15 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, if (argc != 3) { - interp->result = "wrong # args"; + Tcl_AppendResult (interp, wrongArgs, *argv, + "objScanName objParentName\"", NULL); return TCL_ERROR; } + logf (LOG_DEBUG, "ir scan create %s", argv[1]); if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) { - interp->result = "No parent"; - return TCL_ERROR; + Tcl_AppendResult (interp, "no object parent", NULL); + return ir_tcl_error_exec (interp, argc, argv); } obj = ir_tcl_malloc (sizeof(*obj)); obj->parent = (IrTcl_Obj *) parent_info.clientData; @@ -2765,7 +3873,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = obj; tabs[1].tab = NULL; - if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR) return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method, (ClientData) obj, ir_scan_obj_delete); @@ -2774,6 +3882,65 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, /* ------------------------------------------------------- */ +/* + * ir_log_init_proc: set yaz log level + */ +static int ir_log_init_proc (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int lev; + if (argc <= 1 || argc > 4) + { + Tcl_AppendResult (interp, wrongArgs, *argv, + " ?level ?prefix ?filename\"", NULL); + return TCL_OK; + } + lev = yaz_log_mask_str (argv[1]); + if (argc == 2) + yaz_log_init (lev, "", NULL); + else if (argc == 3) + yaz_log_init (lev, argv[2], NULL); + else + yaz_log_init (lev, argv[2], argv[3]); + if (lev & LOG_DEBUG) + odr_print_file = yaz_log_file(); + else + odr_print_file = 0; + return TCL_OK; +} + +/* + * ir_log_proc: log yaz message + */ +static int ir_log_proc (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int mask; + if (argc != 3) + { + Tcl_AppendResult (interp, wrongArgs, *argv, + " level string\"", NULL); + return TCL_OK; + } + mask = yaz_log_mask_str_x (argv[1], 0); + logf (LOG_DEBUG, "%s", argv[2]); + return TCL_OK; +} + + +/* + * ir_version: log ir version + */ +static int ir_version (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + Tcl_AppendElement (interp, IR_TCL_VERSION); + Tcl_AppendElement (interp, YAZ_VERSION); + return TCL_OK; +} + + +/* ------------------------------------------------------- */ static void ir_initResponse (void *obj, Z_InitResponse *initrs) { IrTcl_Obj *p = obj; @@ -2786,13 +3953,13 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) get_referenceId (&p->set_inher.referenceId, initrs->referenceId); - free (p->targetImplementationId); + xfree (p->targetImplementationId); ir_tcl_strdup (p->interp, &p->targetImplementationId, initrs->implementationId); - free (p->targetImplementationName); + xfree (p->targetImplementationName); ir_tcl_strdup (p->interp, &p->targetImplementationName, initrs->implementationName); - free (p->targetImplementationVersion); + xfree (p->targetImplementationVersion); ir_tcl_strdup (p->interp, &p->targetImplementationVersion, initrs->implementationVersion); @@ -2802,7 +3969,7 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) memcpy (&p->options, initrs->options, sizeof(initrs->options)); memcpy (&p->protocolVersion, initrs->protocolVersion, sizeof(initrs->protocolVersion)); - free (p->userInformationField); + xfree (p->userInformationField); p->userInformationField = NULL; if (initrs->userInformationField) { @@ -2826,30 +3993,46 @@ 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); + xfree ((*dst_list)[i].addinfo); + xfree (*dst_list); *dst_list = NULL; *dst_num = 0; } static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, - Z_DiagRec **list, int num) + Z_DiagRec **list, int num) { int i; - char *addinfo; + char *addinfo = NULL; *dst_num = num; *dst_list = ir_tcl_malloc (sizeof(**dst_list) * num); for (i = 0; iwhich) { case Z_DiagRec_defaultFormat: (*dst_list)[i].condition = *list[i]->u.defaultFormat->condition; +#ifdef ASN_COMPILED + switch (list[i]->u.defaultFormat->which) + { + case Z_DefaultDiagFormat_v2Addinfo: + addinfo = list[i]->u.defaultFormat->u.v2Addinfo; + break; + case Z_DefaultDiagFormat_v3Addinfo: + addinfo = list[i]->u.defaultFormat->u.v3Addinfo; + break; + } +#else addinfo = list[i]->u.defaultFormat->addinfo; +#endif if (addinfo && ((*dst_list)[i].addinfo = ir_tcl_malloc (strlen(addinfo)+1))) strcpy ((*dst_list)[i].addinfo, addinfo); + cp = diagbib1_str ((*dst_list)[i].condition); + logf (LOG_DEBUG, "Diag %d %s %s", (*dst_list)[i].condition, + cp ? cp : "", addinfo ? addinfo : ""); break; default: (*dst_list)[i].addinfo = NULL; @@ -2858,7 +4041,93 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, } } -static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj, +static void ir_handleDBRecord (IrTcl_Obj *p, IrTcl_RecordList *rl, + Z_External *oe) +{ + struct oident *ident; + Z_ext_typeent *etype; + + logf (LOG_DEBUG, "handleDBRecord size=%d", oe->u.octet_aligned->len); + rl->u.dbrec.size = oe->u.octet_aligned->len; + rl->u.dbrec.buf = NULL; + + if ((ident = oid_getentbyoid (oe->direct_reference))) + rl->u.dbrec.type = ident->value; + else + rl->u.dbrec.type = VAL_USMARC; + + if (ident && (oe->which == Z_External_single || + oe->which == Z_External_octet) + && (etype = z_ext_getentbyref (ident->value))) + { + void *rr; + + odr_setbuf (p->odr_in, (char*) oe->u.octet_aligned->buf, + oe->u.octet_aligned->len, 0); + if (!(*etype->fun)(p->odr_in, (char **) &rr, 0, 0)) + { + rl->u.dbrec.type = VAL_NONE; + return; + } + switch (etype->what) + { + case Z_External_sutrs: + logf (LOG_DEBUG, "Z_External_sutrs"); + oe->u.sutrs = rr; + if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1))) + { + 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; + break; + case Z_External_grs1: + logf (LOG_DEBUG, "Z_External_grs1"); + oe->u.grs1 = rr; + ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1); + break; + case Z_External_explainRecord: + logf (LOG_DEBUG, "Z_External_explainRecord"); + if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size))) + { + memcpy (rl->u.dbrec.buf, oe->u.octet_aligned->buf, + rl->u.dbrec.size); + } + break; + } + } + else + { + if (oe->which == Z_External_octet && rl->u.dbrec.size > 0) + { + char *buf = (char*) oe->u.octet_aligned->buf; + if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size+1))) + { + memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size); + rl->u.dbrec.buf[rl->u.dbrec.size] = '\0'; + } + } + else if (rl->u.dbrec.type == VAL_SUTRS && + oe->which == Z_External_sutrs) + { + if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1))) + { + 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_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1); + } + } +} + +static void ir_handleZRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj, const char *elements) { IrTcl_Obj *p = o; @@ -2873,67 +4142,30 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj, &setobj->nonSurrogateDiagnosticNum); if (zrs->which == Z_Records_DBOSD) { - setobj->numberOfRecordsReturned = - zrs->u.databaseOrSurDiagnostics->num_records; - logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned); - for (offset = 0; offsetnumberOfRecordsReturned; offset++) + int num_rec = zrs->u.databaseOrSurDiagnostics->num_records; + + if (num_rec != setobj->numberOfRecordsReturned) { - rl = new_IR_record (setobj, setobj->start + offset, - zrs->u.databaseOrSurDiagnostics-> - records[offset]->which, - elements); + logf (LOG_WARN, "numberOfRecordsReturned=%d but num records=%d", + setobj->numberOfRecordsReturned, num_rec); + setobj->numberOfRecordsReturned = num_rec; + } + + for (offset = 0; offset < num_rec; offset++) + { + Z_NamePlusRecord *znpr = zrs->u.databaseOrSurDiagnostics-> + records[offset]; + + rl = new_IR_record (setobj, setobj->start + offset, znpr->which, + elements); if (rl->which == Z_NamePlusRecord_surrogateDiagnostic) - { ir_handleDiags (&rl->u.surrogateDiagnostics.list, &rl->u.surrogateDiagnostics.num, - &zrs->u.databaseOrSurDiagnostics-> - records[offset]->u.surrogateDiagnostic, + &znpr->u.surrogateDiagnostic, 1); - } else - { - Z_DatabaseRecord *zr; - Z_External *oe; - struct oident *ident; - - zr = zrs->u.databaseOrSurDiagnostics->records[offset] - ->u.databaseRecord; - oe = (Z_External*) zr; - rl->u.dbrec.size = zr->u.octet_aligned->len; - - 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 = 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 == Z_External_sutrs) - { - odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf, - oe->u.single_ASN1_type->len, 0); - if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1))) - { - 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; - } + ir_handleDBRecord (p, rl, + (Z_External*) (znpr->u.databaseRecord)); } } else if (zrs->which == Z_Records_multipleNSD) @@ -2948,12 +4180,90 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj, } else { +#ifdef ASN_COMPILED + Z_DiagRec dr, *dr_p = &dr; + dr.which = Z_DiagRec_defaultFormat; + dr.u.defaultFormat = zrs->u.nonSurrogateDiagnostic; +#else + Z_DiagRec *dr_p = zrs->u.nonSurrogateDiagnostic; +#endif logf (LOG_DEBUG, "NonSurrogateDiagnostic"); + setobj->numberOfRecordsReturned = 0; ir_handleDiags (&setobj->nonSurrogateDiagnosticList, &setobj->nonSurrogateDiagnosticNum, - &zrs->u.nonSurrogateDiagnostic, - 1); + &dr_p, 1); + } +} + +static char *set_queryExpression (Z_QueryExpression *qe) +{ + char *termz = 0; + if (!qe) + return 0; + if (qe->which == Z_QueryExpression_term) + { + if (qe->u.term->queryTerm) + { + Z_Term *term = qe->u.term->queryTerm; + if (term->which == Z_Term_general) + { + termz = xmalloc (term->u.general->len+1); + memcpy (termz, term->u.general->buf, term->u.general->len); + termz[term->u.general->len] = 0; + } + } + } + return termz; +} + +static void set_searchResult (Z_OtherInformation *o, + IrTcl_SetObj *setobj) +{ + int i; + if (!o) + return ; + for (i = 0; i < o->num_elements; i++) + { + if (o->list[i]->which == Z_OtherInfo_externallyDefinedInfo) + { + ODR odr = odr_createmem (ODR_DECODE); + Z_External *ext = o->list[i]->information.externallyDefinedInfo; + Z_SearchInfoReport *sr = 0; + + if (ext->which == Z_External_single) + { + odr_setbuf (odr, ext->u.single_ASN1_type->buf, + ext->u.single_ASN1_type->len, 0); + z_SearchInfoReport (odr, &sr, 0, "searchInfo"); + } + if (ext->which == Z_External_searchResult1) + sr = ext->u.searchResult1; + if (sr) + { + int j; + reset_searchResult (setobj); + + setobj->searchResult_num = sr->num; + setobj->searchResult_terms = + xmalloc (sr->num * sizeof(*setobj->searchResult_terms)); + setobj->searchResult_count = + xmalloc (sr->num * sizeof(*setobj->searchResult_count)); + + for (j = 0; j < sr->num; j++) + { + setobj->searchResult_terms[j] = + set_queryExpression ( + sr->elements[j]->subqueryExpression); + if (sr->elements[j]->subqueryCount) + setobj->searchResult_count[j] = + *sr->elements[j]->subqueryCount; + else + setobj->searchResult_count[j] = 0; + } + } + odr_destroy (odr); + } } } @@ -2966,18 +4276,21 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs, if (!setobj) { logf (LOG_DEBUG, "Search response, no object!"); - return; + return; } - setobj->searchStatus = searchrs->searchStatus ? 1 : 0; + setobj->searchStatus = *searchrs->searchStatus; get_referenceId (&setobj->set_inher.referenceId, searchrs->referenceId); setobj->resultCount = *searchrs->resultCount; if (searchrs->presentStatus) setobj->presentStatus = *searchrs->presentStatus; + else + setobj->presentStatus = Z_SearchResponse_none; if (searchrs->nextResultSetPosition) setobj->nextResultSetPosition = *searchrs->nextResultSetPosition; - logf (LOG_DEBUG, "Search response %d, %d hits", + logf (LOG_DEBUG, "status %d hits %d", setobj->searchStatus, setobj->resultCount); + set_searchResult (searchrs->additionalSearchInfo, setobj); if (zrs) { const char *es; @@ -2985,10 +4298,14 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs, es = setobj->set_inher.smallSetElementSetNames; else es = setobj->set_inher.mediumSetElementSetNames; - ir_handleRecords (o, zrs, setobj, es); + setobj->numberOfRecordsReturned = *searchrs->numberOfRecordsReturned; + ir_handleZRecords (o, zrs, setobj, es); } else + { + setobj->numberOfRecordsReturned = 0; setobj->recordFlag = 0; + } } @@ -3001,15 +4318,19 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs, if (!setobj) { logf (LOG_DEBUG, "Present response, no object!"); - return; + return; } setobj->presentStatus = *presrs->presentStatus; get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId); setobj->nextResultSetPosition = *presrs->nextResultSetPosition; if (zrs) - ir_handleRecords (o, zrs, setobj, setobj->set_inher.elementSetNames); + { + setobj->numberOfRecordsReturned = *presrs->numberOfRecordsReturned; + ir_handleZRecords (o, zrs, setobj, setobj->set_inher.elementSetNames); + } else { + setobj->numberOfRecordsReturned = 0; setobj->recordFlag = 0; logf (LOG_DEBUG, "No records!"); } @@ -3040,85 +4361,117 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs, scanobj->positionOfTerm = -1; logf (LOG_DEBUG, "positionOfTerm=%d", scanobj->positionOfTerm); - free (scanobj->entries); + xfree (scanobj->entries); scanobj->entries = NULL; - + scanobj->num_entries = 0; + scanobj->entries_flag = 0; + ir_deleteDiags (&scanobj->nonSurrogateDiagnosticList, &scanobj->nonSurrogateDiagnosticNum); if (scanrs->entries) { int i; - Z_Entry *ze; + Z_Entry **ze; scanobj->entries_flag = 1; - scanobj->which = scanrs->entries->which; - switch (scanobj->which) + if (scanrs->entries) { - case Z_ListEntries_entries: - scanobj->num_entries = scanrs->entries->u.entries->num_entries; - scanobj->entries = ir_tcl_malloc (scanobj->num_entries * - sizeof(*scanobj->entries)); - for (i=0; inum_entries; i++) + scanobj->num_entries = scanrs->entries->num_entries; + scanobj->entries = ir_tcl_malloc (scanobj->num_entries * + sizeof(*scanobj->entries)); + ze = scanrs->entries->entries; + } + for (i=0; inum_entries; i++, ze++) + { + scanobj->entries[i].which = (*ze)->which; + switch ((*ze)->which) { - ze = scanrs->entries->u.entries->entries[i]; - scanobj->entries[i].which = ze->which; - switch (ze->which) + case Z_Entry_termInfo: + if ((*ze)->u.termInfo->term->which == Z_Term_general) { - case Z_Entry_termInfo: - if (ze->u.termInfo->term->which == Z_Term_general) - { - int l = ze->u.termInfo->term->u.general->len; - 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); - scanobj->entries[i].u.term.buf[l] = '\0'; - } - else - scanobj->entries[i].u.term.buf = NULL; - if (ze->u.termInfo->globalOccurrences) - scanobj->entries[i].u.term.globalOccurrences = - *ze->u.termInfo->globalOccurrences; - else - scanobj->entries[i].u.term.globalOccurrences = 0; - break; - case Z_Entry_surrogateDiagnostic: - ir_handleDiags (&scanobj->entries[i].u.diag.list, - &scanobj->entries[i].u.diag.num, - &ze->u.surrogateDiagnostic, - 1); - break; + int l = (*ze)->u.termInfo->term->u.general->len; + 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); + scanobj->entries[i].u.term.buf[l] = '\0'; } + else + scanobj->entries[i].u.term.buf = NULL; + if ((*ze)->u.termInfo->globalOccurrences) + scanobj->entries[i].u.term.globalOccurrences = + *(*ze)->u.termInfo->globalOccurrences; + else + scanobj->entries[i].u.term.globalOccurrences = 0; + break; + case Z_Entry_surrogateDiagnostic: + ir_handleDiags (&scanobj->entries[i].u.diag.list, + &scanobj->entries[i].u.diag.num, + &(*ze)->u.surrogateDiagnostic, + 1); + break; } - break; - case Z_ListEntries_nonSurrogateDiagnostics: - ir_handleDiags (&scanobj->nonSurrogateDiagnosticList, - &scanobj->nonSurrogateDiagnosticNum, - scanrs->entries->u.nonSurrogateDiagnostics-> - diagRecs, - scanrs->entries->u.nonSurrogateDiagnostics-> - num_diagRecs); - break; } + if (scanrs->entries->nonsurrogateDiagnostics) + ir_handleDiags (&scanobj->nonSurrogateDiagnosticList, + &scanobj->nonSurrogateDiagnosticNum, + scanrs->entries->nonsurrogateDiagnostics, + scanrs->entries->num_nonsurrogateDiagnostics); } - else - scanobj->entries_flag = 0; +} + + +static void ir_sortResponse (void *o, Z_SortResponse *sortrs, + IrTcl_SetObj *setobj) +{ + IrTcl_Obj *p = o; + + logf (LOG_DEBUG, "Received sortResponse"); + + if (!setobj) + return; + + purge_IR_records (setobj); + + get_referenceId (&p->set_inher.referenceId, sortrs->referenceId); + + setobj->sortStatus = *sortrs->sortStatus; + + ir_deleteDiags (&setobj->nonSurrogateDiagnosticList, + &setobj->nonSurrogateDiagnosticNum); +#ifdef ASN_COMPILED + if (sortrs->diagnostics) + ir_handleDiags (&setobj->nonSurrogateDiagnosticList, + &setobj->nonSurrogateDiagnosticNum, + sortrs->diagnostics, + sortrs->num_diagnostics); +#else + if (sortrs->diagnostics) + ir_handleDiags (&setobj->nonSurrogateDiagnosticList, + &setobj->nonSurrogateDiagnosticNum, + sortrs->diagnostics->diagRecs, + sortrs->diagnostics->num_diagRecs); +#endif } /* * ir_select_read: handle incoming packages */ -void ir_select_read (ClientData clientData) +static void ir_select_read (ClientData clientData) { - IrTcl_Obj *p = clientData; + IrTcl_Obj *p = (IrTcl_Obj *) clientData; Z_APDU *apdu; int r; IrTcl_Request *rq; char *object_name; Tcl_CmdInfo cmd_info; + const char *apdu_call; + int round = 0; + logf(LOG_DEBUG, "Read handler fd=%d", cs_fileno(p->cs_link)); if (p->state == IR_TCL_R_Connecting) { + logf(LOG_DEBUG, "read: connect"); r = cs_rcvconnect (p->cs_link); if (r == 1) { @@ -3126,121 +4479,157 @@ void ir_select_read (ClientData clientData) return; } p->state = IR_TCL_R_Idle; + p->ref_count = 2; ir_select_remove_write (cs_fileno (p->cs_link), p); if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_CONNECT; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); + ir_obj_delete ((ClientData) p); 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_eval (p->interp, p->callback); + if (p->ref_count == 2 && p->cs_link && p->request_queue + && p->state == IR_TCL_R_Idle) ir_tcl_send_q (p, p->request_queue, "x"); + ir_obj_delete ((ClientData) p); 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); + round++; + yaz_log(LOG_DEBUG, "round %d", round); /* read incoming APDU */ - if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 0) + if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) == 1) + { + logf(LOG_DEBUG, "PDU Fraction read"); + return ; + } + /* signal one more use of ir object - callbacks must not + release the ir memory (p pointer) */ + p->ref_count = 2; + if (r <= 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); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_READ; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } - /* release ir object now if callback deleted it */ - ir_obj_delete (p); + /* release ir object now if callback deleted it */ + ir_obj_delete ((ClientData) p); return; } - if (r == 1) - return ; /* got complete APDU. Now decode */ + p->apduLen = r; + p->apduOffset = -1; 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, "cs_get ok, total size %d", r); + if (!z_APDU (p->odr_in, &apdu, 0, 0)) { - logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]); - do_disconnect (p, NULL, 2, NULL); + logf (LOG_DEBUG, "cs_get failed: %s", + odr_errmsg (odr_geterror (p->odr_in))); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_IN_APDU; - IrTcl_eval (p->interp, p->failback); + p->apduOffset = odr_offset (p->odr_in); + ir_tcl_eval (p->interp, p->failback); } - /* release ir object now if failback deleted it */ - ir_obj_delete (p); + /* release ir object now if failback deleted it */ + ir_obj_delete ((ClientData) p); return; } + if (p->odr_pr) + z_APDU(p->odr_pr, &apdu, 0, 0); /* handle APDU and invoke callback */ rq = p->request_queue; - if (!rq) - { - logf (LOG_FATAL, "Internal error. No queue entry"); - exit (1); + if (!rq) + { + /* no corresponding request. Skip it. */ + logf(LOG_DEBUG, "no corresponding request. Skipping it"); + p->state = IR_TCL_R_Idle; + return; } object_name = rq->object_name; - logf (LOG_DEBUG, "getCommandInfo (%s)", object_name); + logf (LOG_DEBUG, "Object %s", object_name); + apdu_call = NULL; if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info)) { switch(apdu->which) { case Z_APDU_initResponse: + p->eventType = "init"; ir_initResponse (p, apdu->u.initResponse); + apdu_call = p->initResponse; break; case Z_APDU_searchResponse: + p->eventType = "search"; ir_searchResponse (p, apdu->u.searchResponse, (IrTcl_SetObj *) cmd_info.clientData); + apdu_call = ((IrTcl_SetObj *) + cmd_info.clientData)->searchResponse; break; case Z_APDU_presentResponse: + p->eventType = "present"; ir_presentResponse (p, apdu->u.presentResponse, (IrTcl_SetObj *) cmd_info.clientData); + apdu_call = ((IrTcl_SetObj *) + cmd_info.clientData)->presentResponse; break; case Z_APDU_scanResponse: + p->eventType = "scan"; ir_scanResponse (p, apdu->u.scanResponse, (IrTcl_ScanObj *) cmd_info.clientData); + apdu_call = ((IrTcl_ScanObj *) + cmd_info.clientData)->scanResponse; break; + case Z_APDU_sortResponse: + p->eventType = "sort"; + ir_sortResponse (p, apdu->u.sortResponse, + (IrTcl_SetObj *) cmd_info.clientData); + apdu_call = ((IrTcl_SetObj *) + cmd_info.clientData)->sortResponse; + break; default: logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); - do_disconnect (p, NULL, 2, NULL); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } return; } } 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); + + if (apdu_call) + ir_tcl_eval (p->interp, apdu_call); + else if (rq->callback) + ir_tcl_eval (p->interp, rq->callback); + xfree (rq->buf_out); + xfree (rq->callback); + xfree (rq->object_name); + xfree (rq); odr_reset (p->odr_in); - if (p->ref_count == 1) - { - ir_obj_delete (p); - return; - } - --(p->ref_count); + if (p->ref_count == 1) + { + ir_obj_delete ((ClientData) p); + return; + } + ir_obj_delete ((ClientData) p); } while (p->cs_link && cs_more (p->cs_link)); if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle) ir_tcl_send_q (p, p->request_queue, "x"); @@ -3249,72 +4638,135 @@ void ir_select_read (ClientData clientData) /* * ir_select_write: handle outgoing packages - not yet written. */ -void ir_select_write (ClientData clientData) +static int ir_select_write (ClientData clientData) { - IrTcl_Obj *p = clientData; + IrTcl_Obj *p = (IrTcl_Obj *) clientData; int r; IrTcl_Request *rq; - logf (LOG_DEBUG, "In write handler"); + logf (LOG_DEBUG, "Write handler fd=%d", cs_fileno(p->cs_link)); if (p->state == IR_TCL_R_Connecting) { + logf(LOG_DEBUG, "write: connect"); r = cs_rcvconnect (p->cs_link); if (r == 1) - return; + { + logf (LOG_DEBUG, "cs_rcvconnect returned 1"); + return 2; + } p->state = IR_TCL_R_Idle; + p->ref_count = 2; + ir_select_remove_write (cs_fileno (p->cs_link), p); if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); - ir_select_remove_write (cs_fileno (p->cs_link), p); + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_CONNECT; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); - return; + ir_obj_delete ((ClientData) p); + return 2; } - ir_select_remove_write (cs_fileno (p->cs_link), p); if (p->callback) - IrTcl_eval (p->interp, p->callback); - return; + ir_tcl_eval (p->interp, p->callback); + ir_obj_delete ((ClientData) p); + return 2; } rq = p->request_queue; + if (!rq || !rq->buf_out) + return 0; assert (rq); if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0) { - logf (LOG_DEBUG, "select write fail"); + logf (LOG_DEBUG, "cs_put write fail"); + p->ref_count = 2; + xfree (rq->buf_out); + rq->buf_out = NULL; + ir_tcl_disconnect (p); if (p->failback) { p->failInfo = IR_TCL_FAIL_WRITE; - IrTcl_eval (p->interp, p->failback); + ir_tcl_eval (p->interp, p->failback); } - free (rq->buf_out); - rq->buf_out = NULL; - do_disconnect (p, NULL, 2, NULL); + ir_obj_delete ((ClientData) p); } else if (r == 0) /* remove select bit */ { + logf (LOG_DEBUG, "Write completed"); p->state = IR_TCL_R_Waiting; ir_select_remove_write (cs_fileno (p->cs_link), p); - free (rq->buf_out); + xfree (rq->buf_out); rq->buf_out = NULL; } + return 1; } -/* ------------------------------------------------------- */ +static void ir_select_notify (ClientData clientData, int r, int w, int e) +{ + if (w) + { + if (!ir_select_write (clientData) && r) + ir_select_read (clientData); + } + else if (r) + { + ir_select_read (clientData); + } +} + +/*----------------------------------------------------------- */ +/* + * DllEntryPoint -- + * + * This wrapper function is used by Windows to invoke the + * initialization code for the DLL. If we are compiling + * with Visual C++, this routine will be renamed to DllMain. + * routine. + * + * Results: + * Returns TRUE; + * + * Side effects: + * None. + */ + +#ifdef __WIN32__ +BOOL APIENTRY +DllEntryPoint(hInst, reason, reserved) + HINSTANCE hInst; /* Library instance handle. */ + DWORD reason; /* Reason this function is being called. */ + LPVOID reserved; /* Not used. */ +{ + return TRUE; +} +#endif +/* ------------------------------------------------------- */ /* * Irtcl_init: Registration of TCL commands. */ -int Irtcl_Init (Tcl_Interp *interp) +EXPORT (int,Irtcl_Init) (Tcl_Interp *interp) { +#if USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } +#endif Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand (interp, "ir-set", ir_set_obj_mk, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand (interp, "ir-log-init", ir_log_init_proc, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand (interp, "ir-log", ir_log_proc, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand (interp, "ir-version", ir_version, (ClientData) NULL, + (Tcl_CmdDeleteProc *) NULL); + nmem_init (); return TCL_OK; }