X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=06dc10b6cc41f8aa4fbc422a02d0e3f1dc0ec17c;hb=4ca298d78bdacb8a44057b66fcda06a2c012def4;hp=ab6ef29b13a6d731280b5ddc879e4275a9bb4781;hpb=f25d0ab1672bff45ed845baf786f23aac60ca243;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index ab6ef29..06dc10b 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,33 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.57 1995-09-21 13:11:51 adam + * 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. + * + * Revision 1.63 1995/11/13 09:55:39 adam + * Multiple records at a position in a result-set with differnt + * element specs. + * + * Revision 1.62 1995/10/18 17:20:33 adam + * Work on target setup in client.tcl. + * + * Revision 1.61 1995/10/18 16:42:42 adam + * New settings: smallSetElementSetNames and mediumSetElementSetNames. + * + * Revision 1.60 1995/10/18 15:43:31 adam + * In search: mediumSetElementSetNames and smallSetElementSetNames are + * set to elementSetNames. + * + * Revision 1.59 1995/10/17 12:18:58 adam + * Bug fix: when target connection closed, the connection was not + * properly reestablished. + * + * Revision 1.58 1995/10/16 17:00:55 adam + * New setting: elementSetNames. + * Various client improvements. Medium presentation format looks better. + * + * Revision 1.57 1995/09/21 13:11:51 adam * Support of dynamic loading. * Test script uses load command if necessary. * @@ -226,14 +252,17 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, int argc, char **argv); static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, - int no, int which) + int no, int which, + const char *elements) { IrTcl_RecordList *rl; for (rl = setobj->record_list; rl; rl = rl->next) { - if (no == rl->no) + if (no == rl->no && (!rl->elements || !elements || + !strcmp(elements, rl->elements))) { + free (rl->elements); switch (rl->which) { case Z_NamePlusRecord_databaseRecord: @@ -256,6 +285,7 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, setobj->record_list = rl; } rl->which = which; + ir_tcl_strdup (NULL, &rl->elements, elements); return rl; } @@ -330,7 +360,9 @@ static IrTcl_RecordList *find_IR_record (IrTcl_SetObj *setobj, int no) IrTcl_RecordList *rl; for (rl = setobj->record_list; rl; rl = rl->next) - if (no == rl->no) + if (no == rl->no && + (!setobj->recordElements || !rl->elements || + !strcmp (setobj->recordElements, rl->elements))) return rl; return NULL; } @@ -517,6 +549,8 @@ static int do_init_request (void *obj, Tcl_Interp *interp, Z_IdPass *pass = odr_malloc (p->odr_out, sizeof(*pass)); Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth)); + logf (LOG_DEBUG, "using pass authentication"); + auth->which = Z_IdAuthentication_idPass; auth->u.idPass = pass; if (p->idAuthenticationGroupId && *p->idAuthenticationGroupId) @@ -539,6 +573,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, { Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth)); + logf (LOG_DEBUG, "using open authentication"); auth->which = Z_IdAuthentication_open; auth->u.open = p->idAuthenticationOpen; req->idAuthentication = auth; @@ -852,19 +887,23 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, { if (argc == 3) { - if (ir_tcl_strdup (interp, &p->idAuthenticationOpen, argv[2]) + if (argv[2][0] && + ir_tcl_strdup (interp, &p->idAuthenticationOpen, argv[2]) == TCL_ERROR) return TCL_ERROR; } else if (argc == 5) { - if (ir_tcl_strdup (interp, &p->idAuthenticationGroupId, argv[2]) + if (argv[2][0] && + ir_tcl_strdup (interp, &p->idAuthenticationGroupId, argv[2]) == TCL_ERROR) return TCL_ERROR; - if (ir_tcl_strdup (interp, &p->idAuthenticationUserId, argv[3]) + if (argv[3][0] && + ir_tcl_strdup (interp, &p->idAuthenticationUserId, argv[3]) == TCL_ERROR) return TCL_ERROR; - if (ir_tcl_strdup (interp, &p->idAuthenticationPassword, argv[4]) + if (argv[4][0] && + ir_tcl_strdup (interp, &p->idAuthenticationPassword, argv[4]) == TCL_ERROR) return TCL_ERROR; } @@ -899,6 +938,8 @@ static int do_connect (void *obj, Tcl_Interp *interp, interp->result = "already connected"; return TCL_ERROR; } + if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) + return TCL_ERROR; if (!strcmp (p->cs_type, "tcpip")) { p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type); @@ -932,8 +973,6 @@ static int do_connect (void *obj, Tcl_Interp *interp, p->cs_type, NULL); return TCL_ERROR; } - if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) - return TCL_ERROR; if ((r=cs_connect (p->cs_link, addr)) < 0) { interp->result = "connect fail"; @@ -953,6 +992,8 @@ static int do_connect (void *obj, Tcl_Interp *interp, IrTcl_eval (p->interp, p->callback); } } + else + Tcl_AppendResult (interp, p->hostname, NULL); return TCL_OK; } @@ -978,6 +1019,8 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, ir_select_remove_write (cs_fileno (p->cs_link), p); ir_select_remove (cs_fileno (p->cs_link), p); + odr_reset (p->odr_in); + assert (p->cs_link); cs_close (p->cs_link); p->cs_link = NULL; @@ -1366,6 +1409,84 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp, } +/* + * do_elementSetNames: Set/Get element Set Names + */ +static int do_elementSetNames (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; + + if (argc == 0) + { + p->elementSetNames = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->elementSetNames); + if (argc == 3) + { + free (p->elementSetNames); + if (ir_tcl_strdup (interp, &p->elementSetNames, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->elementSetNames, NULL); + return TCL_OK; +} + +/* + * do_smallSetElementSetNames: Set/Get small Set Element Set Names + */ +static int do_smallSetElementSetNames (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; + + if (argc == 0) + { + p->smallSetElementSetNames = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->smallSetElementSetNames); + if (argc == 3) + { + free (p->smallSetElementSetNames); + if (ir_tcl_strdup (interp, &p->smallSetElementSetNames, + argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->smallSetElementSetNames, NULL); + return TCL_OK; +} + +/* + * do_mediumSetElementSetNames: Set/Get medium Set Element Set Names + */ +static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetCObj *p = obj; + + if (argc == 0) + { + p->mediumSetElementSetNames = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (interp, &p->mediumSetElementSetNames); + if (argc == 3) + { + free (p->mediumSetElementSetNames); + if (ir_tcl_strdup (interp, &p->mediumSetElementSetNames, + argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->mediumSetElementSetNames, NULL); + return TCL_OK; +} + + static IrTcl_Method ir_method_tab[] = { { 1, "comstack", do_comstack }, { 1, "protocol", do_protocol }, @@ -1403,6 +1524,9 @@ static IrTcl_Method ir_set_c_method_tab[] = { { 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} }; @@ -1545,6 +1669,8 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) 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; @@ -1562,8 +1688,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) req->databaseNames = obj->set_inher.databaseNames; for (r=0; r < obj->set_inher.num_databaseNames; r++) logf (LOG_DEBUG, " Database %s", obj->set_inher.databaseNames[r]); - req->smallSetElementSetNames = 0; - req->mediumSetElementSetNames = 0; if (obj->set_inher.preferredRecordSyntax) { struct oident ident; @@ -1577,8 +1701,33 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) } else req->preferredRecordSyntax = 0; - req->query = &query; + if (obj->set_inher.smallSetElementSetNames && + *obj->set_inher.smallSetElementSetNames) + { + Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn)); + + esn->which = Z_ElementSetNames_generic; + esn->u.generic = obj->set_inher.smallSetElementSetNames; + req->smallSetElementSetNames = esn; + } + else + req->smallSetElementSetNames = NULL; + + if (obj->set_inher.mediumSetElementSetNames && + *obj->set_inher.mediumSetElementSetNames) + { + Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn)); + + esn->which = Z_ElementSetNames_generic; + esn->u.generic = obj->set_inher.mediumSetElementSetNames; + req->mediumSetElementSetNames = esn; + } + else + req->mediumSetElementSetNames = NULL; + + req->query = &query; + if (!strcmp (obj->set_inher.queryType, "rpn")) { Z_RPNQuery *RPNquery; @@ -1748,7 +1897,7 @@ static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) delete_IR_records (obj); return TCL_OK; } - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1757,7 +1906,10 @@ static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_ERROR; rl = find_IR_record (obj, offset); if (!rl) + { + logf (LOG_DEBUG, "No record at position %d", offset); return TCL_OK; + } switch (rl->which) { case Z_NamePlusRecord_databaseRecord: @@ -1788,7 +1940,7 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) { return TCL_OK; } - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1809,6 +1961,36 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) } /* + * set record elements (for record extraction) + */ +static int do_recordElements (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_SetObj *obj = o; + + if (argc == 0) + { + obj->recordElements = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_tcl_strdel (NULL, &obj->recordElements); + if (argc > 3) + { + sprintf (interp->result, "wrong # args"); + return TCL_ERROR; + } + if (argc == 3) + { + free (obj->recordElements); + return ir_tcl_strdup (NULL, &obj->recordElements, + (*argv[2] ? argv[2] : NULL)); + } + Tcl_AppendResult (interp, obj->recordElements, NULL); + return TCL_OK; +} + +/* * ir_diagResult */ static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num) @@ -1846,7 +2028,7 @@ static int do_diag (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc <= 0) return TCL_OK; - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1911,7 +2093,7 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc <= 0) return TCL_OK; - if (argc < 3) + if (argc != 3) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -2072,7 +2254,21 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) } else req->preferredRecordSyntax = 0; - + + if (obj->set_inher.elementSetNames && *obj->set_inher.elementSetNames) + { + Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn)); + Z_RecordComposition *compo = odr_malloc (p->odr_out, sizeof(*compo)); + + esn->which = Z_ElementSetNames_generic; + esn->u.generic = obj->set_inher.elementSetNames; + + req->recordComposition = compo; + compo->which = Z_RecordComp_simple; + compo->u.simple = esn; + } + else + req->recordComposition = NULL; return ir_tcl_send_APDU (interp, p, apdu, "present", argv[0]); } @@ -2091,7 +2287,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - if (argc < 3) + if (argc != 3) { interp->result = "wrong # args"; return TCL_ERROR; @@ -2106,7 +2302,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, { IrTcl_RecordList *rl; - rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord); + 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; @@ -2131,6 +2327,7 @@ static IrTcl_Method ir_set_method_tab[] = { { 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 }, @@ -2232,6 +2429,20 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, == TCL_ERROR) return TCL_ERROR; + if (ir_tcl_strdup (interp, &dst->elementSetNames, src->elementSetNames) + == TCL_ERROR) + return TCL_ERROR; + + if (ir_tcl_strdup (interp, &dst->smallSetElementSetNames, + src->smallSetElementSetNames) + == TCL_ERROR) + return TCL_ERROR; + + if (ir_tcl_strdup (interp, &dst->mediumSetElementSetNames, + src->mediumSetElementSetNames) + == TCL_ERROR) + return TCL_ERROR; + if (src->preferredRecordSyntax && (dst->preferredRecordSyntax = ir_tcl_malloc (sizeof(*dst->preferredRecordSyntax)))) @@ -2647,7 +2858,8 @@ 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_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj, + const char *elements) { IrTcl_Obj *p = o; @@ -2668,7 +2880,8 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) { rl = new_IR_record (setobj, setobj->start + offset, zrs->u.databaseOrSurDiagnostics-> - records[offset]->which); + records[offset]->which, + elements); if (rl->which == Z_NamePlusRecord_surrogateDiagnostic) { ir_handleDiags (&rl->u.surrogateDiagnostics.list, @@ -2766,7 +2979,14 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs, logf (LOG_DEBUG, "Search response %d, %d hits", setobj->searchStatus, setobj->resultCount); if (zrs) - ir_handleRecords (o, zrs, setobj); + { + const char *es; + if (setobj->resultCount <= setobj->set_inher.smallSetUpperBound) + es = setobj->set_inher.smallSetElementSetNames; + else + es = setobj->set_inher.mediumSetElementSetNames; + ir_handleRecords (o, zrs, setobj, es); + } else setobj->recordFlag = 0; } @@ -2787,7 +3007,7 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs, get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId); setobj->nextResultSetPosition = *presrs->nextResultSetPosition; if (zrs) - ir_handleRecords (o, zrs, setobj); + ir_handleRecords (o, zrs, setobj, setobj->set_inher.elementSetNames); else { setobj->recordFlag = 0; @@ -2937,13 +3157,12 @@ void ir_select_read (ClientData clientData) { logf (LOG_DEBUG, "cs_get failed, code %d", r); ir_select_remove (cs_fileno (p->cs_link), p); + do_disconnect (p, NULL, 2, NULL); if (p->failback) { p->failInfo = IR_TCL_FAIL_READ; IrTcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); - /* release ir object now if callback deleted it */ ir_obj_delete (p); return; @@ -2956,13 +3175,12 @@ void ir_select_read (ClientData clientData) if (!z_APDU (p->odr_in, &apdu, 0)) { logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]); + do_disconnect (p, NULL, 2, NULL); if (p->failback) { p->failInfo = IR_TCL_FAIL_IN_APDU; IrTcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); - /* release ir object now if failback deleted it */ ir_obj_delete (p); return; @@ -2998,12 +3216,12 @@ void ir_select_read (ClientData clientData) default: logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); + do_disconnect (p, NULL, 2, NULL); if (p->failback) { p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; IrTcl_eval (p->interp, p->failback); } - do_disconnect (p, NULL, 2, NULL); return; } }