X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=2e01beb4978aefd5ff17aed1c9416b05565815cc;hb=ed2cf91053cc9e6b59c810215b1b756019641743;hp=be6bba7f02c7ada01e1d6c59d9b5bcdf5eccb3d2;hpb=841680acd268a8d673fbec862e21cd607c787cfa;p=ir-tcl-moved-to-github.git

diff --git a/ir-tcl.c b/ir-tcl.c
index be6bba7..2e01beb 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,21 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.58  1995-10-16 17:00:55  adam
+ * 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.
  *
@@ -903,6 +917,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);
@@ -936,8 +952,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";
@@ -957,6 +971,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;
 }
 
@@ -982,6 +998,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;
@@ -1395,6 +1413,58 @@ static int do_elementSetNames (void *obj, Tcl_Interp *interp,
     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 },
@@ -1434,6 +1504,8 @@ static IrTcl_Method ir_set_c_method_tab[] = {
 { 0, "mediumSetPresentNumber",      do_mediumSetPresentNumber},
 { 0, "referenceId",                 do_referenceId },
 { 0, "elementSetNames",             do_elementSetNames },
+{ 0, "smallSetElementSetNames",     do_smallSetElementSetNames },
+{ 0, "mediumSetElementSetNames",    do_mediumSetElementSetNames },
 { 0, NULL, NULL}
 };
 
@@ -1576,6 +1648,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;
@@ -1593,8 +1667,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;
@@ -1609,19 +1681,32 @@ 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)
+    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->mediumSetElementSetNames = NULL; 
+    
     req->query = &query;
-
+    
     if (!strcmp (obj->set_inher.queryType, "rpn"))
     {
         Z_RPNQuery *RPNquery;
@@ -1800,7 +1885,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:
@@ -2115,6 +2203,7 @@ 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));
@@ -2292,6 +2381,16 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
             == 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))))
@@ -2997,13 +3096,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;
@@ -3016,13 +3114,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;
@@ -3058,12 +3155,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;
             }
         }