X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=ad3fba6ff110dea62b4aab89b00c713300a53a25;hb=2514337466dde9568aa6c267170510cc2bca4121;hp=e4ee0473873c75a1c5563133361b2334bf22f4b6;hpb=e4f11f428b4bdd143bb237177df4563fbfa19262;p=ir-tcl-moved-to-github.git

diff --git a/ir-tcl.c b/ir-tcl.c
index e4ee047..ad3fba6 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -1,11 +1,32 @@
 /*
  * IR toolkit for tcl/tk
- * (c) Index Data 1995
+ * (c) Index Data 1995-1996
  * See the file LICENSE for details.
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.90  1996-06-27 14:21:00  adam
+ * Revision 1.96  1996-10-08 13:02:50  adam
+ * When dealing with records, odr_choice_enable_bias function is used to
+ * prevent decoding of externals.
+ *
+ * Revision 1.95  1996/09/13  10:51:49  adam
+ * Bug fix: ir_tcl_select_set called Tcl_GetFile at disconnect.
+ *
+ * Revision 1.94  1996/08/21  13:32:53  adam
+ * Implemented saveFile method and extended loadFile method to work with it.
+ *
+ * Revision 1.93  1996/08/16  15:07:45  adam
+ * First work on Explain.
+ *
+ * Revision 1.92  1996/08/09  15:33:07  adam
+ * Modified the code to use tk4.1/tcl7.5 patch level 1. The time-driven
+ * polling is no longer activated on Windows since asynchrounous I/O works
+ * better.
+ *
+ * Revision 1.91  1996/07/03  13:31:11  adam
+ * The xmalloc/xfree functions from YAZ are used to manage memory.
+ *
+ * Revision 1.90  1996/06/27  14:21:00  adam
  * Yet another Windows port.
  *
  * Revision 1.89  1996/06/11  15:27:15  adam
@@ -324,7 +345,11 @@
 
 #include <stdlib.h>
 #include <stdio.h>
+#ifdef WINDOWS
+
+#else
 #include <unistd.h>
+#endif
 #include <time.h>
 #include <assert.h>
 
@@ -369,14 +394,15 @@ static void delete_IR_record (IrTcl_RecordList *rl)
         default:
             break;
         }
-        free (rl->u.dbrec.buf);
+        xfree (rl->u.dbrec.buf);
+        rl->u.dbrec.buf = NULL;
         break;
     case Z_NamePlusRecord_surrogateDiagnostic:
         ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
                         &rl->u.surrogateDiagnostics.num);
         break;
     }
-    free (rl->elements);
+    xfree (rl->elements);
 }
 
 static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, 
@@ -425,7 +451,7 @@ int ir_tcl_eval (Tcl_Interp *interp, const char *command)
               interp->result);
     }
     Tcl_FreeResult (interp);
-    free (tmp);
+    xfree (tmp);
     return r;
 }
 
@@ -477,7 +503,7 @@ static void delete_IR_records (IrTcl_SetObj *setobj)
     {
         delete_IR_record (rl);
         rl1 = rl->next;
-        free (rl);
+        xfree (rl);
     }
     setobj->record_list = NULL;
 }
@@ -583,7 +609,7 @@ static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src)
 
 static void get_referenceId (char **dst, Z_ReferenceId *src)
 {
-    free (*dst);
+    xfree (*dst);
     if (!src)
     {
         *dst = NULL;
@@ -887,7 +913,7 @@ static int do_implementationName (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->implementationName);
     if (argc == 3)
     {
-        free (p->implementationName);
+        xfree (p->implementationName);
         if (ir_tcl_strdup (interp, &p->implementationName, argv[2])
             == TCL_ERROR)
             return TCL_ERROR;
@@ -922,7 +948,11 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp,
 
     if (argc == 0)
         return ir_tcl_strdup (interp, &p->implementationVersion, 
-                          "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
+                          "YAZ: " YAZ_VERSION
+#ifdef IR_TCL_VERSION
+                          " / Irtcl: " IR_TCL_VERSION
+#endif
+                          );
     else if (argc == -1)
         return ir_tcl_strdel (interp, &p->implementationVersion);
     Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
@@ -996,10 +1026,10 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp,
 
     if (argc >= 3 || argc == -1)
     {
-        free (p->idAuthenticationOpen);
-        free (p->idAuthenticationGroupId);
-        free (p->idAuthenticationUserId);
-        free (p->idAuthenticationPassword);
+        xfree (p->idAuthenticationOpen);
+        xfree (p->idAuthenticationGroupId);
+        xfree (p->idAuthenticationUserId);
+        xfree (p->idAuthenticationPassword);
     }
     if (argc >= 3 || argc <= 0)
     {
@@ -1136,14 +1166,13 @@ void ir_tcl_disconnect (IrTcl_Obj *p)
     if (p->hostname)
     {
         logf(LOG_DEBUG, "Closing connection to %s", p->hostname);
-        free (p->hostname);
+        xfree (p->hostname);
         p->hostname = NULL;
-        ir_select_remove_write (cs_fileno (p->cs_link), p);
+        assert (p->cs_link);
         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;
 
@@ -1196,7 +1225,7 @@ static int do_comstack (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->comstackType);
     else if (argc == 3)
     {
-        free (obj->comstackType);
+        xfree (obj->comstackType);
         if (ir_tcl_strdup (interp, &obj->comstackType, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1257,7 +1286,7 @@ static int do_callback (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->callback);
     if (argc == 3)
     {
-        free (p->callback);
+        xfree (p->callback);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
@@ -1286,7 +1315,7 @@ static int do_failback (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->failback);
     else if (argc == 3)
     {
-        free (p->failback);
+        xfree (p->failback);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &p->failback, argv[2]) == TCL_ERROR)
@@ -1315,7 +1344,7 @@ static int do_initResponse (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->initResponse);
     if (argc == 3)
     {
-        free (p->initResponse);
+        xfree (p->initResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &p->initResponse, argv[2]) == TCL_ERROR)
@@ -1402,8 +1431,8 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp,
     if (argc == -1)
     {
         for (i=0; i<p->num_databaseNames; i++)
-            free (p->databaseNames[i]);
-        free (p->databaseNames);
+            xfree (p->databaseNames[i]);
+        xfree (p->databaseNames);
     }
     if (argc <= 0)
     {
@@ -1420,8 +1449,8 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp,
     if (p->databaseNames)
     {
         for (i=0; i<p->num_databaseNames; i++)
-            free (p->databaseNames[i]);
-        free (p->databaseNames);
+            xfree (p->databaseNames[i]);
+        xfree (p->databaseNames);
     }
     p->num_databaseNames = argc - 2;
     p->databaseNames =
@@ -1466,7 +1495,7 @@ static int do_queryType (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->queryType);
     if (argc == 3)
     {
-        free (p->queryType);
+        xfree (p->queryType);
         if (ir_tcl_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1558,7 +1587,7 @@ static int do_referenceId (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->referenceId);
     if (argc == 3)
     {
-        free (p->referenceId);
+        xfree (p->referenceId);
         if (ir_tcl_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1581,13 +1610,13 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp,
     }
     else if (argc == -1)
     {
-        free (p->preferredRecordSyntax);
+        xfree (p->preferredRecordSyntax);
         p->preferredRecordSyntax = NULL;
         return TCL_OK;
     }
     if (argc == 3)
     {
-        free (p->preferredRecordSyntax);
+        xfree (p->preferredRecordSyntax);
         p->preferredRecordSyntax = NULL;
         if (argv[2][0] && (p->preferredRecordSyntax = 
                            ir_tcl_malloc (sizeof(*p->preferredRecordSyntax))))
@@ -1620,7 +1649,7 @@ static int do_elementSetNames (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->elementSetNames);
     if (argc == 3)
     {
-        free (p->elementSetNames);
+        xfree (p->elementSetNames);
         if (ir_tcl_strdup (interp, &p->elementSetNames, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1645,7 +1674,7 @@ static int do_smallSetElementSetNames (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->smallSetElementSetNames);
     if (argc == 3)
     {
-        free (p->smallSetElementSetNames);
+        xfree (p->smallSetElementSetNames);
         if (ir_tcl_strdup (interp, &p->smallSetElementSetNames,
                            argv[2]) == TCL_ERROR)
             return TCL_ERROR;
@@ -1671,7 +1700,7 @@ static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->mediumSetElementSetNames);
     if (argc == 3)
     {
-        free (p->mediumSetElementSetNames);
+        xfree (p->mediumSetElementSetNames);
         if (ir_tcl_strdup (interp, &p->mediumSetElementSetNames,
                            argv[2]) == TCL_ERROR)
             return TCL_ERROR;
@@ -1776,7 +1805,7 @@ static void ir_obj_delete (ClientData clientData)
     odr_destroy (obj->odr_in);
     odr_destroy (obj->odr_out);
     odr_destroy (obj->odr_pr);
-    free (obj);
+    xfree (obj);
 }
 
 /* 
@@ -1810,6 +1839,7 @@ int ir_obj_init (ClientData clientData, Tcl_Interp *interp,
 
     logf (LOG_DEBUG, "ir object create %s", argv[1]);
     obj->odr_in = odr_createmem (ODR_DECODE);
+    odr_choice_enable_bias (obj->odr_in, 0);
     obj->odr_out = odr_createmem (ODR_ENCODE);
     obj->odr_pr = odr_createmem (ODR_PRINT);
     obj->state = IR_TCL_R_Idle;
@@ -2028,7 +2058,7 @@ static int do_searchResponse (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->searchResponse);
     if (argc == 3)
     {
-        free (obj->searchResponse);
+        xfree (obj->searchResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &obj->searchResponse, argv[2])
@@ -2058,7 +2088,7 @@ static int do_presentResponse (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->presentResponse);
     if (argc == 3)
     {
-        free (obj->presentResponse);
+        xfree (obj->presentResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &obj->presentResponse, argv[2])
@@ -2145,7 +2175,7 @@ static int do_setName (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->setName);
     if (argc == 3)
     {
-        free (obj->setName);
+        xfree (obj->setName);
         if (ir_tcl_strdup (interp, &obj->setName, argv[2])
             == TCL_ERROR)
             return TCL_ERROR;
@@ -2275,7 +2305,7 @@ static int do_recordElements (void *o, Tcl_Interp *interp,
     }
     if (argc == 3)
     {
-        free (obj->recordElements);
+        xfree (obj->recordElements);
         return ir_tcl_strdup (NULL, &obj->recordElements, 
                               (*argv[2] ? argv[2] : NULL));
     }
@@ -2411,7 +2441,7 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv)
 
 
 /*
- * do_getGrs: Get a GRS1 Record
+ * do_getGrs: Get a GRS-1 Record
  */
 static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
@@ -2446,6 +2476,54 @@ static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
 
 
 /*
+ * do_getExplain: Get an Explain Record
+ */
+static int do_getExplain (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_SetObj *obj = o;
+    IrTcl_Obj *p = obj->parent;
+    void *rr;
+    Z_ext_typeent *etype;
+    int offset;
+    IrTcl_RecordList *rl;
+
+    if (argc <= 0)
+        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)
+    {
+        Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->which != Z_NamePlusRecord_databaseRecord)
+    {
+        Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->u.dbrec.type != VAL_EXPLAIN)
+        return TCL_OK;
+
+    if (!(etype = z_ext_getentbyref (VAL_EXPLAIN)))
+        return TCL_OK;
+
+    odr_setbuf (p->odr_in, rl->u.dbrec.buf, rl->u.dbrec.size, 0);
+    if (!(*etype->fun)(p->odr_in, &rr, 0))
+        return TCL_OK;
+    
+    if (etype->what != Z_External_explainRecord)
+        return TCL_OK;
+
+    return ir_tcl_get_explain (interp, rr, argc, argv);
+}
+
+/*
  * do_responseStatus: Return response status (present or search)
  */
 static int do_responseStatus (void *o, Tcl_Interp *interp, 
@@ -2565,47 +2643,165 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
     return ir_tcl_send_APDU (interp, p, apdu, "present", *argv);
 }
 
+#define IR_TCL_RECORD_ENCODING_ISO2709  1
+#define IR_TCL_RECORD_ENCODING_RAW      2
+
+typedef struct {
+    int encoding;
+    int syntax;
+    int size;
+} IrTcl_FileRecordHead;
+
 /*
  * do_loadFile: Load result set from file
  */
-
 static int do_loadFile (void *o, Tcl_Interp *interp,
                         int argc, char **argv)
 {
     IrTcl_SetObj *setobj = o;
     FILE *inf;
     size_t size;
-    int  no = 1;
+    int offset;
+    int start = 1;
+    int number = 30000;
     char *buf;
-
+    
     if (argc <= 0)
         return TCL_OK;
-    if (argc != 3)
+    if (argc < 3)
     {
         interp->result = "wrong # args";
         return TCL_ERROR;
     }
+    if (argc > 3)
+        start = atoi (argv[3]);
+    if (argc > 4)
+        number = atoi (argv[4]);
+    offset = start;
+
     inf = fopen (argv[2], "r");
     if (!inf)
     {
         Tcl_AppendResult (interp, "Cannot open ", argv[2], NULL);
         return TCL_ERROR;
     }
-    while ((buf = ir_tcl_fread_marc (inf, &size)))
+    while (offset < (start+number))
     {
+        IrTcl_FileRecordHead head;
         IrTcl_RecordList *rl;
 
-        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;
-        no++;
+        if (fread (&head, sizeof(head), 1, inf) < 1)
+            break;
+        rl = new_IR_record (setobj, offset,
+                            Z_NamePlusRecord_databaseRecord,
+                            (argc > 5) ? argv[5] : NULL);
+        rl->u.dbrec.type = head.syntax;
+        if (head.encoding == IR_TCL_RECORD_ENCODING_ISO2709)
+        {
+            if (!(buf = ir_tcl_fread_marc (inf, &size)))
+                break;
+            rl->u.dbrec.buf = buf;
+            rl->u.dbrec.size = size;
+            if (size != head.size)
+            {
+                Tcl_AppendResult (interp, "Bad ISO2709 encoding in file",
+                                  argv[2], NULL);
+                fclose (inf);
+                return TCL_ERROR;
+            }
+        } 
+        else if (head.encoding == IR_TCL_RECORD_ENCODING_RAW)
+        {
+            rl->u.dbrec.size = head.size;
+            rl->u.dbrec.buf = ir_tcl_malloc (head.size + 1);
+            if (fread (rl->u.dbrec.buf, rl->u.dbrec.size, 1, inf) < 1)
+            {
+                Tcl_AppendResult (interp, "Bad RAW encoding in file",
+                                  argv[2], NULL);
+                fclose (inf);
+                return TCL_ERROR;
+            }
+            rl->u.dbrec.buf[rl->u.dbrec.size] = '\0';
+        }
+        else
+        {
+            rl->u.dbrec.buf = NULL;
+            rl->u.dbrec.size = 0;
+            Tcl_AppendResult (interp, "Bad encoding in file", argv[2], NULL);
+            fclose (inf);
+            return TCL_ERROR;
+        }
+        offset++;
     }
-    setobj->numberOfRecordsReturned = no-1;
+    setobj->numberOfRecordsReturned = offset - start;
     fclose (inf);
     return TCL_OK;
 }
 
+/*
+ * do_saveFile: Save result set on file
+ */
+static int do_saveFile (void *o, Tcl_Interp *interp,
+                        int argc, char **argv)
+{
+    IrTcl_SetObj *setobj = o;
+    FILE *outf;
+    int offset;
+    int start = 1;
+    int number = 30000;
+    IrTcl_RecordList *rl;
+    
+    if (argc <= 0)
+        return TCL_OK;
+    if (argc < 3)
+    {
+        interp->result = "wrong # args";
+        return TCL_ERROR;
+    }
+    if (argc > 3)
+        start = atoi (argv[3]);
+    if (argc > 4)
+        number = atoi (argv[4]);
+    offset = start;
+
+    outf = fopen (argv[2], "w");
+    if (!outf)
+    {
+        Tcl_AppendResult (interp, "Cannot open ", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    while (offset < (start+number) && (rl = find_IR_record (setobj, offset)))
+    {
+        if (rl->which == Z_NamePlusRecord_databaseRecord &&
+            rl->u.dbrec.buf && rl->u.dbrec.size)
+        {
+            IrTcl_FileRecordHead head;
+
+            head.encoding = IR_TCL_RECORD_ENCODING_RAW;
+            head.syntax = rl->u.dbrec.type;
+            head.size = rl->u.dbrec.size;
+            if (fwrite (&head, sizeof(head), 1, outf) < 1)
+            {
+                Tcl_AppendResult (interp, "Cannot write ", argv[2], NULL);
+                return TCL_ERROR;
+            }
+            if (fwrite (rl->u.dbrec.buf, rl->u.dbrec.size, 1, outf) < 1)
+            {
+                Tcl_AppendResult (interp, "Cannot write ", argv[2], NULL);
+                return TCL_ERROR;
+            }
+        }
+        offset++;
+    }
+    if (fclose (outf))
+    {
+        Tcl_AppendResult (interp, "Cannot write ", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+
 static IrTcl_Method ir_set_method_tab[] = {
     { "search",                  do_search, NULL},
     { "searchResponse",          do_searchResponse, NULL},
@@ -2621,11 +2817,13 @@ static IrTcl_Method ir_set_method_tab[] = {
     { "getMarc",                 do_getMarc, NULL},
     { "getSutrs",                do_getSutrs, NULL},
     { "getGrs",                  do_getGrs, NULL},
+    { "getExplain",              do_getExplain, NULL},
     { "recordType",              do_recordType, NULL},
     { "recordElements",          do_recordElements, NULL},
     { "diag",                    do_diag, NULL},
     { "responseStatus",          do_responseStatus, NULL},
     { "loadFile",                do_loadFile, NULL},
+    { "saveFile",                do_saveFile, NULL},
     { NULL, NULL}
 };
 
@@ -2672,7 +2870,7 @@ static void ir_set_obj_delete (ClientData clientData)
 
     ir_tcl_method (NULL, -1, NULL, tabs, NULL);
 
-    free (p);
+    xfree (p);
 }
 
 /*
@@ -2893,7 +3091,7 @@ static int do_scanResponse (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->scanResponse);
     if (argc == 3)
     {
-        free (obj->scanResponse);
+        xfree (obj->scanResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &obj->scanResponse, argv[2])
@@ -3100,7 +3298,7 @@ static void ir_scan_obj_delete (ClientData clientData)
     tabs[1].tab = NULL;
 
     ir_tcl_method (NULL, -1, NULL, tabs, NULL);
-    free (obj);
+    xfree (obj);
 }
 
 /* 
@@ -3152,13 +3350,13 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
 
     get_referenceId (&p->set_inher.referenceId, initrs->referenceId);
 
-    free (p->targetImplementationId);
+    xfree (p->targetImplementationId);
     ir_tcl_strdup (p->interp, &p->targetImplementationId,
                initrs->implementationId);
-    free (p->targetImplementationName);
+    xfree (p->targetImplementationName);
     ir_tcl_strdup (p->interp, &p->targetImplementationName,
                initrs->implementationName);
-    free (p->targetImplementationVersion);
+    xfree (p->targetImplementationVersion);
     ir_tcl_strdup (p->interp, &p->targetImplementationVersion,
                initrs->implementationVersion);
 
@@ -3168,7 +3366,7 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
     memcpy (&p->options, initrs->options, sizeof(initrs->options));
     memcpy (&p->protocolVersion, initrs->protocolVersion,
             sizeof(initrs->protocolVersion));
-    free (p->userInformationField);
+    xfree (p->userInformationField);
     p->userInformationField = NULL;
     if (initrs->userInformationField)
     {
@@ -3192,14 +3390,14 @@ 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);
+        xfree (dst_list[i]->addinfo);
+    xfree (*dst_list);
     *dst_list = NULL;
     *dst_num = 0;
 }
 
 static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
-                    Z_DiagRec **list, int num)
+                            Z_DiagRec **list, int num)
 {
     int i;
     char *addinfo;
@@ -3228,7 +3426,86 @@ 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_handleDBRecord (IrTcl_Obj *p, IrTcl_RecordList *rl,
+                               Z_External *oe)
+{
+    struct oident *ident;
+    Z_ext_typeent *etype;
+                
+    rl->u.dbrec.size = oe->u.octet_aligned->len;
+    rl->u.dbrec.buf = NULL;
+    
+    if ((ident = oid_getentbyoid (oe->direct_reference)))
+        rl->u.dbrec.type = ident->value;
+    else
+        rl->u.dbrec.type = VAL_USMARC;
+
+    if (ident && (oe->which == Z_External_single ||
+                  oe->which == Z_External_octet)
+        && (etype = z_ext_getentbyref (ident->value)))
+    {
+        void *rr;
+        
+        odr_setbuf (p->odr_in, (char*) oe->u.octet_aligned->buf,
+                    oe->u.octet_aligned->len, 0);
+        if (!(*etype->fun)(p->odr_in, &rr, 0))
+            return;
+        switch (etype->what)
+        {
+        case Z_External_sutrs:
+            logf (LOG_LOG, "Z_External_sutrs");
+            oe->u.sutrs = rr;
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
+            {
+                memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
+                        oe->u.sutrs->len);
+                rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
+            }
+            rl->u.dbrec.size = oe->u.sutrs->len;
+            break;
+        case Z_External_grs1:
+            logf (LOG_LOG, "Z_External_grs1");
+            oe->u.grs1 = rr;
+            ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
+            break;
+        case Z_External_explainRecord:
+            logf (LOG_LOG, "Z_External_explainRecord");
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
+            {
+                memcpy (rl->u.dbrec.buf, oe->u.octet_aligned->buf,
+                        rl->u.dbrec.size);
+            }
+            break;
+        }
+    }
+    else
+    {
+        if (oe->which == Z_External_octet && rl->u.dbrec.size > 0)
+        {
+            char *buf = (char*) oe->u.octet_aligned->buf;
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
+                memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
+        }
+        else if (rl->u.dbrec.type == VAL_SUTRS && 
+                 oe->which == Z_External_sutrs)
+        {
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
+            {
+                memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
+                        oe->u.sutrs->len);
+                rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
+            }
+            rl->u.dbrec.size = oe->u.sutrs->len;
+        }
+        else if (rl->u.dbrec.type == VAL_GRS1 && 
+                 oe->which == Z_External_grs1)
+        {
+            ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
+        }
+    }
+}
+
+static void ir_handleZRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
                               const char *elements)
 {
     IrTcl_Obj *p = o;
@@ -3246,64 +3523,21 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
         setobj->numberOfRecordsReturned = 
             zrs->u.databaseOrSurDiagnostics->num_records;
         logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned);
-        for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
+        for (offset = 0; offset < setobj->numberOfRecordsReturned; offset++)
         {
-            rl = new_IR_record (setobj, setobj->start + offset,
-                                zrs->u.databaseOrSurDiagnostics->
-                                records[offset]->which,
+            Z_NamePlusRecord *znpr = zrs->u.databaseOrSurDiagnostics->
+                records[offset];
+            
+            rl = new_IR_record (setobj, setobj->start + offset, znpr->which,
                                 elements);
             if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
-            {
                 ir_handleDiags (&rl->u.surrogateDiagnostics.list,
                                 &rl->u.surrogateDiagnostics.num,
-                                &zrs->u.databaseOrSurDiagnostics->
-                                records[offset]->u.surrogateDiagnostic,
+                                &znpr->u.surrogateDiagnostic,
                                 1);
-            } 
             else
-            {
-                Z_DatabaseRecord *zr; 
-                Z_External *oe;
-                struct oident *ident;
-                
-                zr = zrs->u.databaseOrSurDiagnostics->records[offset]
-                    ->u.databaseRecord;
-                oe = (Z_External*) zr;
-                rl->u.dbrec.size = zr->u.octet_aligned->len;
-
-                if ((ident = oid_getentbyoid (oe->direct_reference)))
-                    rl->u.dbrec.type = ident->value;
-                else
-                    rl->u.dbrec.type = VAL_USMARC;
-
-                if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
-                {
-                    char *buf = (char*) zr->u.octet_aligned->buf;
-                    if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
-                        memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
-                }
-                else if (rl->u.dbrec.type == VAL_SUTRS && 
-                         oe->which == Z_External_sutrs)
-                {
-                    odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf,
-                                oe->u.single_ASN1_type->len, 0);
-                    if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
-                    {
-                        memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
-                                oe->u.sutrs->len);
-                        rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
-                    }
-                    rl->u.dbrec.size = oe->u.sutrs->len;
-                }
-                else if (rl->u.dbrec.type == VAL_GRS1 && 
-                         oe->which == Z_External_grs1)
-                {
-                    ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
-                    rl->u.dbrec.buf = NULL;
-                }
-                else
-                    rl->u.dbrec.buf = NULL;
-            }
+                ir_handleDBRecord (p, rl,
+                                   (Z_External*) (znpr->u.databaseRecord));
         }
     }
     else if (zrs->which == Z_Records_multipleNSD)
@@ -3355,7 +3589,7 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs,
             es = setobj->set_inher.smallSetElementSetNames;
         else 
             es = setobj->set_inher.mediumSetElementSetNames;
-        ir_handleRecords (o, zrs, setobj, es);
+        ir_handleZRecords (o, zrs, setobj, es);
     }
     else
         setobj->recordFlag = 0;
@@ -3377,7 +3611,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, setobj->set_inher.elementSetNames);
+        ir_handleZRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
     else
     {
         setobj->recordFlag = 0;
@@ -3410,7 +3644,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs,
         scanobj->positionOfTerm = -1;
     logf (LOG_DEBUG, "positionOfTerm=%d", scanobj->positionOfTerm);
 
-    free (scanobj->entries);
+    xfree (scanobj->entries);
     scanobj->entries = NULL;
 
     ir_deleteDiags (&scanobj->nonSurrogateDiagnosticList,
@@ -3627,10 +3861,10 @@ static void ir_select_read (ClientData clientData)
             ir_tcl_eval (p->interp, apdu_call);
         else if (rq->callback)
             ir_tcl_eval (p->interp, rq->callback);
-        free (rq->buf_out);
-        free (rq->callback);
-        free (rq->object_name);
-        free (rq);
+        xfree (rq->buf_out);
+        xfree (rq->callback);
+        xfree (rq->object_name);
+        xfree (rq);
         odr_reset (p->odr_in);
         if (p->ref_count == 1)
         {
@@ -3690,7 +3924,7 @@ static int ir_select_write (ClientData clientData)
     {
         logf (LOG_DEBUG, "cs_put write fail");
         p->ref_count = 2;
-        free (rq->buf_out);
+        xfree (rq->buf_out);
         rq->buf_out = NULL;
         ir_tcl_disconnect (p);
         if (p->failback)
@@ -3705,7 +3939,7 @@ static int ir_select_write (ClientData clientData)
         logf (LOG_DEBUG, "Write completed");
         p->state = IR_TCL_R_Waiting;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
-        free (rq->buf_out);
+        xfree (rq->buf_out);
         rq->buf_out = NULL;
     }
     return 1;