X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=ir-tcl.c;h=2d3e9ef6cca0a9f10f1b9af0e0019bb3a5103f0a;hb=f087065f9d65edce52cf5e02b51e97cb70a9c3f5;hp=1cec835263911c7e3cfb3039738e485edac71101;hpb=23633eacc9e900364109a4fd4b4ded8deaa84dc2;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index 1cec835..2d3e9ef 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -4,7 +4,19 @@ * See the file LICENSE for details. * * $Log: ir-tcl.c,v $ - * Revision 1.122 2003-03-05 18:02:08 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 @@ -464,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) { @@ -1705,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); @@ -1965,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); } @@ -2002,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; @@ -2737,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 @@ -3284,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}, @@ -3845,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; } @@ -4053,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) @@ -4497,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); @@ -4695,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,