X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=ir-tcl.c;h=f49c97b571a2fd29dae55b7057935e51e57a3aee;hb=a78acc150da77d8c6ef548642dc29622427687a0;hp=8b2cc99b97bd56348ab910a0f0e773b6b8c3cbb8;hpb=902b576840c636b84739391ea9e5415ef4dfae23;p=ir-tcl-moved-to-github.git

diff --git a/ir-tcl.c b/ir-tcl.c
index 8b2cc99..f49c97b 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,31 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.37  1995-06-01 07:31:20  adam
+ * Revision 1.43  1995-06-19 13:06:08  adam
+ * New define: IR_TCL_VERSION.
+ *
+ * Revision 1.42  1995/06/19  08:08:52  adam
+ * client.tcl: hotTargets now contain both database and target name.
+ * ir-tcl.c: setting protocol edited. Errors in callbacks are logged
+ * by logf(LOG_WARN, ...) calls.
+ *
+ * Revision 1.41  1995/06/16  12:28:16  adam
+ * Implemented preferredRecordSyntax.
+ * Minor changes in diagnostic handling.
+ * Record list deleted when connection closes.
+ *
+ * Revision 1.40  1995/06/14  13:37:18  adam
+ * Setting recordType implemented.
+ * Setting implementationVersion implemented.
+ * Settings implementationId / implementationName edited.
+ *
+ * Revision 1.39  1995/06/08  10:26:32  adam
+ * Bug fix in ir_strdup.
+ *
+ * Revision 1.38  1995/06/01  16:36:47  adam
+ * About buttons. Minor bug fixes.
+ *
+ * Revision 1.37  1995/06/01  07:31:20  adam
  * Rename of many typedefs -> IrTcl_...
  *
  * Revision 1.36  1995/05/31  13:09:59  adam
@@ -142,6 +166,9 @@ typedef struct {
     IrTcl_Method *tab;
 } IrTcl_Methods;
 
+static Tcl_Interp *irTcl_interp;
+
+static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num);
 static int do_disconnect (void *obj, Tcl_Interp *interp, 
                           int argc, char **argv);
 
@@ -161,8 +188,8 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj,
 		rl->u.dbrec.buf = NULL;
                 break;
             case Z_NamePlusRecord_surrogateDiagnostic:
-                free (rl->u.diag.addinfo);
-                rl->u.diag.addinfo = NULL;
+                ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
+                                &rl->u.surrogateDiagnostics.num);
                 break;
             }
             break;
@@ -180,6 +207,74 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj,
     return rl;
 }
 
+static struct {
+    enum oid_value value;
+    const char *name;
+} IrTcl_recordSyntaxTab[] = { 
+{ VAL_UNIMARC,    "UNIMARC" },
+{ VAL_INTERMARC,  "INTERMARC" },
+{ VAL_CCF,        "CCF" },
+{ VAL_USMARC,     "USMARC" },
+{ VAL_UKMARC,     "UKMARC" },
+{ VAL_NORMARC,    "NORMARC" },
+{ VAL_LIBRISMARC, "LIBRISMARC" },
+{ VAL_DANMARC,    "DANMARC" },
+{ VAL_FINMARC,    "FINMARC" },
+{ VAL_MAB,        "MAB" },
+{ VAL_CANMARC,    "CANMARC" },
+{ VAL_SBN,        "SBN" },
+{ VAL_PICAMARC,   "PICAMARC" },
+{ VAL_AUSMARC,    "AUSMARC" },
+{ VAL_IBERMARC,   "IBERMARC" },
+{ VAL_SUTRS,      "SUTRS" },
+{ 0, NULL }
+};
+
+/* 
+ * IrTcl_eval
+ */
+int IrTcl_eval (Tcl_Interp *interp, const char *command)
+{
+    char *tmp = malloc (strlen(command)+1);
+    int r;
+
+    if (!tmp)
+    {
+        logf (LOG_FATAL, "Out of memory in IrTcl_eval");
+        exit (1);
+    }
+    strcpy (tmp, command);
+    r = Tcl_Eval (interp, tmp);
+    if (r == TCL_ERROR)
+        logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine, interp->result);
+    free (tmp);
+    return r;
+}
+
+/*
+ * IrTcl_getRecordSyntaxStr: Return record syntax name of object id
+ */
+static const char *IrTcl_getRecordSyntaxStr (enum oid_value value)
+{
+    int i;
+    for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) 
+        if (IrTcl_recordSyntaxTab[i].value == value)
+            return IrTcl_recordSyntaxTab[i].name;
+    return "USMARC";
+}
+
+/*
+ * IrTcl_getRecordSyntaxVal: Return record syntax value of string
+ */
+static enum oid_value IrTcl_getRecordSyntaxVal (const char *name)
+{
+    int i;
+    for (i = 0; IrTcl_recordSyntaxTab[i].name; i++) 
+        if (!strcmp (IrTcl_recordSyntaxTab[i].name, name))
+            return IrTcl_recordSyntaxTab[i].value;
+    return 0;
+}
+
 static IrTcl_RecordList *find_IR_record (IrTcl_SetObj *setobj, int no)
 {
     IrTcl_RecordList *rl;
@@ -202,7 +297,8 @@ static void delete_IR_records (IrTcl_SetObj *setobj)
 	    free (rl->u.dbrec.buf);
             break;
         case Z_NamePlusRecord_surrogateDiagnostic:
-            free (rl->u.diag.addinfo);
+            ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
+                            &rl->u.surrogateDiagnostics.num);
             break;
 	}
 	rl1 = rl->next;
@@ -212,7 +308,7 @@ static void delete_IR_records (IrTcl_SetObj *setobj)
 }
 
 /*
- * getsetint: Set/get integer value
+ * get_set_int: Set/get integer value
  */
 static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
 {
@@ -229,30 +325,6 @@ static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
 }
 
 /*
- * mk_nonSurrogateDiagnostics: Make Tcl result with diagnostic info
- */
-static int mk_nonSurrogateDiagnostics (Tcl_Interp *interp, 
-                                       int condition, const char *addinfo)
-{
-    char buf[20];
-    const char *cp;
-
-    Tcl_AppendElement (interp, "NSD");
-    sprintf (buf, "%d", condition);
-    Tcl_AppendElement (interp, buf);
-    cp = diagbib1_str (condition);
-    if (cp)
-        Tcl_AppendElement (interp, (char*) cp);
-    else
-        Tcl_AppendElement (interp, "");
-    if (addinfo)
-        Tcl_AppendElement (interp, (char*) addinfo);
-    else
-        Tcl_AppendElement (interp, "");
-    return TCL_OK;
-}
-
-/*
  * ir_method: Search for method in table and invoke method handler
  */
 int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
@@ -340,6 +412,11 @@ int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
  */
 int ir_strdup (Tcl_Interp *interp, char** p, const char *s)
 {
+    if (!s)
+    {
+        *p = NULL;
+        return TCL_OK;
+    }
     *p = malloc (strlen(s)+1);
     if (!*p)
     {
@@ -411,9 +488,9 @@ static void get_referenceId (char **dst, Z_ReferenceId *src)
 static int do_init_request (void *obj, Tcl_Interp *interp,
                             int argc, char **argv)
 {
-    Z_APDU apdu, *apdup = &apdu;
+    Z_APDU *apdu;
     IrTcl_Obj *p = obj;
-    Z_InitRequest req;
+    Z_InitRequest *req;
     int r;
 
     if (argc <= 0)
@@ -424,12 +501,14 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
         return TCL_ERROR;
     }
     odr_reset (p->odr_out);
+    apdu = zget_APDU (p->odr_out, Z_APDU_initRequest);
+    req = apdu->u.initRequest;
 
-    set_referenceId (p->odr_out, &req.referenceId, p->set_inher.referenceId);
-    req.options = &p->options;
-    req.protocolVersion = &p->protocolVersion;
-    req.preferredMessageSize = &p->preferredMessageSize;
-    req.maximumRecordSize = &p->maximumRecordSize;
+    set_referenceId (p->odr_out, &req->referenceId, p->set_inher.referenceId);
+    req->options = &p->options;
+    req->protocolVersion = &p->protocolVersion;
+    req->preferredMessageSize = &p->preferredMessageSize;
+    req->maximumRecordSize = &p->maximumRecordSize;
 
     if (p->idAuthenticationGroupId)
     {
@@ -450,27 +529,24 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
             pass->password = p->idAuthenticationPassword;
         else
             pass->password = NULL;
-        req.idAuthentication = auth;
+        req->idAuthentication = auth;
     }
     else if (!p->idAuthenticationOpen || !*p->idAuthenticationOpen)
-        req.idAuthentication = NULL;
+        req->idAuthentication = NULL;
     else
     {
         Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth));
 
         auth->which = Z_IdAuthentication_open;
         auth->u.open = p->idAuthenticationOpen;
-        req.idAuthentication = auth;
+        req->idAuthentication = auth;
     }
-    req.implementationId = p->implementationId;
-    req.implementationName = p->implementationName;
-    req.implementationVersion = "0.1";
-    req.userInformationField = 0;
+    req->implementationId = p->implementationId;
+    req->implementationName = p->implementationName;
+    req->implementationVersion = p->implementationVersion;
+    req->userInformationField = 0;
 
-    apdu.u.initRequest = &req;
-    apdu.which = Z_APDU_initRequest;
-
-    if (!z_APDU (p->odr_out, &apdup, 0))
+    if (!z_APDU (p->odr_out, &apdu, 0))
     {
         Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)],
                           NULL);
@@ -500,13 +576,8 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
                                int argc, char **argv)
 {
-    static struct ir_named_entry version_tab[] = {
-    { "1", 0 },
-    { "2", 1 },
-    { "3", 2 },
-    { "4", 3 },
-    { NULL,0}
-    };
+    int version, i;
+    char buf[10];
     IrTcl_Obj *p = obj;
 
     if (argc <= 0)
@@ -516,8 +587,20 @@ static int do_protocolVersion (void *obj, Tcl_Interp *interp,
 	ODR_MASK_SET (&p->protocolVersion, 1);
         return TCL_OK;
     }
-    return ir_named_bits (version_tab, &p->protocolVersion,
-                          interp, argc-2, argv+2);
+    if (argc == 3)
+    {
+        if (Tcl_GetInt (interp, argv[2], &version)==TCL_ERROR)
+            return TCL_ERROR;
+        ODR_MASK_ZERO (&p->protocolVersion);
+        for (i = 0; i<version; i++)
+            ODR_MASK_SET (&p->protocolVersion, i);
+    }
+    for (i = 4; --i >= 0; )
+        if (ODR_MASK_GET (&p->protocolVersion, i))
+            break;
+    sprintf (buf, "%d", i+1);
+    interp->result = buf;
+    return TCL_OK;
 }
 
 /*
@@ -536,7 +619,7 @@ static int do_options (void *obj, Tcl_Interp *interp,
     { "accessCtrl", 6},
     { "scan", 7},
     { "sort", 8},
-    { "extentedServices", 10},
+    { "extendedServices", 10},
     { "level-1Segmentation", 11},
     { "level-2Segmentation", 12},
     { "concurrentOperations", 13},
@@ -567,7 +650,7 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
     {
-        p->preferredMessageSize = 4096;
+        p->preferredMessageSize = 30000;
 	return TCL_OK;
     }
     return get_set_int (&p->preferredMessageSize, interp, argc, argv);
@@ -583,7 +666,7 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
     {
-        p->maximumRecordSize = 32768;
+        p->maximumRecordSize = 30000;
 	return TCL_OK;
     }
     return get_set_int (&p->maximumRecordSize, interp, argc, argv);
@@ -612,7 +695,8 @@ static int do_implementationName (void *obj, Tcl_Interp *interp,
     IrTcl_Obj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->implementationName, "TCL/TK on YAZ");
+        return ir_strdup (interp, &p->implementationName,
+                          "Index Data/IrTcl on YAZ");
     else if (argc == -1)
         return ir_strdel (interp, &p->implementationName);
     if (argc == 3)
@@ -627,7 +711,7 @@ static int do_implementationName (void *obj, Tcl_Interp *interp,
 }
 
 /*
- * do_implementationId: Set/get Implementation Id.
+ * do_implementationId: Get Implementation Id.
  */
 static int do_implementationId (void *obj, Tcl_Interp *interp,
                                 int argc, char **argv)
@@ -635,20 +719,31 @@ static int do_implementationId (void *obj, Tcl_Interp *interp,
     IrTcl_Obj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->implementationId, "81");
+        return ir_strdup (interp, &p->implementationId, "YAZ (id=81)");
     else if (argc == -1)
         return ir_strdel (interp, &p->implementationId);
-    if (argc == 3)
-    {
-        free (p->implementationId);
-        if (ir_strdup (interp, &p->implementationId, argv[2]) == TCL_ERROR)
-            return TCL_ERROR;
-    }
     Tcl_AppendResult (interp, p->implementationId, (char*) NULL);
     return TCL_OK;
 }
 
 /*
+ * do_implementationVersion: get Implementation Version.
+ */
+static int do_implementationVersion (void *obj, Tcl_Interp *interp,
+                                     int argc, char **argv)
+{
+    IrTcl_Obj *p = obj;
+
+    if (argc == 0)
+        return ir_strdup (interp, &p->implementationVersion, 
+                          "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
+    else if (argc == -1)
+        return ir_strdel (interp, &p->implementationVersion);
+    Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
+    return TCL_OK;
+}
+
+/*
  * do_targetImplementationName: Get Implementation Name of target.
  */
 static int do_targetImplementationName (void *obj, Tcl_Interp *interp,
@@ -770,7 +865,6 @@ static int do_connect (void *obj, Tcl_Interp *interp,
     void *addr;
     IrTcl_Obj *p = obj;
     int r;
-    int protocol_type = PROTO_Z3950;
 
     if (argc <= 0)
         return TCL_OK;
@@ -781,18 +875,9 @@ static int do_connect (void *obj, Tcl_Interp *interp,
             interp->result = "already connected";
             return TCL_ERROR;
         }
-        if (!strcmp (p->protocol_type, "Z3950"))
-            protocol_type = PROTO_Z3950;
-        else if (!strcmp (p->protocol_type, "SR"))
-            protocol_type = PROTO_SR;
-        else
-        {
-            interp->result = "bad protocol type";
-            return TCL_ERROR;
-        }
         if (!strcmp (p->cs_type, "tcpip"))
         {
-            p->cs_link = cs_create (tcpip_type, CS_BLOCK, protocol_type);
+            p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type);
             addr = tcpip_strtoaddr (argv[2]);
             if (!addr)
             {
@@ -801,10 +886,10 @@ static int do_connect (void *obj, Tcl_Interp *interp,
             }
             logf (LOG_DEBUG, "tcp/ip connect %s", argv[2]);
         }
-#if MOSI
         else if (!strcmp (p->cs_type, "mosi"))
         {
-            p->cs_link = cs_create (mosi_type, CS_BLOCK, protocol_type);
+#if MOSI
+            p->cs_link = cs_create (mosi_type, CS_BLOCK, p->protocol_type);
             addr = mosi_strtoaddr (argv[2]);
             if (!addr)
             {
@@ -812,18 +897,22 @@ static int do_connect (void *obj, Tcl_Interp *interp,
                 return TCL_ERROR;
             }
             logf (LOG_DEBUG, "mosi connect %s", argv[2]);
-        }
+#else
+            interp->result = "MOSI support not there";
+            return TCL_ERROR;
 #endif
+        }
         else 
         {
-            interp->result = "unknown comstack type";
+            Tcl_AppendResult (interp, "Bad comstack type: ", 
+                              p->cs_type, NULL);
             return TCL_ERROR;
         }
         if (ir_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
         if ((r=cs_connect (p->cs_link, addr)) < 0)
         {
-            interp->result = "cs_connect fail";
+            interp->result = "connect fail";
             do_disconnect (p, NULL, 2, NULL);
             return TCL_ERROR;
         }
@@ -837,7 +926,7 @@ static int do_connect (void *obj, Tcl_Interp *interp,
         {
             p->connectFlag = 0;
             if (p->callback)
-                Tcl_Eval (p->interp, p->callback);
+                IrTcl_eval (p->interp, p->callback);
         }
     }
     if (p->hostname)
@@ -870,6 +959,16 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
         assert (p->cs_link);
         cs_close (p->cs_link);
         p->cs_link = NULL;
+
+        ODR_MASK_ZERO (&p->options);
+	ODR_MASK_SET (&p->options, 0);
+	ODR_MASK_SET (&p->options, 1);
+	ODR_MASK_SET (&p->options, 7);
+	ODR_MASK_SET (&p->options, 14);
+
+        ODR_MASK_ZERO (&p->protocolVersion);
+	ODR_MASK_SET (&p->protocolVersion, 0);
+	ODR_MASK_SET (&p->protocolVersion, 1);
     }
     assert (!p->cs_link);
     return TCL_OK;
@@ -897,27 +996,6 @@ static int do_comstack (void *o, Tcl_Interp *interp,
     return TCL_OK;
 }
 
-/*
- * do_protocol: Set/get protocol method on IR object
- */
-static int do_protocol (void *o, Tcl_Interp *interp,
-		        int argc, char **argv)
-{
-    IrTcl_Obj *obj = o;
-
-    if (argc == 0)
-        return ir_strdup (interp, &obj->protocol_type, "Z3950");
-    else if (argc == -1)
-        return ir_strdel (interp, &obj->protocol_type);
-    else if (argc == 3)
-    {
-        free (obj->protocol_type);
-        if (ir_strdup (interp, &obj->protocol_type, argv[2]) == TCL_ERROR)
-            return TCL_ERROR;
-    }
-    Tcl_AppendElement (interp, obj->protocol_type);
-    return TCL_OK;
-}
 
 /*
  * do_callback: add callback
@@ -944,7 +1022,7 @@ static int do_callback (void *obj, Tcl_Interp *interp,
 	}
 	else
 	    p->callback = NULL;
-        p->interp = interp;
+        p->interp = irTcl_interp;
     }
     return TCL_OK;
 }
@@ -974,7 +1052,44 @@ static int do_failback (void *obj, Tcl_Interp *interp,
 	}
 	else
 	    p->failback = NULL;
-        p->interp = interp;
+        p->interp = irTcl_interp;
+    }
+    return TCL_OK;
+}
+
+/*
+ * do_protocol: Set/get protocol method on IR object
+ */
+static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_Obj *p = o;
+
+    if (argc <= 0)
+    {
+        p->protocol_type = PROTO_Z3950;
+        return TCL_OK;
+    }
+    else if (argc == 3)
+    {
+        if (!strcmp (argv[2], "Z39"))
+            p->protocol_type = PROTO_Z3950;
+        else if (!strcmp (argv[2], "SR"))
+            p->protocol_type = PROTO_SR;
+        else
+        {
+            Tcl_AppendResult (interp, "Bad protocol: ", argv[2], NULL);
+            return TCL_ERROR;
+        }
+        return TCL_OK;
+    }
+    switch (p->protocol_type)
+    {
+    case PROTO_Z3950:
+        Tcl_AppendElement (interp, "Z39");
+        break;
+    case PROTO_SR:
+        Tcl_AppendElement (interp, "SR");
+        break;
     }
     return TCL_OK;
 }
@@ -983,7 +1098,7 @@ static int do_failback (void *obj, Tcl_Interp *interp,
  * do_databaseNames: specify database names
  */
 static int do_databaseNames (void *obj, Tcl_Interp *interp,
-                          int argc, char **argv)
+                             int argc, char **argv)
 {
     int i;
     IrTcl_SetCObj *p = obj;
@@ -1139,7 +1254,10 @@ static int do_referenceId (void *obj, Tcl_Interp *interp,
     IrTcl_SetCObj *p = obj;
 
     if (argc == 0)
+    {
         p->referenceId = NULL;
+        return TCL_OK;
+    }
     else if (argc == -1)
         return ir_strdel (interp, &p->referenceId);
     if (argc == 3)
@@ -1152,6 +1270,36 @@ static int do_referenceId (void *obj, Tcl_Interp *interp,
     return TCL_OK;
 }
 
+/*
+ * do_preferredRecordSyntax: Set/get preferred record syntax
+ */
+static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp,
+                                     int argc, char **argv)
+{
+    IrTcl_SetCObj *p = obj;
+
+    if (argc == 0)
+    {
+        p->preferredRecordSyntax = NULL;
+        return TCL_OK;
+    }
+    else if (argc == -1)
+    {
+        free (p->preferredRecordSyntax);
+        p->preferredRecordSyntax = NULL;
+        return TCL_OK;
+    }
+    if (argc == 3)
+    {
+        free (p->preferredRecordSyntax);
+        p->preferredRecordSyntax = NULL;
+        if (argv[2][0] && (p->preferredRecordSyntax = 
+                           malloc (sizeof(*p->preferredRecordSyntax))))
+            *p->preferredRecordSyntax = IrTcl_getRecordSyntaxVal (argv[2]);
+    }
+    return TCL_OK;
+            
+}
 static IrTcl_Method ir_method_tab[] = {
 { 1, "comstack",                    do_comstack },
 { 1, "protocol",                    do_protocol },
@@ -1163,6 +1311,7 @@ static IrTcl_Method ir_method_tab[] = {
 { 1, "maximumRecordSize",           do_maximumRecordSize },
 { 1, "implementationName",          do_implementationName },
 { 1, "implementationId",            do_implementationId },
+{ 1, "implementationVersion",       do_implementationVersion },
 { 0, "targetImplementationName",    do_targetImplementationName },
 { 0, "targetImplementationId",      do_targetImplementationId },
 { 0, "targetImplementationVersion", do_targetImplementationVersion },
@@ -1180,6 +1329,7 @@ static IrTcl_Method ir_set_c_method_tab[] = {
 { 0, "databaseNames",               do_databaseNames},
 { 0, "replaceIndicator",            do_replaceIndicator},
 { 0, "queryType",                   do_queryType },
+{ 0, "preferredRecordSyntax",       do_preferredRecordSyntax },
 { 0, "smallSetUpperBound",          do_smallSetUpperBound},
 { 0, "largeSetLowerBound",          do_largeSetLowerBound},
 { 0, "mediumSetPresentNumber",      do_mediumSetPresentNumber},
@@ -1295,12 +1445,11 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
 /*
  * do_search: Do search request
  */
-static int do_search (void *o, Tcl_Interp *interp,
-		       int argc, char **argv)
+static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
-    Z_SearchRequest req;
+    Z_SearchRequest *req;
     Z_Query query;
-    Z_APDU apdu, *apdup = &apdu;
+    Z_APDU *apdu;
     Odr_oct ccl_query;
     IrTcl_SetObj *obj = o;
     IrTcl_Obj *p = obj->parent;
@@ -1327,29 +1476,41 @@ static int do_search (void *o, Tcl_Interp *interp,
         return TCL_ERROR;
     }
     odr_reset (p->odr_out);
-    apdu.which = Z_APDU_searchRequest;
-    apdu.u.searchRequest = &req;
-    
-    bib1.proto = PROTO_Z3950;
+    apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest);
+    req = apdu->u.searchRequest;
+
+    bib1.proto = p->protocol_type;
     bib1.class = CLASS_ATTSET;
     bib1.value = VAL_BIB1;
 
-    set_referenceId (p->odr_out, &req.referenceId, obj->set_inher.referenceId);
-
-    req.smallSetUpperBound = &obj->set_inher.smallSetUpperBound;
-    req.largeSetLowerBound = &obj->set_inher.largeSetLowerBound;
-    req.mediumSetPresentNumber = &obj->set_inher.mediumSetPresentNumber;
-    req.replaceIndicator = &obj->set_inher.replaceIndicator;
-    req.resultSetName = obj->setName ? obj->setName : "Default";
-    logf (LOG_DEBUG, "Search, resultSetName %s", req.resultSetName);
-    req.num_databaseNames = obj->set_inher.num_databaseNames;
-    req.databaseNames = obj->set_inher.databaseNames;
+    set_referenceId (p->odr_out, &req->referenceId,
+                     obj->set_inher.referenceId);
+
+    req->smallSetUpperBound = &obj->set_inher.smallSetUpperBound;
+    req->largeSetLowerBound = &obj->set_inher.largeSetLowerBound;
+    req->mediumSetPresentNumber = &obj->set_inher.mediumSetPresentNumber;
+    req->replaceIndicator = &obj->set_inher.replaceIndicator;
+    req->resultSetName = obj->setName ? obj->setName : "Default";
+    logf (LOG_DEBUG, "Search, resultSetName %s", req->resultSetName);
+    req->num_databaseNames = obj->set_inher.num_databaseNames;
+    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;
-    req.preferredRecordSyntax = 0;
-    req.query = &query;
+    req->smallSetElementSetNames = 0;
+    req->mediumSetElementSetNames = 0;
+    if (obj->set_inher.preferredRecordSyntax)
+    {
+        struct oident ident;
+
+        ident.proto = p->protocol_type;
+        ident.class = CLASS_RECSYN;
+        ident.value = *obj->set_inher.preferredRecordSyntax;
+        req->preferredRecordSyntax = odr_oiddup (p->odr_out, 
+                                                 oid_getoidbyent (&ident));
+    }
+    else
+        req->preferredRecordSyntax = 0;
+    req->query = &query;
 
     if (!strcmp (obj->set_inher.queryType, "rpn"))
     {
@@ -1403,7 +1564,7 @@ static int do_search (void *o, Tcl_Interp *interp,
         interp->result = "unknown query method";
         return TCL_ERROR;
     }
-    if (!z_APDU (p->odr_out, &apdup, 0))
+    if (!z_APDU (p->odr_out, &apdu, 0))
     {
         interp->result = odr_errlist [odr_geterror (p->odr_out)];
         odr_reset (p->odr_out);
@@ -1507,19 +1668,22 @@ static int do_setName (void *o, Tcl_Interp *interp,
  * do_numberOfRecordsReturned: Get number of records returned
  */
 static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp,
-		       int argc, char **argv)
+                                       int argc, char **argv)
 {
     IrTcl_SetObj *obj = o;
 
-    if (argc < 0)
+    if (argc <= 0)
+    {
+        obj->numberOfRecordsReturned = 0;
         return TCL_OK;
+    }
     return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv);
 }
 
 /*
- * do_recordType: Return record type (if any) at position.
+ * do_type: Return type (if any) at position.
  */
-static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
+static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
     IrTcl_SetObj *obj = o;
     int offset;
@@ -1548,24 +1712,88 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
     switch (rl->which)
     {
     case Z_NamePlusRecord_databaseRecord:
-        interp->result = "databaseRecord";
+        interp->result = "DB";
         break;
     case Z_NamePlusRecord_surrogateDiagnostic:
-        interp->result = "surrogateDiagnostic";
+        interp->result = "SD";
         break;
     }
     return TCL_OK;
 }
 
+
 /*
- * do_recordDiag: Return diagnostic record info
+ * do_recordType: Return record type (if any) at position.
  */
-static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv)
+static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
     IrTcl_SetObj *obj = o;
     int offset;
     IrTcl_RecordList *rl;
+
+    if (argc == 0)
+    {
+	return TCL_OK;
+    }
+    else if (argc == -1)
+    {
+	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)
+        return TCL_OK;
+    if (rl->which != Z_NamePlusRecord_databaseRecord)
+    {
+        Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    Tcl_AppendElement (interp, (char*)
+                       IrTcl_getRecordSyntaxStr (rl->u.dbrec.type));
+    return TCL_OK;
+}
+
+/*
+ * ir_diagResult 
+ */
+static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num)
+{
     char buf[20];
+    int i;
+    const char *cp;
+
+    for (i = 0; i<num; i++)
+    {
+        logf (LOG_DEBUG, "Diagnostic, code %d", list[i].condition);
+        sprintf (buf, "%d", list[i].condition);
+        Tcl_AppendElement (interp, buf);
+        cp = diagbib1_str (list[i].condition);
+        if (cp)
+            Tcl_AppendElement (interp, (char*) cp);
+        else
+            Tcl_AppendElement (interp, "");
+        if (list[i].addinfo)
+            Tcl_AppendElement (interp, (char*) list[i].addinfo);
+        else
+            Tcl_AppendElement (interp, "");
+    }
+    return TCL_OK;
+}
+
+/*
+ * do_diag: Return diagnostic record info
+ */
+static int do_diag (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_SetObj *obj = o;
+    int offset;
+    IrTcl_RecordList *rl;
 
     if (argc <= 0)
         return TCL_OK;
@@ -1587,11 +1815,8 @@ static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv)
         Tcl_AppendResult (interp, "No Diagnostic record at #", argv[2], NULL);
         return TCL_ERROR;
     }
-    sprintf (buf, "%d", rl->u.diag.condition);
-    Tcl_AppendResult (interp, buf, " {", 
-                      (rl->u.diag.addinfo ? rl->u.diag.addinfo : ""),
-                      "}", NULL);
-    return TCL_OK;
+    return ir_diagResult (interp, rl->u.surrogateDiagnostics.list,
+                          rl->u.surrogateDiagnostics.num);
 }
 
 /*
@@ -1620,7 +1845,7 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
     }
     if (rl->which != Z_NamePlusRecord_databaseRecord)
     {
-        Tcl_AppendResult (interp, "No MARC record at #", argv[2], NULL);
+        Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
         return TCL_ERROR;
     }
     return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv);
@@ -1638,11 +1863,16 @@ static int do_responseStatus (void *o, Tcl_Interp *interp,
     if (argc == 0)
     {
         obj->recordFlag = 0;
-	obj->addinfo = NULL;
+        obj->nonSurrogateDiagnosticNum = 0;
+        obj->nonSurrogateDiagnosticList = NULL;
 	return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &obj->addinfo);
+    {
+        ir_deleteDiags (&obj->nonSurrogateDiagnosticList,
+                        &obj->nonSurrogateDiagnosticNum);
+        return TCL_OK;
+    }
     if (!obj->recordFlag)
     {
         Tcl_AppendElement (interp, "OK");
@@ -1654,8 +1884,9 @@ static int do_responseStatus (void *o, Tcl_Interp *interp,
     	Tcl_AppendElement (interp, "DBOSD");
         break;
     case Z_Records_NSD:
-        return mk_nonSurrogateDiagnostics (interp, obj->condition, 
-	                                   obj->addinfo);
+        Tcl_AppendElement (interp, "NSD");
+        return ir_diagResult (interp, obj->nonSurrogateDiagnosticList,
+                              obj->nonSurrogateDiagnosticNum);
     }
     return TCL_OK;
 }
@@ -1669,8 +1900,8 @@ static int do_present (void *o, Tcl_Interp *interp,
 {
     IrTcl_SetObj *obj = o;
     IrTcl_Obj *p = obj->parent;
-    Z_APDU apdu, *apdup = &apdu;
-    Z_PresentRequest req;
+    Z_APDU *apdu;
+    Z_PresentRequest *req;
     int start;
     int number;
     int r;
@@ -1700,19 +1931,19 @@ static int do_present (void *o, Tcl_Interp *interp,
     obj->start = start;
     obj->number = number;
 
-    apdu.which = Z_APDU_presentRequest;
-    apdu.u.presentRequest = &req;
+    apdu = zget_APDU (p->odr_out, Z_APDU_presentRequest);
+    req = apdu->u.presentRequest;
 
-    set_referenceId (p->odr_out, &req.referenceId, obj->set_inher.referenceId);
+    set_referenceId (p->odr_out, &req->referenceId,
+                     obj->set_inher.referenceId);
 
-    req.resultSetId = obj->setName ? obj->setName : "Default";
+    req->resultSetId = obj->setName ? obj->setName : "Default";
     
-    req.resultSetStartPoint = &start;
-    req.numberOfRecordsRequested = &number;
-    req.elementSetNames = 0;
-    req.preferredRecordSyntax = 0;
+    req->resultSetStartPoint = &start;
+    req->numberOfRecordsRequested = &number;
+    req->preferredRecordSyntax = 0;
 
-    if (!z_APDU (p->odr_out, &apdup, 0))
+    if (!z_APDU (p->odr_out, &apdu, 0))
     {
         interp->result = odr_errlist [odr_geterror (p->odr_out)];
         odr_reset (p->odr_out);
@@ -1787,9 +2018,10 @@ static IrTcl_Method ir_set_method_tab[] = {
     { 0, "resultCount",             do_resultCount },
     { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned },
     { 0, "present",                 do_present },
-    { 0, "recordType",              do_recordType },
+    { 0, "type",                    do_type },
     { 0, "getMarc",                 do_getMarc },
-    { 0, "Diag",                    do_recordDiag },
+    { 0, "recordType",              do_recordType },
+    { 0, "diag",                    do_diag },
     { 0, "responseStatus",          do_responseStatus },
     { 0, "loadFile",                do_loadFile },
     { 0, NULL, NULL}
@@ -1888,7 +2120,13 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
         if (ir_strdup (interp, &dst->referenceId, src->referenceId)
             == TCL_ERROR)
             return TCL_ERROR;
-        
+
+        if (src->preferredRecordSyntax && 
+            (dst->preferredRecordSyntax 
+             = malloc (sizeof(*dst->preferredRecordSyntax))))
+            *dst->preferredRecordSyntax = *src->preferredRecordSyntax;
+        else
+            dst->preferredRecordSyntax = NULL;
         dst->replaceIndicator = src->replaceIndicator;
         dst->smallSetUpperBound = src->smallSetUpperBound;
         dst->largeSetLowerBound = src->largeSetLowerBound;
@@ -1916,8 +2154,8 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
  */
 static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
-    Z_ScanRequest req;
-    Z_APDU apdu, *apdup = &apdu;
+    Z_ScanRequest *req;
+    Z_APDU *apdu;
     IrTcl_ScanObj *obj = o;
     IrTcl_Obj *p = obj->parent;
     int r;
@@ -1947,19 +2185,20 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
     }
     odr_reset (p->odr_out);
 
-    bib1.proto = PROTO_Z3950;
+    bib1.proto = p->protocol_type;
     bib1.class = CLASS_ATTSET;
     bib1.value = VAL_BIB1;
 
-    apdu.which = Z_APDU_scanRequest;
-    apdu.u.scanRequest = &req;
-    set_referenceId (p->odr_out, &req.referenceId, p->set_inher.referenceId);
-    req.num_databaseNames = p->set_inher.num_databaseNames;
-    req.databaseNames = p->set_inher.databaseNames;
-    req.attributeSet = oid_getoidbyent (&bib1);
+    apdu = zget_APDU (p->odr_out, Z_APDU_scanRequest);
+    req = apdu->u.scanRequest;
+
+    set_referenceId (p->odr_out, &req->referenceId, p->set_inher.referenceId);
+    req->num_databaseNames = p->set_inher.num_databaseNames;
+    req->databaseNames = p->set_inher.databaseNames;
+    req->attributeSet = oid_getoidbyent (&bib1);
 
 #if !CCL2RPN
-    if (!(req.termListAndStartPoint = p_query_scan (p->odr_out, argv[2])))
+    if (!(req->termListAndStartPoint = p_query_scan (p->odr_out, argv[2])))
     {
         Tcl_AppendResult (interp, "Syntax error in query", NULL);
 	return TCL_ERROR;
@@ -1973,19 +2212,19 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
     }
     ccl_pr_tree (rpn, stderr);
     fprintf (stderr, "\n");
-    if (!(req.termListAndStartPoint = ccl_scan_query (rpn)))
+    if (!(req->termListAndStartPoint = ccl_scan_query (rpn)))
         return TCL_ERROR;
 #endif
-    req.stepSize = &obj->stepSize;
-    req.numberOfTermsRequested = &obj->numberOfTermsRequested;
-    req.preferredPositionInResponse = &obj->preferredPositionInResponse;
-    logf (LOG_DEBUG, "stepSize=%d", *req.stepSize);
+    req->stepSize = &obj->stepSize;
+    req->numberOfTermsRequested = &obj->numberOfTermsRequested;
+    req->preferredPositionInResponse = &obj->preferredPositionInResponse;
+    logf (LOG_DEBUG, "stepSize=%d", *req->stepSize);
     logf (LOG_DEBUG, "numberOfTermsRequested=%d",
-          *req.numberOfTermsRequested);
+          *req->numberOfTermsRequested);
     logf (LOG_DEBUG, "preferredPositionInResponse=%d",
-          *req.preferredPositionInResponse);
+          *req->preferredPositionInResponse);
 
-    if (!z_APDU (p->odr_out, &apdup, 0))
+    if (!z_APDU (p->odr_out, &apdu, 0))
     {
         interp->result = odr_errlist [odr_geterror (p->odr_out)];
         odr_reset (p->odr_out);
@@ -2109,16 +2348,18 @@ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv)
     {
         p->entries_flag = 0;
 	p->entries = NULL;
-	p->nonSurrogateDiagnostics = NULL;
+	p->nonSurrogateDiagnosticNum = 0;
+        p->nonSurrogateDiagnosticList = 0;
 	return TCL_OK;
     }
     else if (argc == -1)
     {
         p->entries_flag = 0;
 	/* release entries */
-	p->entries = NULL;
-	/* release non diagnostics */
-	p->nonSurrogateDiagnostics = NULL;
+        p->entries = NULL;
+
+        ir_deleteDiags (&p->nonSurrogateDiagnosticList, 
+                        &p->nonSurrogateDiagnosticNum);
 	return TCL_OK;
     }
     if (argc != 3)
@@ -2143,9 +2384,9 @@ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv)
 	Tcl_AppendElement (interp, numstr);
 	break;
     case Z_Entry_surrogateDiagnostic:
-        return 
-	    mk_nonSurrogateDiagnostics (interp, p->entries[i].u.diag.condition,
-	                                p->entries[i].u.diag.addinfo);
+        Tcl_AppendElement (interp, "SD");
+        return ir_diagResult (interp, p->entries[i].u.diag.list,
+                              p->entries[i].u.diag.num);
 	break;
     }
     return TCL_OK;
@@ -2285,34 +2526,62 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
     }
 }
 
+static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num)
+{
+    int i;
+    for (i = 0; i<*dst_num; i++)
+        free (dst_list[i]->addinfo);
+    free (*dst_list);
+    *dst_list = NULL;
+    *dst_num = 0;
+}
+
+static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
+                    Z_DiagRec **list, int num)
+{
+    int i;
+    char *addinfo;
+
+    *dst_num = num;
+    *dst_list = malloc (sizeof(**dst_list) * num);
+    if (!*dst_list) 
+    {
+        *dst_num = 0;
+        return;
+    }
+    for (i = 0; i<num; i++)
+    {
+        switch (list[i]->which)
+        {
+        case Z_DiagRec_defaultFormat:
+            (*dst_list)[i].condition = *list[i]->u.defaultFormat->condition;
+            addinfo = list[i]->u.defaultFormat->addinfo;
+            if (addinfo && 
+                ((*dst_list)[i].addinfo = malloc (strlen(addinfo)+1)))
+                strcpy ((*dst_list)[i].addinfo, addinfo);
+            break;
+        default:
+            (*dst_list)[i].addinfo = NULL;
+            (*dst_list)[i].condition = 0;
+        }
+    }
+}
+
 static void ir_handleRecords (void *o, Z_Records *zrs)
 {
     IrTcl_Obj *p = o;
     IrTcl_SetObj *setobj = p->set_child;
 
+    int offset;
+    IrTcl_RecordList *rl;
+
     setobj->which = zrs->which;
     setobj->recordFlag = 1;
-    if (zrs->which == Z_Records_NSD)
-    {
-        const char *addinfo;
-        
-        setobj->numberOfRecordsReturned = 0;
-        setobj->condition = *zrs->u.nonSurrogateDiagnostic->condition;
-        free (setobj->addinfo);
-        setobj->addinfo = NULL;
-        addinfo = zrs->u.nonSurrogateDiagnostic->addinfo;
-        if (addinfo && (setobj->addinfo = malloc (strlen(addinfo) + 1)))
-            strcpy (setobj->addinfo, addinfo);
-        logf (LOG_DEBUG, "Diagnostic response. %s (%d): %s",
-              diagbib1_str (setobj->condition),
-              setobj->condition,
-              setobj->addinfo ? setobj->addinfo : "");
-    }
-    else
+    
+    ir_deleteDiags (&setobj->nonSurrogateDiagnosticList,
+                    &setobj->nonSurrogateDiagnosticNum);
+    if (zrs->which == Z_Records_DBOSD)
     {
-        int offset;
-        IrTcl_RecordList *rl;
-        
         setobj->numberOfRecordsReturned = 
             zrs->u.databaseOrSurDiagnostics->num_records;
         logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned);
@@ -2323,16 +2592,12 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
                                 records[offset]->which);
             if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
             {
-                Z_DiagRec *diagrec;
-                
-                diagrec = zrs->u.databaseOrSurDiagnostics->
-                    records[offset]->u.surrogateDiagnostic;
-                
-                rl->u.diag.condition = *diagrec->condition;
-                if (diagrec->addinfo && (rl->u.diag.addinfo =
-                                         malloc (strlen (diagrec->addinfo)+1)))
-                    strcpy (rl->u.diag.addinfo, diagrec->addinfo);
-            }
+                ir_handleDiags (&rl->u.surrogateDiagnostics.list,
+                                &rl->u.surrogateDiagnostics.num,
+                                &zrs->u.databaseOrSurDiagnostics->
+                                records[offset]->u.surrogateDiagnostic,
+                                1);
+            } 
             else
             {
                 Z_DatabaseRecord *zr; 
@@ -2342,17 +2607,43 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
                     ->u.databaseRecord;
                 oe = (Odr_external*) zr;
 		rl->u.dbrec.size = zr->u.octet_aligned->len;
+                rl->u.dbrec.type = VAL_USMARC;
                 if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
                 {
                     const char *buf = (char*) zr->u.octet_aligned->buf;
                     if ((rl->u.dbrec.buf = malloc (rl->u.dbrec.size)))
 		        memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
+                    if (oe->direct_reference)
+                    {
+                        struct oident *ident = 
+                            oid_getentbyoid (oe->direct_reference);
+                        rl->u.dbrec.type = ident->value;
+                    }
                 }
                 else
                     rl->u.dbrec.buf = NULL;
             }
         }
     }
+    else if (zrs->which == Z_Records_multipleNSD)
+    {
+        logf (LOG_DEBUG, "multipleNonSurrogateDiagnostic %d",
+              zrs->u.multipleNonSurDiagnostics->num_diagRecs);
+        setobj->numberOfRecordsReturned = 0;
+        ir_handleDiags (&setobj->nonSurrogateDiagnosticList,
+                        &setobj->nonSurrogateDiagnosticNum,
+                        zrs->u.multipleNonSurDiagnostics->diagRecs,
+                        zrs->u.multipleNonSurDiagnostics->num_diagRecs);
+    }
+    else
+    {
+        logf (LOG_DEBUG, "NonSurrogateDiagnostic");
+        setobj->numberOfRecordsReturned = 0;
+        ir_handleDiags (&setobj->nonSurrogateDiagnosticList,
+                        &setobj->nonSurrogateDiagnosticNum,
+                        &zrs->u.nonSurrogateDiagnostic,
+                        1);
+    }
 }
 
 static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
@@ -2435,9 +2726,9 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs)
 
     free (scanobj->entries);
     scanobj->entries = NULL;
-    free (scanobj->nonSurrogateDiagnostics);
-    scanobj->nonSurrogateDiagnostics = NULL;
 
+    ir_deleteDiags (&scanobj->nonSurrogateDiagnosticList,
+                    &scanobj->nonSurrogateDiagnosticNum);
     if (scanrs->entries)
     {
         int i;
@@ -2476,22 +2767,21 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs)
 		        scanobj->entries[i].u.term.globalOccurrences = 0;
                     break;
 		case Z_Entry_surrogateDiagnostic:
-		    scanobj->entries[i].u.diag.addinfo = 
-		            malloc (1+strlen(ze->u.surrogateDiagnostic->
-			                     addinfo));
-                    strcpy (scanobj->entries[i].u.diag.addinfo,
-		            ze->u.surrogateDiagnostic->addinfo);
-		    scanobj->entries[i].u.diag.condition = 
-		        *ze->u.surrogateDiagnostic->condition;
+                    ir_handleDiags (&scanobj->entries[i].u.diag.list,
+                                    &scanobj->entries[i].u.diag.num,
+                                    &ze->u.surrogateDiagnostic,
+                                    1);
 		    break;
 		}
 	    }
             break;
 	case Z_ListEntries_nonSurrogateDiagnostics:
-	    scanobj->num_diagRecs = scanrs->entries->
-	                          u.nonSurrogateDiagnostics->num_diagRecs;
-	    scanobj->nonSurrogateDiagnostics = malloc (scanobj->num_diagRecs *
-	                          sizeof(*scanobj->nonSurrogateDiagnostics));
+            ir_handleDiags (&scanobj->nonSurrogateDiagnosticList,
+                            &scanobj->nonSurrogateDiagnosticNum,
+                            scanrs->entries->u.nonSurrogateDiagnostics->
+                            diagRecs,
+                            scanrs->entries->u.nonSurrogateDiagnostics->
+                            num_diagRecs);
             break;
 	}
     }
@@ -2512,19 +2802,22 @@ void ir_select_read (ClientData clientData)
     {
         r = cs_rcvconnect (p->cs_link);
         if (r == 1)
+        {
+            logf (LOG_WARN, "cs_rcvconnect returned 1");
             return;
+        }
         p->connectFlag = 0;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         if (r < 0)
         {
             logf (LOG_DEBUG, "cs_rcvconnect error");
             if (p->failback)
-                Tcl_Eval (p->interp, p->failback);
+                IrTcl_eval (p->interp, p->failback);
             do_disconnect (p, NULL, 2, NULL);
             return;
         }
         if (p->callback)
-	    Tcl_Eval (p->interp, p->callback);
+	    IrTcl_eval (p->interp, p->callback);
         return;
     }
     do
@@ -2537,7 +2830,7 @@ void ir_select_read (ClientData clientData)
             logf (LOG_DEBUG, "cs_get failed, code %d", r);
             ir_select_remove (cs_fileno (p->cs_link), p);
             if (p->failback)
-                Tcl_Eval (p->interp, p->failback);
+                IrTcl_eval (p->interp, p->failback);
             do_disconnect (p, NULL, 2, NULL);
 
 	    /* relase ir object now if callback deleted it */
@@ -2552,10 +2845,10 @@ void ir_select_read (ClientData clientData)
         {
             logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]);
             if (p->failback)
-                Tcl_Eval (p->interp, p->failback);
+                IrTcl_eval (p->interp, p->failback);
             do_disconnect (p, NULL, 2, NULL);
 
-	    /* release ir object now if callback deleted it */
+	    /* release ir object now if failback deleted it */
 	    ir_obj_delete (p);
             return;
         }
@@ -2576,12 +2869,12 @@ void ir_select_read (ClientData clientData)
         default:
             logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which);
             if (p->failback)
-                Tcl_Eval (p->interp, p->failback);
+                IrTcl_eval (p->interp, p->failback);
             do_disconnect (p, NULL, 2, NULL);
         }
         odr_reset (p->odr_in);
         if (p->callback)
-	    Tcl_Eval (p->interp, p->callback);
+	    IrTcl_eval (p->interp, p->callback);
 	if (p->ref_count == 1)
 	{
 	    ir_obj_delete (p);
@@ -2611,20 +2904,20 @@ void ir_select_write (ClientData clientData)
             logf (LOG_DEBUG, "cs_rcvconnect error");
             ir_select_remove_write (cs_fileno (p->cs_link), p);
             if (p->failback)
-                Tcl_Eval (p->interp, p->failback);
+                IrTcl_eval (p->interp, p->failback);
             do_disconnect (p, NULL, 2, NULL);
             return;
         }
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         if (p->callback)
-	    Tcl_Eval (p->interp, p->callback);
+	    IrTcl_eval (p->interp, p->callback);
         return;
     }
     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
     {   
         logf (LOG_DEBUG, "select write fail");
         if (p->failback)
-            Tcl_Eval (p->interp, p->failback);
+            IrTcl_eval (p->interp, p->failback);
         do_disconnect (p, NULL, 2, NULL);
     }
     else if (r == 0)            /* remove select bit */
@@ -2646,6 +2939,7 @@ int ir_tcl_init (Tcl_Interp *interp)
     		       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk,
     		       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    irTcl_interp = interp;
     return TCL_OK;
 }