X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=0f056779b1ff28b500c58aeac342859156370718;hb=a48560994cdd4d65473fd26f7aaabf974a8c9f19;hp=36d46f4ec195cdac07e83548431ee0f1f4730d90;hpb=52284820cfaee3773182b71bc96fe2e307d9ee49;p=ir-tcl-moved-to-github.git

diff --git a/ir-tcl.c b/ir-tcl.c
index 36d46f4..0f05677 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,33 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.56  1995-08-29 15:30:14  adam
+ * 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.
+ *
+ * Revision 1.56  1995/08/29  15:30:14  adam
  * Work on GRS records.
  *
  * Revision 1.55  1995/08/28  09:43:25  adam
@@ -222,14 +248,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:
@@ -252,6 +281,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;
 }
 
@@ -326,7 +356,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;
 }
@@ -895,6 +927,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);
@@ -928,8 +962,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";
@@ -949,6 +981,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;
 }
 
@@ -974,6 +1008,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;
@@ -1362,6 +1398,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 },
@@ -1399,6 +1513,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}
 };
 
@@ -1541,6 +1658,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;
@@ -1558,8 +1677,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;
@@ -1573,8 +1690,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.elementSetNames;
+        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.elementSetNames;
+        req->mediumSetElementSetNames = esn;
+    }
+    else
+        req->mediumSetElementSetNames = NULL; 
+    
+    req->query = &query;
+    
     if (!strcmp (obj->set_inher.queryType, "rpn"))
     {
         Z_RPNQuery *RPNquery;
@@ -1744,7 +1886,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;
@@ -1753,7 +1895,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:
@@ -1784,7 +1929,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;
@@ -1805,6 +1950,33 @@ 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 > 2)
+    {
+        sprintf (interp->result, "wrong # args");
+        return TCL_ERROR;
+    }
+    if (argc == 2)
+        return ir_tcl_strdup (NULL, &obj->recordElements, 
+                              (*argv[1] ? argv[1] : NULL));
+    Tcl_AppendResult (interp, obj->recordElements, NULL);
+    return TCL_OK;
+}
+
+/*
  * ir_diagResult 
  */
 static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num)
@@ -1842,7 +2014,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;
@@ -1907,7 +2079,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;
@@ -2068,7 +2240,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]);
 }
 
@@ -2087,7 +2273,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;
@@ -2102,7 +2288,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;
@@ -2127,6 +2313,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 },
@@ -2228,6 +2415,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))))
@@ -2643,7 +2844,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;
 
@@ -2664,7 +2866,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,
@@ -2762,7 +2965,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;
 }
@@ -2783,7 +2993,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;
@@ -2933,13 +3143,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;
@@ -2952,13 +3161,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;
@@ -2994,12 +3202,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;
             }
         }
@@ -3083,9 +3291,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);
@@ -3095,3 +3303,4 @@ int ir_tcl_init (Tcl_Interp *interp)
     		       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
 }
+