X-Git-Url: http://git.indexdata.com/?p=ir-tcl-moved-to-github.git;a=blobdiff_plain;f=ir-tcl.c;h=2d3e9ef6cca0a9f10f1b9af0e0019bb3a5103f0a;hp=abe271c47f2ed75de9a129dafda8c9292e47f573;hb=e5bca6e2527eb47c1a44c6d5d61aa3cdfd438bc4;hpb=f4dfdf10de44985020d90581aa426d106dddc542 diff --git a/ir-tcl.c b/ir-tcl.c index abe271c..2d3e9ef 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -4,7 +4,22 @@ * See the file LICENSE for details. * * $Log: ir-tcl.c,v $ - * Revision 1.121 2003-01-30 13:27:07 adam + * 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. * @@ -461,6 +476,7 @@ #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) { @@ -789,7 +805,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)); @@ -812,9 +828,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)); @@ -823,6 +837,8 @@ 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; @@ -1184,6 +1200,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) @@ -1191,6 +1213,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) @@ -1207,7 +1231,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); @@ -1694,7 +1718,7 @@ static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, if (argc <= 0) { - p->largeSetLowerBound = 2; + p->largeSetLowerBound = 1; return TCL_OK; } return ir_tcl_get_set_int (&p->largeSetLowerBound, interp, argc, argv); @@ -1954,7 +1978,11 @@ static void ir_obj_delete (ClientData clientData) ir_tcl_del_q (obj); odr_destroy (obj->odr_in); odr_destroy (obj->odr_out); - odr_destroy (obj->odr_pr); + if (obj->odr_pr) + { + obj->odr_pr->print = 0; + odr_destroy (obj->odr_pr); + } xfree (obj); } @@ -1991,7 +2019,12 @@ int ir_obj_init (ClientData clientData, Tcl_Interp *interp, 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; @@ -2726,6 +2759,41 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) 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 GRS-1 Record @@ -3273,6 +3341,7 @@ static IrTcl_Method ir_set_method_tab[] = { { "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}, @@ -3834,18 +3903,24 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, 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 (yaz_log_mask_str (argv[1]), "", NULL); + yaz_log_init (lev, "", NULL); else if (argc == 3) - yaz_log_init (yaz_log_mask_str (argv[1]), argv[2], NULL); + yaz_log_init (lev, argv[2], NULL); else - yaz_log_init (yaz_log_mask_str (argv[1]), argv[2], argv[3]); + 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; } @@ -4042,8 +4117,11 @@ static void ir_handleDBRecord (IrTcl_Obj *p, IrTcl_RecordList *rl, 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))) + 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) @@ -4486,14 +4564,16 @@ static void ir_select_read (ClientData clientData) 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) - { - /* no corresponding request. Skip it. */ - logf(LOG_DEBUG, "no corresponding request. Skipping it"); + if (!rq) + { + /* no corresponding request. Skip it. */ + logf(LOG_DEBUG, "no corresponding request. Skipping it"); p->state = IR_TCL_R_Idle; - return; + return; } object_name = rq->object_name; logf (LOG_DEBUG, "Object %s", object_name); @@ -4684,6 +4764,11 @@ DllEntryPoint(hInst, reason, reserved) */ 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,