X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=be6bba7f02c7ada01e1d6c59d9b5bcdf5eccb3d2;hb=3fa224fe60438ccdc1465d548673d2692467fdee;hp=9d910c9ea1206d954fba443e1eefe877c9e7376d;hpb=6ddbb3991cc5ad6089410078695f574b2bd8388e;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index 9d910c9..be6bba7 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,28 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.52 1995-08-04 11:32:38 adam + * 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. + * + * Revision 1.56 1995/08/29 15:30:14 adam + * Work on GRS records. + * + * Revision 1.55 1995/08/28 09:43:25 adam + * Minor changes. configure only searches for yaz beta 3 and versions after + * that. + * + * Revision 1.54 1995/08/24 12:25:16 adam + * Modified to work with yaz 1.0b3. + * + * Revision 1.53 1995/08/04 12:49:26 adam + * Bug fix: reading uninitialized variable p. + * + * Revision 1.52 1995/08/04 11:32:38 adam * More work on output queue. Memory related routines moved * to mem.c * @@ -204,8 +225,6 @@ typedef struct { IrTcl_Method *tab; } IrTcl_Methods; -static Tcl_Interp *irTcl_interp; - static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num); static int do_disconnect (void *obj, Tcl_Interp *interp, int argc, char **argv); @@ -264,6 +283,7 @@ static struct { { VAL_AUSMARC, "AUSMARC" }, { VAL_IBERMARC, "IBERMARC" }, { VAL_SUTRS, "SUTRS" }, +{ VAL_GRS1, "GRS1" }, { 0, NULL } }; @@ -484,7 +504,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, return TCL_OK; if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "init: not connected"; return TCL_ERROR; } apdu = zget_APDU (p->odr_out, Z_APDU_initRequest); @@ -1047,7 +1067,6 @@ static int do_callback (void *obj, Tcl_Interp *interp, } else p->callback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1077,7 +1096,6 @@ static int do_failback (void *obj, Tcl_Interp *interp, } else p->failback = NULL; - p->interp = interp; } return TCL_OK; } @@ -1134,7 +1152,7 @@ static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, return TCL_OK; if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "triggerResourceControl: not connected"; return TCL_ERROR; } apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest); @@ -1352,6 +1370,32 @@ 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; +} + + static IrTcl_Method ir_method_tab[] = { { 1, "comstack", do_comstack }, { 1, "protocol", do_protocol }, @@ -1389,6 +1433,7 @@ 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, NULL, NULL} }; @@ -1475,6 +1520,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->odr_out = odr_createmem (ODR_ENCODE); obj->odr_pr = odr_createmem (ODR_PRINT); obj->state = IR_TCL_R_Idle; + obj->interp = interp; obj->len_in = 0; obj->buf_in = NULL; @@ -1524,7 +1570,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) } if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "search: not connected"; return TCL_ERROR; } apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest); @@ -1562,6 +1608,18 @@ static int do_search (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)); + + esn->which = Z_ElementSetNames_generic; + esn->u.generic = obj->set_inher.elementSetNames; + req->mediumSetElementSetNames = esn; + } + else + req->mediumSetElementSetNames = NULL; + req->query = &query; if (!strcmp (obj->set_inher.queryType, "rpn")) @@ -1922,6 +1980,41 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv) /* + * do_getGrs: Get a GRS1 Record + */ +static int do_getGrs (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) + { + sprintf (interp->result, "wrong # args"); + 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.type != VAL_GRS1) + return TCL_OK; + return ir_tcl_get_grs (interp, rl->u.dbrec.u.grs1, argc, argv); +} + + +/* * do_responseStatus: Return response status (present or search) */ static int do_responseStatus (void *o, Tcl_Interp *interp, @@ -1964,8 +2057,7 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, * do_present: Perform Present Request */ -static int do_present (void *o, Tcl_Interp *interp, - int argc, char **argv) +static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) { IrTcl_SetObj *obj = o; IrTcl_Obj *p; @@ -1990,12 +2082,12 @@ static int do_present (void *o, Tcl_Interp *interp, } else number = 10; + p = obj->parent; if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "present: not connected"; return TCL_ERROR; } - p = obj->parent; obj->start = start; obj->number = number; @@ -2023,7 +2115,20 @@ static int do_present (void *o, Tcl_Interp *interp, } 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]); } @@ -2080,6 +2185,7 @@ static IrTcl_Method ir_set_method_tab[] = { { 0, "type", do_type }, { 0, "getMarc", do_getMarc }, { 0, "getSutrs", do_getSutrs }, + { 0, "getGrs", do_getGrs }, { 0, "recordType", do_recordType }, { 0, "diag", do_diag }, { 0, "responseStatus", do_responseStatus }, @@ -2164,16 +2270,16 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, dst = &obj->set_inher; src = &obj->parent->set_inher; - dst->num_databaseNames = src->num_databaseNames; - dst->databaseNames = - ir_tcl_malloc (sizeof (*dst->databaseNames) - * dst->num_databaseNames); + if ((dst->num_databaseNames = src->num_databaseNames)) + dst->databaseNames = + ir_tcl_malloc (sizeof (*dst->databaseNames) + * dst->num_databaseNames); + 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; @@ -2182,6 +2288,10 @@ 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 (src->preferredRecordSyntax && (dst->preferredRecordSyntax = ir_tcl_malloc (sizeof(*dst->preferredRecordSyntax)))) @@ -2239,7 +2349,7 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) } if (!p->cs_link) { - interp->result = "not connected"; + interp->result = "scan: not connected"; return TCL_ERROR; } @@ -2630,17 +2740,19 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) else { Z_DatabaseRecord *zr; - Odr_external *oe; + Z_External *oe; struct oident *ident; zr = zrs->u.databaseOrSurDiagnostics->records[offset] ->u.databaseRecord; - oe = (Odr_external*) zr; + oe = (Z_External*) zr; rl->u.dbrec.size = zr->u.octet_aligned->len; - rl->u.dbrec.type = VAL_USMARC; 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; @@ -2648,27 +2760,23 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj) memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size); } else if (rl->u.dbrec.type == VAL_SUTRS && - oe->which == ODR_EXTERNAL_single) + oe->which == Z_External_sutrs) { - Odr_oct *rc; - - logf (LOG_DEBUG, "Decoding SUTRS"); odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf, oe->u.single_ASN1_type->len, 0); - if (!z_SUTRS(p->odr_in, &rc, 0)) - { - logf (LOG_WARN, "Cannot decode SUTRS"); - rl->u.dbrec.buf = NULL; - } - else + if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1))) { - if ((rl->u.dbrec.buf = ir_tcl_malloc (rc->len+1))) - { - memcpy (rl->u.dbrec.buf, rc->buf, rc->len); - rl->u.dbrec.buf[rc->len] = '\0'; - } - rl->u.dbrec.size = rc->len; + 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; @@ -2927,6 +3035,7 @@ void ir_select_read (ClientData clientData) exit (1); } object_name = rq->object_name; + logf (LOG_DEBUG, "getCommandInfo (%s)", object_name); if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info)) { switch(apdu->which) @@ -3038,9 +3147,9 @@ void ir_select_write (ClientData clientData) /* ------------------------------------------------------- */ /* - * ir_tcl_init: Registration of TCL commands. + * Irtcl_init: Registration of TCL commands. */ -int ir_tcl_init (Tcl_Interp *interp) +int Irtcl_Init (Tcl_Interp *interp) { Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); @@ -3048,8 +3157,6 @@ int ir_tcl_init (Tcl_Interp *interp) (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - irTcl_interp = interp; return TCL_OK; } -