Added configure.
[ir-tcl-moved-to-github.git] / ir-tcl.c
index 93331e6..1048cf0 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,14 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.101  1997-09-09 10:19:53  adam
+ * Revision 1.103  1997-11-19 11:22:10  adam
+ * Object identifiers can be accessed in GRS-1 records.
+ *
+ * Revision 1.102  1997/09/17 12:22:40  adam
+ * Changed to use YAZ version 1.4. The new comstack utility, cs_straddr,
+ * is used.
+ *
+ * Revision 1.101  1997/09/09 10:19:53  adam
  * New MSV5.0 port with fewer warnings.
  *
  * Revision 1.100  1997/05/01 15:04:05  adam
@@ -500,8 +507,9 @@ int ir_tcl_eval (Tcl_Interp *interp, const char *command)
     r = Tcl_Eval (interp, tmp);
     if (r == TCL_ERROR)
     {
-        logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine, 
-              interp->result);
+       const char *errorInfo = Tcl_GetVar (interp, "errorInfo", 0);
+        logf (LOG_WARN, "Tcl error in line %d: %s\n%s", interp->errorLine, 
+              interp->result, errorInfo ? errorInfo : "<null>");
     }
     Tcl_FreeResult (interp);
     xfree (tmp);
@@ -1173,24 +1181,12 @@ static int do_connect (void *obj, Tcl_Interp *interp,
         if (!strcmp (p->comstackType, "tcpip"))
         {
             p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type);
-            addr = tcpip_strtoaddr (argv[2]);
-            if (!addr)
-            {
-                Tcl_AppendResult (interp, "tcpip_strtoaddr fail", NULL);
-                return ir_tcl_error_exec (interp, argc, argv);
-            }
             logf (LOG_DEBUG, "tcp/ip connect %s", argv[2]);
         }
         else if (!strcmp (p->comstackType, "mosi"))
         {
 #if MOSI
             p->cs_link = cs_create (mosi_type, CS_BLOCK, p->protocol_type);
-            addr = mosi_strtoaddr (argv[2]);
-            if (!addr)
-            {
-                Tcl_AppendResult (interp, "mosi_strtoaddr fail", NULL);
-                return ir_tcl_error_exec (interp, argc, argv);
-            }
             logf (LOG_DEBUG, "mosi connect %s", argv[2]);
 #else
             Tcl_AppendResult (interp, "mosi not supported", NULL);
@@ -1206,6 +1202,13 @@ static int do_connect (void *obj, Tcl_Interp *interp,
         if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
         p->eventType = "connect";
+       addr = cs_straddr (p->cs_link, argv[2]);
+       if (!addr)
+       {
+           ir_tcl_disconnect (p);
+           Tcl_AppendResult (interp, "cs_straddr fail", NULL);
+           return ir_tcl_error_exec (interp, argc, argv);
+       }
         if ((r=cs_connect (p->cs_link, addr)) < 0)
         {
             ir_tcl_disconnect (p);
@@ -3470,7 +3473,7 @@ static int ir_log_proc (ClientData clientData, Tcl_Interp *interp,
         return TCL_OK;
     }
     mask = log_mask_str_x (argv[1], 0);
-    logf (mask, "%s", argv[1], mask, argv[2]);
+    logf (LOG_DEBUG, "%s", argv[2]);
     return TCL_OK;
 }
 
@@ -3658,10 +3661,12 @@ static void ir_handleZRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
                     &setobj->nonSurrogateDiagnosticNum);
     if (zrs->which == Z_Records_DBOSD)
     {
-        setobj->numberOfRecordsReturned = 
-            zrs->u.databaseOrSurDiagnostics->num_records;
-        logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned);
-        for (offset = 0; offset < setobj->numberOfRecordsReturned; offset++)
+       int num_rec = setobj->numberOfRecordsReturned;
+
+       if (num_rec > zrs->u.databaseOrSurDiagnostics->num_records)
+           num_rec = zrs->u.databaseOrSurDiagnostics->num_records;
+        logf (LOG_DEBUG, "Got %d records", num_rec);
+        for (offset = 0; offset < num_rec; offset++)
         {
             Z_NamePlusRecord *znpr = zrs->u.databaseOrSurDiagnostics->
                 records[offset];
@@ -3727,10 +3732,14 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs,
             es = setobj->set_inher.smallSetElementSetNames;
         else 
             es = setobj->set_inher.mediumSetElementSetNames;
+       setobj->numberOfRecordsReturned = *searchrs->numberOfRecordsReturned;
         ir_handleZRecords (o, zrs, setobj, es);
     }
     else
+    {
+       setobj->numberOfRecordsReturned = 0;
         setobj->recordFlag = 0;
+    }
 }
 
 
@@ -3749,9 +3758,13 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs,
     get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId);
     setobj->nextResultSetPosition = *presrs->nextResultSetPosition;
     if (zrs)
+    {
+       setobj->numberOfRecordsReturned = *presrs->numberOfRecordsReturned;
         ir_handleZRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
+    }
     else
     {
+       setobj->numberOfRecordsReturned = 0;
         setobj->recordFlag = 0;
         logf (LOG_DEBUG, "No records!");
     }
@@ -4138,6 +4151,7 @@ EXPORT (int,Irtcl_Init) (Tcl_Interp *interp)
                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand (interp, "ir-log", ir_log_proc,
                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    nmem_init ();
     return TCL_OK;
 }