New setting: elementSetNames.

[ir-tcl-moved-to-github.git] / ir-tcl.c

diff --git a/ir-tcl.c b/ir-tcl.c
index 86da3b3..be6bba7 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,18 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.55  1995-08-28 09:43:25  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.
  *
@@ -272,6 +283,7 @@ static struct {
 { VAL_AUSMARC,    "AUSMARC" },
 { VAL_IBERMARC,   "IBERMARC" },
 { VAL_SUTRS,      "SUTRS" },
+{ VAL_GRS1,       "GRS1" },
 { 0, NULL }
 };
 
@@ -1358,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 },
@@ -1395,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}
 };
 
@@ -1569,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"))
@@ -1929,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, 
@@ -2029,7 +2115,20 @@ 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]);
 }
 
@@ -2086,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 },
@@ -2188,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))))
@@ -2644,9 +2748,11 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj)
                 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;
@@ -2666,6 +2772,12 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj)
                     }
                     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;
             }
@@ -3035,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);
@@ -3047,3 +3159,4 @@ int ir_tcl_init (Tcl_Interp *interp)
                       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
 }
+