Event loop in tclmain.c rewritten. New method searchStatus.
[ir-tcl-moved-to-github.git] / ir-tcl.c
index 331dc82..baaf68d 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -1,9 +1,28 @@
 /*
  * IR toolkit for tcl/tk
  * (c) Index Data 1995
+ * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.8  1995-03-15 08:25:16  adam
+ * Revision 1.14  1995-03-20 08:53:22  adam
+ * Event loop in tclmain.c rewritten. New method searchStatus.
+ *
+ * Revision 1.13  1995/03/17  18:26:17  adam
+ * Non-blocking i/o used now. Database names popup as cascade items.
+ *
+ * Revision 1.12  1995/03/17  15:45:00  adam
+ * Improved target/database setup.
+ *
+ * Revision 1.11  1995/03/16  17:54:03  adam
+ * Minor changes really.
+ *
+ * Revision 1.10  1995/03/15  16:14:50  adam
+ * Blocking arg in cs_create changed.
+ *
+ * Revision 1.9  1995/03/15  13:59:24  adam
+ * Minor changes.
+ *
+ * Revision 1.8  1995/03/15  08:25:16  adam
  * New method presentStatus to check for error on present. Misc. cleanup
  * of IRRecordList manipulations. Full MARC record presentation in
  * search.tcl.
@@ -36,6 +55,7 @@
 
 #include <odr.h>
 #include <proto.h>
+#include <diagbib1.h>
 
 #include <tcl.h>
 
@@ -45,7 +65,7 @@ typedef struct {
     COMSTACK cs_link;
 
     int preferredMessageSize;
-    int maximumMessageSize;
+    int maximumRecordSize;
     Odr_bitmask options;
     Odr_bitmask protocolVersion;
     char *idAuthentication;
@@ -60,6 +80,9 @@ typedef struct {
     char *buf_in;
     int  len_in;
 
+    char *sbuf;
+    int  slen;
+
     ODR odr_in;
     ODR odr_out;
     ODR odr_pr;
@@ -97,6 +120,7 @@ typedef struct IRRecordList_ {
 
 typedef struct IRSetObj_ {
     IRObj *parent;
+    int searchStatus;
     int resultCount;
     int start;
     int number;
@@ -286,14 +310,13 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
     Z_APDU apdu, *apdup;
     IRObj *p = obj;
     Z_InitRequest req;
-    char *sbuf;
-    int slen;
+    int r;
 
     req.referenceId = 0;
     req.options = &p->options;
     req.protocolVersion = &p->protocolVersion;
     req.preferredMessageSize = &p->preferredMessageSize;
-    req.maximumRecordSize = &p->maximumMessageSize;
+    req.maximumRecordSize = &p->maximumRecordSize;
 
     req.idAuthentication = p->idAuthentication;
     req.implementationId = p->implementationId;
@@ -312,13 +335,19 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
         odr_reset (p->odr_out);
         return TCL_ERROR;
     }
-    sbuf = odr_getbuf (p->odr_out, &slen);
-    if (cs_put (p->cs_link, sbuf, slen) < 0)
-    {
+    p->sbuf = odr_getbuf (p->odr_out, &p->slen);
+    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
+    {     
         interp->result = "cs_put failed in init";
         return TCL_ERROR;
     }
-    printf("Sent initializeRequest (%d bytes).\n", slen);
+    else if (r == 1)
+    {
+        ir_select_add_write (cs_fileno(p->cs_link), p);
+        printf("Sent part of initializeRequest (%d bytes).\n", p->slen);
+    }
+    else
+        printf("Sent whole initializeRequest (%d bytes).\n", p->slen);
     return TCL_OK;
 }
 
@@ -363,19 +392,19 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
 }
 
 /*
- * do_maximumMessageSize: Set/get maximum message size
+ * do_maximumRecordSize: Set/get maximum record size
  */
-static int do_maximumMessageSize (void *obj, Tcl_Interp *interp,
+static int do_maximumRecordSize (void *obj, Tcl_Interp *interp,
                                     int argc, char **argv)
 {
     char buf[20];
     if (argc == 3)
     {
         if (Tcl_GetInt (interp, argv[2], 
-                        &((IRObj *)obj)->maximumMessageSize)==TCL_ERROR)
+                        &((IRObj *)obj)->maximumRecordSize)==TCL_ERROR)
             return TCL_ERROR;
     }
-    sprintf (buf, "%d", ((IRObj *)obj)->maximumMessageSize);
+    sprintf (buf, "%d", ((IRObj *)obj)->maximumRecordSize);
     Tcl_AppendResult (interp, buf, NULL);
     return TCL_OK;
 }
@@ -526,6 +555,7 @@ static int do_comstack (void *obj, Tcl_Interp *interp,
     char *cs_type = NULL;
     if (argc == 3)
     {
+        cs_close (((IRObj*) obj)->cs_link);
         if (!strcmp (argv[2], "tcpip"))
             ((IRObj *)obj)->cs_link = cs_create (tcpip_type, 0);
         else if (!strcmp (argv[2], "mosi"))
@@ -573,8 +603,9 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp,
 
     if (argc < 3)
     {
-        interp->result = "wrong # args";
-        return TCL_ERROR;
+        for (i=0; i<p->num_databaseNames; i++)
+            Tcl_AppendElement (interp, p->databaseNames[i]);
+        return TCL_OK;
     }
     if (p->databaseNames)
     {
@@ -624,14 +655,14 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
     { 0, "protocolVersion",         do_protocolVersion },
     { 0, "options",                 do_options },
     { 1, "preferredMessageSize",    do_preferredMessageSize },
-    { 1, "maximumMessageSize",      do_maximumMessageSize },
+    { 1, "maximumRecordSize",       do_maximumRecordSize },
     { 1, "implementationName",      do_implementationName },
     { 1, "implementationId",        do_implementationId },
     { 1, "idAuthentication",        do_idAuthentication },
     { 0, "init",                    do_init_request },
     { 0, "disconnect",              do_disconnect },
     { 0, "callback",                do_callback },
-    { 0, "databaseNames",           do_databaseNames},
+    { 1, "databaseNames",           do_databaseNames},
     { 1, "query",                   do_query },
     { 0, NULL, NULL}
     };
@@ -666,7 +697,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
         return TCL_ERROR;
     obj->cs_link = cs_create (tcpip_type, 0);
 
-    obj->maximumMessageSize = 32768;
+    obj->maximumRecordSize = 32768;
     obj->preferredMessageSize = 4096;
 
     obj->idAuthentication = NULL;
@@ -735,8 +766,7 @@ static int do_search (void *o, Tcl_Interp *interp,
     Odr_oct ccl_query;
     IRSetObj *obj = o;
     IRObj *p = obj->parent;
-    char *sbuf;
-    int slen;
+    int r;
 
     p->child = o;
     if (argc != 3)
@@ -802,13 +832,21 @@ static int do_search (void *o, Tcl_Interp *interp,
         odr_reset (p->odr_out);
         return TCL_ERROR;
     } 
-    sbuf = odr_getbuf (p->odr_out, &slen);
-    if (cs_put (p->cs_link, sbuf, slen) < 0)
+    p->sbuf = odr_getbuf (p->odr_out, &p->slen);
+    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
     {
         interp->result = "cs_put failed in init";
         return TCL_ERROR;
     }
-    printf ("Search request\n");
+    else if (r == 1)
+    {
+        ir_select_add_write (cs_fileno(p->cs_link), p);
+        printf("Sent part of searchRequest (%d bytes).\n", p->slen);
+    }
+    else
+    {
+        printf ("Whole search request\n");
+    }
     return TCL_OK;
 }
 
@@ -825,6 +863,18 @@ static int do_resultCount (void *o, Tcl_Interp *interp,
 }
 
 /*
+ * do_searchStatus: Get search status (after search response)
+ */
+static int do_searchStatus (void *o, Tcl_Interp *interp,
+                           int argc, char **argv)
+{
+    IRSetObj *obj = o;
+
+    sprintf (interp->result, "%d", obj->searchStatus);
+    return TCL_OK;
+}
+
+/*
  * do_numberOfRecordsReturned: Get number of records returned
  */
 static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp,
@@ -1020,18 +1070,27 @@ static int do_presentStatus (void *o, Tcl_Interp *interp,
                              int argc, char **argv)
 {
     IRSetObj *obj = o;
+    const char *cp;
     char buf[28];
 
     switch (obj->which)
     {
     case Z_Records_DBOSD:
-       Tcl_AppendResult (interp, "DBOSD", NULL);
+       Tcl_AppendElement (interp, "DBOSD");
         break;
     case Z_Records_NSD:
-        sprintf (buf, "NSD %d", obj->condition);
-        Tcl_AppendResult (interp, buf, " {", 
-                          (obj->addinfo ? obj->addinfo : ""), 
-                          "}", NULL);
+        Tcl_AppendElement (interp, "NSD");
+        sprintf (buf, "%d", obj->condition);
+        Tcl_AppendElement (interp, buf);
+        cp = diagbib1_str (obj->condition);
+        if (cp)
+            Tcl_AppendElement (interp, (char*) cp);
+        else
+            Tcl_AppendElement (interp, "");
+        if (obj->addinfo)
+            Tcl_AppendElement (interp, obj->addinfo);
+        else
+            Tcl_AppendElement (interp, "");
         break;
     }
     return TCL_OK;
@@ -1050,8 +1109,7 @@ static int do_present (void *o, Tcl_Interp *interp,
     Z_PresentRequest req;
     int start;
     int number;
-    char *sbuf;
-    int slen;
+    int r;
 
     if (argc >= 3)
     {
@@ -1087,13 +1145,23 @@ static int do_present (void *o, Tcl_Interp *interp,
         odr_reset (p->odr_out);
         return TCL_ERROR;
     } 
-    sbuf = odr_getbuf (p->odr_out, &slen);
-    if (cs_put (p->cs_link, sbuf, slen) < 0)
+    p->sbuf = odr_getbuf (p->odr_out, &p->slen);
+    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
     {
         interp->result = "cs_put failed in init";
         return TCL_ERROR;
     }
-    printf ("Present request, start=%d, num=%d\n", start, number);
+    else if (r == 1)
+    {
+        ir_select_add_write (cs_fileno(p->cs_link), p);
+        printf ("Part of present request, start=%d, num=%d (%d bytes)\n",
+                start, number, p->slen);
+    }
+    else
+    {
+        printf ("Whole present request, start=%d, num=%d (%d bytes)\n",
+                start, number, p->slen);
+    }
     return TCL_OK;
 }
 
@@ -1146,6 +1214,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
 {
     static IRMethod tab[] = {
     { 0, "search",                  do_search },
+    { 0, "searchStatus",            do_searchStatus },
     { 0, "resultCount",             do_resultCount },
     { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned },
     { 0, "present",                 do_present },
@@ -1208,12 +1277,14 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
     IRSetObj *obj = p->child;
 
     if (obj)
+    {
+        obj->searchStatus = searchrs->searchStatus ? 1 : 0;
         obj->resultCount = *searchrs->resultCount;
-    if (searchrs->searchStatus)
-        printf("Search was a success.\n");
+        printf ("Search response %d, %d hits\n", 
+                 obj->searchStatus, obj->resultCount);
+    }
     else
-        printf("Search was a bloomin' failure.\n");
-    printf("Number of hits: %d\n", *searchrs->resultCount);
+        printf ("Search response, no object!\n");
 }
 
 static void ir_initResponse (void *obj, Z_InitResponse *initrs)
@@ -1228,6 +1299,10 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
         printf("Name   : %s\n", initrs->implementationName);
     if (initrs->implementationVersion)
         printf("Version: %s\n", initrs->implementationVersion);
+    if (initrs->maximumRecordSize)
+        printf ("MaximumRecordSize=%d\n", *initrs->maximumRecordSize);
+    if (initrs->preferredMessageSize)
+        printf ("PreferredMessageSize=%d\n", *initrs->preferredMessageSize);
 #if 0
     if (initrs->userInformationField)
     {
@@ -1315,7 +1390,10 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs)
     }
 }
 
-void ir_select_proc (ClientData clientData)
+/*
+ * ir_select_read: handle incoming packages
+ */
+void ir_select_read (ClientData clientData)
 {
     IRObj *p = clientData;
     Z_APDU *apdu;
@@ -1329,6 +1407,8 @@ void ir_select_proc (ClientData clientData)
             ir_select_remove (cs_fileno (p->cs_link), p);
             return;
         }        
+        if (r == 1)
+            return ;
         odr_setbuf (p->odr_in, p->buf_in, r);
         printf ("cs_get ok, got %d\n", r);
         if (!z_APDU (p->odr_in, &apdu, 0))
@@ -1356,6 +1436,25 @@ void ir_select_proc (ClientData clientData)
     } while (cs_more (p->cs_link));    
 }
 
+/*
+ * ir_select_write: handle outgoing packages - not yet written.
+ */
+void ir_select_write (ClientData clientData)
+{
+    IRObj *p = clientData;
+    int r;
+    
+    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
+    {   
+        printf ("select write fail\n");
+        cs_close (p->cs_link);
+    }
+    else if (r == 0)            /* remove select bit */
+    {
+        ir_select_remove_write (cs_fileno (p->cs_link), p);
+    }
+}
+
 /* ------------------------------------------------------- */
 
 /*
@@ -1369,3 +1468,5 @@ int ir_tcl_init (Tcl_Interp *interp)
                       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
 }
+
+