X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=ir-tcl.c;h=9b4ee5c20e39476407ab2f9d8f96457f6f809ebb;hb=d026c3e06f6e19e5ed4174ab1a504a4b5af79183;hp=e30cd0d256781c6b29b0f8dbb4e2f5815c4626f4;hpb=fb1ba3e3bdae37307afcf6e69f26d25237a8ea84;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index e30cd0d..9b4ee5c 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -1,10 +1,35 @@ /* * IR toolkit for tcl/tk - * (c) Index Data 1995-2002 + * (c) Index Data 1995-2003 * See the file LICENSE for details. * * $Log: ir-tcl.c,v $ - * Revision 1.120 2002-03-20 14:48:54 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 @@ -457,6 +482,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) { @@ -785,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)); @@ -808,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)); @@ -819,6 +843,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; @@ -1180,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) @@ -1187,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) @@ -1203,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); @@ -1554,7 +1588,7 @@ static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, } 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", @@ -1690,7 +1724,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); @@ -1950,7 +1984,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); } @@ -1987,7 +2025,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; @@ -2399,16 +2442,16 @@ static int do_sortStatus (void *o, Tcl_Interp *interp, if (argc <= 0) { - obj->sortStatus = Z_SortStatus_failure; + obj->sortStatus = Z_SortResponse_failure; return TCL_OK; } switch (obj->sortStatus) { - case Z_SortStatus_success: + case Z_SortResponse_success: res = "success"; break; - case Z_SortStatus_partial_1: + case Z_SortResponse_partial_1: res = "partial"; break; - case Z_SortStatus_failure: + case Z_SortResponse_failure: res = "failure"; break; default: res = "unknown"; break; @@ -2722,6 +2765,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 @@ -3210,10 +3288,10 @@ static int do_sort (void *o, Tcl_Interp *interp, int argc, char **argv) } sks->sortRelation = (int *) odr_malloc (p->odr_out, sizeof(*sks->sortRelation)); - *sks->sortRelation = Z_SortRelation_ascending; + *sks->sortRelation = Z_SortKeySpec_ascending; sks->caseSensitivity = (int *) odr_malloc (p->odr_out, sizeof(*sks->caseSensitivity)); - *sks->caseSensitivity = Z_SortCase_caseSensitive; + *sks->caseSensitivity = Z_SortKeySpec_caseSensitive; #ifdef ASN_COMPILED sks->which = Z_SortKeySpec_null; @@ -3229,20 +3307,20 @@ static int do_sort (void *o, Tcl_Interp *interp, int argc, char **argv) case 'a': case 'A': case '>': - *sks->sortRelation = Z_SortRelation_descending; + *sks->sortRelation = Z_SortKeySpec_descending; break; case 'd': case 'D': case '<': - *sks->sortRelation = Z_SortRelation_ascending; + *sks->sortRelation = Z_SortKeySpec_ascending; break; case 'i': case 'I': - *sks->caseSensitivity = Z_SortCase_caseInsensitive; + *sks->caseSensitivity = Z_SortKeySpec_caseInsensitive; break; case 'S': case 's': - *sks->caseSensitivity = Z_SortCase_caseSensitive; + *sks->caseSensitivity = Z_SortKeySpec_caseSensitive; break; } } @@ -3269,6 +3347,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}, @@ -3512,8 +3591,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) req->num_databaseNames = p->set_inher.num_databaseNames; req->databaseNames = p->set_inher.databaseNames; -#if 1 -/* !CCL2RPN */ if (!(req->termListAndStartPoint = p_query_scan (p->odr_out, p->protocol_type, &req->attributeSet, start_term))) @@ -3522,25 +3599,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) code = ir_tcl_error_exec (interp, argc, argv); goto out; } -#else - rpn = ccl_find_str(p->bibset, start_term, &r, &pos); - if (r) - { - Tcl_AppendResult (interp, "ccl syntax error ", ccl_err_msg(r), NULL); - code = ir_tcl_error_exec (interp, argc, argv); - goto out; - } - bib1.proto = p->protocol_type; - bib1.oclass = CLASS_ATTSET; - bib1.value = VAL_BIB1; - - req->attributeSet = oid_getoidbyent (&bib1); - if (!(req->termListAndStartPoint = ccl_scan_query (p->odr_out, rpn))) - { - code = TCL_ERROR; - goto out; - } -#endif req->stepSize = &obj->stepSize; req->numberOfTermsRequested = &obj->numberOfTermsRequested; req->preferredPositionInResponse = &obj->preferredPositionInResponse; @@ -3830,18 +3888,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; } @@ -4038,8 +4102,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) @@ -4217,7 +4284,7 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs, if (searchrs->presentStatus) setobj->presentStatus = *searchrs->presentStatus; else - setobj->presentStatus = Z_RES_NONE; + setobj->presentStatus = Z_SearchResponse_none; if (searchrs->nextResultSetPosition) setobj->nextResultSetPosition = *searchrs->nextResultSetPosition; @@ -4399,6 +4466,7 @@ static void ir_select_read (ClientData clientData) 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) @@ -4437,6 +4505,8 @@ static void ir_select_read (ClientData clientData) { p->state = IR_TCL_R_Reading; + round++; + yaz_log(LOG_DEBUG, "round %d", round); /* read incoming APDU */ if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) == 1) { @@ -4479,12 +4549,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) - { - 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, "Object %s", object_name); @@ -4675,6 +4749,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,