X-Git-Url: http://lists.indexdata.dk/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=5b0e50e156b371425f32cdec1cf6f0a32d911761;hb=5f25140c3097efe0a53437a1e8f1a59077b732e7;hp=d2c1881247c0fd702c18d10c16c37fc82e2fb3b0;hpb=6b7704f0e063b05c5817dd4dd8d3d4dedea22499;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index d2c1881..5b0e50e 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,16 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.45 1995-06-20 08:07:30 adam + * Revision 1.47 1995-06-25 10:25:04 adam + * Working on triggerResourceControl. Description of compile/install + * procedure moved to ir-tcl.sgml. + * + * Revision 1.46 1995/06/22 13:15:06 adam + * Feature: SUTRS. Setting getSutrs implemented. + * Work on display formats. + * Preferred record syntax can be set by the user. + * + * Revision 1.45 1995/06/20 08:07:30 adam * New setting: failInfo. * Working on better cancel mechanism. * @@ -1146,6 +1155,53 @@ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv) } /* + * do_triggerResourceControl: + */ +static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Obj *p = obj; + Z_APDU *apdu; + Z_TriggerResourceControlRequest *req; + int r; + + if (argc <= 0) + return TCL_OK; + if (!p->cs_link) + { + interp->result = "not connected"; + return TCL_ERROR; + } + apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest); + req = apdu->u.triggerResourceControlRequest; + + if (!z_APDU (p->odr_out, &apdu, 0)) + { + Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)], + NULL); + odr_reset (p->odr_out); + return TCL_ERROR; + } + p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); + if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) + { + interp->result = "cs_put failed in triggerResourceControl"; + do_disconnect (p, NULL, 2, NULL); + return TCL_ERROR; + } + else if (r == 1) + { + ir_select_add_write (cs_fileno(p->cs_link), p); + logf (LOG_DEBUG, "Sent part of triggerResourceControl (%d bytes)", + p->slen); + } + else + logf (LOG_DEBUG, "Sent whole of triggerResourceControl (%d bytes)", + p->slen); + return TCL_OK; +} + +/* * do_databaseNames: specify database names */ static int do_databaseNames (void *obj, Tcl_Interp *interp, @@ -1374,6 +1430,7 @@ static IrTcl_Method ir_method_tab[] = { { 0, "initResult", do_initResult }, { 0, "disconnect", do_disconnect }, { 0, "callback", do_callback }, +{ 0, "triggerResourceControl", do_triggerResourceControl }, { 0, NULL, NULL} }; @@ -1557,6 +1614,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) ident.proto = p->protocol_type; ident.class = CLASS_RECSYN; ident.value = *obj->set_inher.preferredRecordSyntax; + logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value); req->preferredRecordSyntax = odr_oiddup (p->odr_out, oid_getoidbyent (&ident)); } @@ -1903,6 +1961,41 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv) return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv); } +/* + * do_getSutrs: Get SUTRS Record + */ +static int do_getSutrs (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_SUTRS) + return TCL_OK; + Tcl_AppendElement (interp, rl->u.dbrec.buf); + return TCL_OK; +} + /* * do_responseStatus: Return response status (present or search) @@ -1993,7 +2086,19 @@ static int do_present (void *o, Tcl_Interp *interp, req->resultSetStartPoint = &start; req->numberOfRecordsRequested = &number; - req->preferredRecordSyntax = 0; + if (obj->set_inher.preferredRecordSyntax) + { + struct oident ident; + + ident.proto = p->protocol_type; + ident.class = CLASS_RECSYN; + ident.value = *obj->set_inher.preferredRecordSyntax; + logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value); + req->preferredRecordSyntax = odr_oiddup (p->odr_out, + oid_getoidbyent (&ident)); + } + else + req->preferredRecordSyntax = 0; if (!z_APDU (p->odr_out, &apdu, 0)) { @@ -2072,6 +2177,7 @@ static IrTcl_Method ir_set_method_tab[] = { { 0, "present", do_present }, { 0, "type", do_type }, { 0, "getMarc", do_getMarc }, + { 0, "getSutrs", do_getSutrs }, { 0, "recordType", do_recordType }, { 0, "diag", do_diag }, { 0, "responseStatus", do_responseStatus }, @@ -2654,22 +2760,44 @@ static void ir_handleRecords (void *o, Z_Records *zrs) { Z_DatabaseRecord *zr; Odr_external *oe; + struct oident *ident; zr = zrs->u.databaseOrSurDiagnostics->records[offset] ->u.databaseRecord; oe = (Odr_external*) zr; rl->u.dbrec.size = zr->u.octet_aligned->len; + rl->u.dbrec.type = VAL_USMARC; + ident = oid_getentbyoid (oe->direct_reference); + rl->u.dbrec.type = ident->value; + if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0) { - const char *buf = (char*) zr->u.octet_aligned->buf; + char *buf = (char*) zr->u.octet_aligned->buf; if ((rl->u.dbrec.buf = malloc (rl->u.dbrec.size))) memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size); - if (oe->direct_reference) + } + else if (rl->u.dbrec.type == VAL_SUTRS && + oe->which == ODR_EXTERNAL_single) + { + 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 { - struct oident *ident = - oid_getentbyoid (oe->direct_reference); - rl->u.dbrec.type = ident->value; + if ((rl->u.dbrec.buf = 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; } } else