X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=ir-tcl.c;h=ab6ef29b13a6d731280b5ddc879e4275a9bb4781;hb=f25d0ab1672bff45ed845baf786f23aac60ca243;hp=468bf3aba372ca2737d4c15e706facf8027b9733;hpb=9d133cf6537db3aa9b09fd5d215e72dfa92b9cf4;p=ir-tcl-moved-to-github.git

diff --git a/ir-tcl.c b/ir-tcl.c
index 468bf3a..ab6ef29 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,59 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.44  1995-06-19 17:01:20  adam
+ * Revision 1.57  1995-09-21 13:11:51  adam
+ * Support of dynamic loading.
+ * Test script uses load command if necessary.
+ *
+ * Revision 1.56  1995/08/29  15:30:14  adam
+ * Work on GRS records.
+ *
+ * Revision 1.55  1995/08/28  09:43:25  adam
+ * Minor changes. configure only searches for yaz beta 3 and versions after
+ * that.
+ *
+ * Revision 1.54  1995/08/24  12:25:16  adam
+ * Modified to work with yaz 1.0b3.
+ *
+ * Revision 1.53  1995/08/04  12:49:26  adam
+ * Bug fix: reading uninitialized variable p.
+ *
+ * Revision 1.52  1995/08/04  11:32:38  adam
+ * More work on output queue. Memory related routines moved
+ * to mem.c
+ *
+ * Revision 1.51  1995/08/03  13:22:54  adam
+ * Request queue.
+ *
+ * Revision 1.50  1995/07/20  08:09:49  adam
+ * client.tcl: Targets removed from hotTargets list when targets
+ *  are removed/modified.
+ * ir-tcl.c: More work on triggerResourceControl.
+ *
+ * Revision 1.49  1995/06/30  12:39:21  adam
+ * Bug fix: loadFile didn't set record type.
+ * The MARC routines are a little less strict in the interpretation.
+ * Script display.tcl replaces the old marc.tcl.
+ * New interactive script: shell.tcl.
+ *
+ * Revision 1.48  1995/06/27  19:03:50  adam
+ * Bug fix in do_present in ir-tcl.c: p->set_child member weren't set.
+ * nextResultSetPosition used instead of setOffset.
+ *
+ * Revision 1.47  1995/06/25  10:25:04  adam
+ * Working on triggerResourceControl. Description of compile/install
+ * procedure moved to ir-tcl.sgml.
+ *
+ * Revision 1.46  1995/06/22  13:15:06  adam
+ * Feature: SUTRS. Setting getSutrs implemented.
+ * Work on display formats.
+ * Preferred record syntax can be set by the user.
+ *
+ * Revision 1.45  1995/06/20  08:07:30  adam
+ * New setting: failInfo.
+ * Working on better cancel mechanism.
+ *
+ * Revision 1.44  1995/06/19  17:01:20  adam
  * Minor changes.
  *
  * Revision 1.43  1995/06/19  13:06:08  adam
@@ -169,8 +221,6 @@ 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);
@@ -200,8 +250,7 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj,
     }
     if (!rl)
     {
-        rl = malloc (sizeof(*rl));
-        assert (rl);
+        rl = ir_tcl_malloc (sizeof(*rl));
         rl->next = setobj->record_list;
         rl->no = no;
         setobj->record_list = rl;
@@ -230,6 +279,7 @@ static struct {
 { VAL_AUSMARC,    "AUSMARC" },
 { VAL_IBERMARC,   "IBERMARC" },
 { VAL_SUTRS,      "SUTRS" },
+{ VAL_GRS1,       "GRS1" },
 { 0, NULL }
 };
 
@@ -238,14 +288,9 @@ static struct {
  */
 int IrTcl_eval (Tcl_Interp *interp, const char *command)
 {
-    char *tmp = malloc (strlen(command)+1);
+    char *tmp = ir_tcl_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)
@@ -350,7 +395,8 @@ int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
 
     if (argc <= 0)
         return TCL_OK;
-    Tcl_AppendResult (interp, "Bad method. Possible methods:", NULL);
+    Tcl_AppendResult (interp, "Bad method: ", argv[1], 
+                      ". Possible methods:", NULL);
     for (tab_i = tab; tab_i->tab; tab_i++)
         for (t = tab_i->tab; t->name; t++)
             Tcl_AppendResult (interp, " ", t->name, NULL);
@@ -412,53 +458,6 @@ int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
     return TCL_OK;
 }
 
-/*
- * ir_strdup: Duplicate string
- */
-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)
-    {
-        interp->result = "strdup fail";
-        return TCL_ERROR;
-    }
-    strcpy (*p, s);
-    return TCL_OK;
-}
-
-/*
- * ir_strdel: Delete string
- */
-int ir_strdel (Tcl_Interp *interp, char **p)
-{
-    free (*p);
-    *p = NULL;
-    return TCL_OK;
-}
-
-/*
- * ir_malloc: Malloc function
- */
-void *ir_malloc (Tcl_Interp *interp, size_t size)
-{
-    static char buf[128];
-    void *p = malloc (size);
-
-    if (!p)
-    {
-        sprintf (buf, "Malloc fail. %ld bytes requested", (long) size);
-        interp->result = buf;
-        return NULL;
-    }
-    return p;
-}
-
 static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src)
 {
     if (!src || !*src)
@@ -480,7 +479,7 @@ static void get_referenceId (char **dst, Z_ReferenceId *src)
         *dst = NULL;
 	return;
     }
-    *dst = malloc (src->len+1);
+    *dst = ir_tcl_malloc (src->len+1);
     memcpy (*dst, src->buf, src->len);
     (*dst)[src->len] = '\0';
 }
@@ -496,16 +495,14 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
     Z_APDU *apdu;
     IrTcl_Obj *p = obj;
     Z_InitRequest *req;
-    int r;
 
     if (argc <= 0)
         return TCL_OK;
     if (!p->cs_link)
     {
-        interp->result = "not connected";
+        interp->result = "init: not connected";
         return TCL_ERROR;
     }
-    odr_reset (p->odr_out);
     apdu = zget_APDU (p->odr_out, Z_APDU_initRequest);
     req = apdu->u.initRequest;
 
@@ -551,28 +548,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
     req->implementationVersion = p->implementationVersion;
     req->userInformationField = 0;
 
-    if (!z_APDU (p->odr_out, &apdu, 0))
-    {
-        Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)],
-                          NULL);
-        odr_reset (p->odr_out);
-        return TCL_ERROR;
-    }
-    p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL);
-    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
-    {     
-        interp->result = "cs_put failed in init";
-        do_disconnect (p, NULL, 2, NULL);
-        return TCL_ERROR;
-    }
-    else if (r == 1)
-    {
-        ir_select_add_write (cs_fileno(p->cs_link), p);
-        logf (LOG_DEBUG, "Sent part of initializeRequest (%d bytes)", p->slen);
-    }
-    else
-        logf (LOG_DEBUG, "Sent whole initializeRequest (%d bytes)", p->slen);
-    return TCL_OK;
+    return ir_tcl_send_APDU (interp, p, apdu, "init", argv[0]);
 }
 
 /*
@@ -638,6 +614,7 @@ static int do_options (void *obj, Tcl_Interp *interp,
         ODR_MASK_ZERO (&p->options);
 	ODR_MASK_SET (&p->options, 0);
 	ODR_MASK_SET (&p->options, 1);
+        ODR_MASK_SET (&p->options, 4);
 	ODR_MASK_SET (&p->options, 7);
 	ODR_MASK_SET (&p->options, 14);
 	return TCL_OK;
@@ -646,6 +623,48 @@ static int do_options (void *obj, Tcl_Interp *interp,
 }
 
 /*
+ * do_failInfo: Get fail information
+ */
+static int do_failInfo (void *obj, Tcl_Interp *interp, int argc, char **argv)
+{
+    char buf[16], *cp;
+    IrTcl_Obj *p = obj;
+
+    if (argc <= 0)
+    {
+        p->failInfo = 0;
+	return TCL_OK;
+    }
+    sprintf (buf, "%d", p->failInfo);
+    switch (p->failInfo)
+    {
+    case 0:
+        cp = "ok";
+        break;
+    case IR_TCL_FAIL_CONNECT:
+        cp = "connect failed";
+        break;
+    case IR_TCL_FAIL_READ:
+        cp = "connection closed";
+        break;
+    case IR_TCL_FAIL_WRITE:
+        cp = "connection closed";
+        break;
+    case IR_TCL_FAIL_IN_APDU:
+        cp = "failed to decode incoming APDU";
+        break;
+    case IR_TCL_FAIL_UNKNOWN_APDU:
+        cp = "unknown APDU";
+        break;
+    default:
+        cp = "";
+    } 
+    Tcl_AppendElement (interp, buf);
+    Tcl_AppendElement (interp, cp);
+    return TCL_OK;
+}
+
+/*
  * do_preferredMessageSize: Set/get preferred message size
  */
 static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
@@ -700,14 +719,14 @@ static int do_implementationName (void *obj, Tcl_Interp *interp,
     IrTcl_Obj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->implementationName,
+        return ir_tcl_strdup (interp, &p->implementationName,
                           "Index Data/IrTcl on YAZ");
     else if (argc == -1)
-        return ir_strdel (interp, &p->implementationName);
+        return ir_tcl_strdel (interp, &p->implementationName);
     if (argc == 3)
     {
         free (p->implementationName);
-        if (ir_strdup (interp, &p->implementationName, argv[2])
+        if (ir_tcl_strdup (interp, &p->implementationName, argv[2])
             == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -724,9 +743,9 @@ static int do_implementationId (void *obj, Tcl_Interp *interp,
     IrTcl_Obj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->implementationId, "YAZ (id=81)");
+        return ir_tcl_strdup (interp, &p->implementationId, "YAZ (id=81)");
     else if (argc == -1)
-        return ir_strdel (interp, &p->implementationId);
+        return ir_tcl_strdel (interp, &p->implementationId);
     Tcl_AppendResult (interp, p->implementationId, (char*) NULL);
     return TCL_OK;
 }
@@ -740,10 +759,10 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp,
     IrTcl_Obj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->implementationVersion, 
+        return ir_tcl_strdup (interp, &p->implementationVersion, 
                           "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
     else if (argc == -1)
-        return ir_strdel (interp, &p->implementationVersion);
+        return ir_tcl_strdel (interp, &p->implementationVersion);
     Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
     return TCL_OK;
 }
@@ -755,14 +774,14 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp,
                                         int argc, char **argv)
 {
     IrTcl_Obj *p = obj;
-
+    
     if (argc == 0)
     {
         p->targetImplementationName = NULL;
 	return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &p->targetImplementationName);
+        return ir_tcl_strdel (interp, &p->targetImplementationName);
     Tcl_AppendResult (interp, p->targetImplementationName, (char*) NULL);
     return TCL_OK;
 }
@@ -781,7 +800,7 @@ static int do_targetImplementationId (void *obj, Tcl_Interp *interp,
 	return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &p->targetImplementationId);
+        return ir_tcl_strdel (interp, &p->targetImplementationId);
     Tcl_AppendResult (interp, p->targetImplementationId, (char*) NULL);
     return TCL_OK;
 }
@@ -800,7 +819,7 @@ static int do_targetImplementationVersion (void *obj, Tcl_Interp *interp,
 	return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &p->targetImplementationVersion);
+        return ir_tcl_strdel (interp, &p->targetImplementationVersion);
     Tcl_AppendResult (interp, p->targetImplementationVersion, (char*) NULL);
     return TCL_OK;
 }
@@ -833,19 +852,19 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp,
     {
         if (argc == 3)
         {
-            if (ir_strdup (interp, &p->idAuthenticationOpen, argv[2])
+            if (ir_tcl_strdup (interp, &p->idAuthenticationOpen, argv[2])
                 == TCL_ERROR)
                 return TCL_ERROR;
         }
         else if (argc == 5)
         {
-            if (ir_strdup (interp, &p->idAuthenticationGroupId, argv[2])
+            if (ir_tcl_strdup (interp, &p->idAuthenticationGroupId, argv[2])
                 == TCL_ERROR)
                 return TCL_ERROR;
-            if (ir_strdup (interp, &p->idAuthenticationUserId, argv[3])
+            if (ir_tcl_strdup (interp, &p->idAuthenticationUserId, argv[3])
                 == TCL_ERROR)
                 return TCL_ERROR;
-            if (ir_strdup (interp, &p->idAuthenticationPassword, argv[4])
+            if (ir_tcl_strdup (interp, &p->idAuthenticationPassword, argv[4])
                 == TCL_ERROR)
                 return TCL_ERROR;
         }
@@ -913,7 +932,7 @@ static int do_connect (void *obj, Tcl_Interp *interp,
                               p->cs_type, NULL);
             return TCL_ERROR;
         }
-        if (ir_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
+        if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
         if ((r=cs_connect (p->cs_link, addr)) < 0)
         {
@@ -925,17 +944,15 @@ static int do_connect (void *obj, Tcl_Interp *interp,
         if (r == 1)
         {
             ir_select_add_write (cs_fileno (p->cs_link), p);
-            p->connectFlag = 1;
+            p->state = IR_TCL_R_Connecting;
         }
         else
         {
-            p->connectFlag = 0;
+            p->state = IR_TCL_R_Idle;
             if (p->callback)
                 IrTcl_eval (p->interp, p->callback);
         }
     }
-    if (p->hostname)
-        Tcl_AppendElement (interp, p->hostname);
     return TCL_OK;
 }
 
@@ -949,7 +966,7 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
 
     if (argc == 0)
     {
-        p->connectFlag = 0;
+        p->state = IR_TCL_R_Idle;
         p->hostname = NULL;
 	p->cs_link = NULL;
         return TCL_OK;
@@ -968,12 +985,14 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
         ODR_MASK_ZERO (&p->options);
 	ODR_MASK_SET (&p->options, 0);
 	ODR_MASK_SET (&p->options, 1);
+	ODR_MASK_SET (&p->options, 4);
 	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);
+        ir_tcl_del_q (p);
     }
     assert (!p->cs_link);
     return TCL_OK;
@@ -988,19 +1007,36 @@ static int do_comstack (void *o, Tcl_Interp *interp,
     IrTcl_Obj *obj = o;
 
     if (argc == 0)
-        return ir_strdup (interp, &obj->cs_type, "tcpip");
+        return ir_tcl_strdup (interp, &obj->cs_type, "tcpip");
     else if (argc == -1)
-        return ir_strdel (interp, &obj->cs_type);
+        return ir_tcl_strdel (interp, &obj->cs_type);
     else if (argc == 3)
     {
         free (obj->cs_type);
-        if (ir_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR)
+        if (ir_tcl_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
     Tcl_AppendElement (interp, obj->cs_type);
     return TCL_OK;
 }
 
+/*
+ * do_logLevel: Set log level
+ */
+static int do_logLevel (void *o, Tcl_Interp *interp,
+                        int argc, char **argv)
+{
+    if (argc <= 2)
+        return TCL_OK;
+    if (argc == 3)
+        log_init (log_mask_str (argv[2]), "", NULL);
+    else if (argc == 4)
+        log_init (log_mask_str (argv[2]), argv[3], NULL);
+    else if (argc == 5)
+        log_init (log_mask_str (argv[2]), argv[3], argv[4]);
+    return TCL_OK;
+}
+
 
 /*
  * do_callback: add callback
@@ -1016,18 +1052,17 @@ static int do_callback (void *obj, Tcl_Interp *interp,
 	return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &p->callback);
+        return ir_tcl_strdel (interp, &p->callback);
     if (argc == 3)
     {
         free (p->callback);
 	if (argv[2][0])
 	{
-            if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
+            if (ir_tcl_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
                 return TCL_ERROR;
 	}
 	else
 	    p->callback = NULL;
-        p->interp = interp;
     }
     return TCL_OK;
 }
@@ -1046,18 +1081,17 @@ static int do_failback (void *obj, Tcl_Interp *interp,
 	return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &p->failback);
+        return ir_tcl_strdel (interp, &p->failback);
     else if (argc == 3)
     {
         free (p->failback);
 	if (argv[2][0])
 	{
-            if (ir_strdup (interp, &p->failback, argv[2]) == TCL_ERROR)
+            if (ir_tcl_strdup (interp, &p->failback, argv[2]) == TCL_ERROR)
                 return TCL_ERROR;
 	}
 	else
 	    p->failback = NULL;
-        p->interp = interp;
     }
     return TCL_OK;
 }
@@ -1100,6 +1134,33 @@ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv)
 }
 
 /*
+ * do_triggerResourceControl:
+ */
+static int do_triggerResourceControl (void *obj, Tcl_Interp *interp,
+                                      int argc, char **argv)
+{
+    IrTcl_Obj *p = obj;
+    Z_APDU *apdu;
+    Z_TriggerResourceControlRequest *req;
+    bool_t is_false = 0;
+
+    if (argc <= 0)
+        return TCL_OK;
+    if (!p->cs_link)
+    {
+        interp->result = "triggerResourceControl: not connected";
+        return TCL_ERROR;
+    }
+    apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest);
+    req = apdu->u.triggerResourceControlRequest;
+    *req->requestedAction = Z_TriggerResourceCtrl_cancel;
+    req->resultSetWanted = &is_false; 
+    
+    return ir_tcl_send_APDU (interp, p, apdu, "triggerResourceControl",
+                             argv[0]);
+}
+
+/*
  * do_databaseNames: specify database names
  */
 static int do_databaseNames (void *obj, Tcl_Interp *interp,
@@ -1133,12 +1194,11 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp,
         free (p->databaseNames);
     }
     p->num_databaseNames = argc - 2;
-    if (!(p->databaseNames = ir_malloc (interp, 
-          sizeof(*p->databaseNames) * p->num_databaseNames)))
-        return TCL_ERROR;
+    p->databaseNames =
+        ir_tcl_malloc (sizeof(*p->databaseNames) * p->num_databaseNames);
     for (i=0; i<p->num_databaseNames; i++)
     {
-        if (ir_strdup (interp, &p->databaseNames[i], argv[2+i]) 
+        if (ir_tcl_strdup (interp, &p->databaseNames[i], argv[2+i]) 
             == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1170,13 +1230,13 @@ static int do_queryType (void *obj, Tcl_Interp *interp,
     IrTcl_SetCObj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->queryType, "rpn");
+        return ir_tcl_strdup (interp, &p->queryType, "rpn");
     else if (argc == -1)
-        return ir_strdel (interp, &p->queryType);
+        return ir_tcl_strdel (interp, &p->queryType);
     if (argc == 3)
     {
         free (p->queryType);
-        if (ir_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR)
+        if (ir_tcl_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
     Tcl_AppendResult (interp, p->queryType, NULL);
@@ -1197,7 +1257,7 @@ static int do_userInformationField (void *obj, Tcl_Interp *interp,
 	return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &p->userInformationField);
+        return ir_tcl_strdel (interp, &p->userInformationField);
     Tcl_AppendResult (interp, p->userInformationField, NULL);
     return TCL_OK;
 }
@@ -1264,11 +1324,11 @@ static int do_referenceId (void *obj, Tcl_Interp *interp,
         return TCL_OK;
     }
     else if (argc == -1)
-        return ir_strdel (interp, &p->referenceId);
+        return ir_tcl_strdel (interp, &p->referenceId);
     if (argc == 3)
     {
         free (p->referenceId);
-        if (ir_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR)
+        if (ir_tcl_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
     Tcl_AppendResult (interp, p->referenceId, NULL);
@@ -1299,16 +1359,19 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp,
         free (p->preferredRecordSyntax);
         p->preferredRecordSyntax = NULL;
         if (argv[2][0] && (p->preferredRecordSyntax = 
-                           malloc (sizeof(*p->preferredRecordSyntax))))
+                           ir_tcl_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 },
 { 0, "failback",                    do_failback },
+{ 0, "failInfo",                    do_failInfo },
+{ 0, "logLevel",                    do_logLevel },
 
 { 1, "connect",                     do_connect },
 { 0, "protocolVersion",             do_protocolVersion },
@@ -1327,6 +1390,7 @@ static IrTcl_Method ir_method_tab[] = {
 { 0, "initResult",                  do_initResult },
 { 0, "disconnect",                  do_disconnect },
 { 0, "callback",                    do_callback },
+{ 0, "triggerResourceControl",      do_triggerResourceControl },
 { 0, NULL, NULL}
 };
 
@@ -1376,6 +1440,7 @@ static void ir_obj_delete (ClientData clientData)
         return;
     assert (obj->ref_count == 0);
 
+    logf (LOG_DEBUG, "ir object delete");
     tab[0].tab = ir_method_tab;
     tab[0].obj = obj;
     tab[1].tab = ir_set_c_method_tab;
@@ -1383,11 +1448,11 @@ static void ir_obj_delete (ClientData clientData)
     tab[2].tab = NULL;
 
     ir_method (NULL, -1, NULL, tab);
+
+    ir_tcl_del_q (obj);
     odr_destroy (obj->odr_in);
     odr_destroy (obj->odr_out);
     odr_destroy (obj->odr_pr);
-    free (obj->buf_out);
-    free (obj->buf_in);
     free (obj);
 }
 
@@ -1408,9 +1473,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
         interp->result = "wrong # args";
         return TCL_ERROR;
     }
-    if (!(obj = ir_malloc (interp, sizeof(*obj))))
-        return TCL_ERROR;
-
+    obj = ir_tcl_malloc (sizeof(*obj));
     obj->ref_count = 1;
 #if CCL2RPN
     obj->bibset = ccl_qual_mk (); 
@@ -1421,17 +1484,16 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
     }
 #endif
 
+    logf (LOG_DEBUG, "ir object create");
     obj->odr_in = odr_createmem (ODR_DECODE);
     obj->odr_out = odr_createmem (ODR_ENCODE);
     obj->odr_pr = odr_createmem (ODR_PRINT);
-
-    obj->len_out = 10000;
-    if (!(obj->buf_out = ir_malloc (interp, obj->len_out)))
-        return TCL_ERROR;
-    odr_setbuf (obj->odr_out, obj->buf_out, obj->len_out, 0);
+    obj->state = IR_TCL_R_Idle;
+    obj->interp = interp;
 
     obj->len_in = 0;
     obj->buf_in = NULL;
+    obj->request_queue = NULL;
 
     tab[0].tab = ir_method_tab;
     tab[0].obj = obj;
@@ -1457,14 +1519,14 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
     Z_APDU *apdu;
     Odr_oct ccl_query;
     IrTcl_SetObj *obj = o;
-    IrTcl_Obj *p = obj->parent;
+    IrTcl_Obj *p;
     int r;
     oident bib1;
 
     if (argc <= 0)
         return TCL_OK;
 
-    p->set_child = o;
+    p = obj->parent;
     if (argc != 3)
     {
         interp->result = "wrong # args";
@@ -1477,10 +1539,9 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
     }
     if (!p->cs_link)
     {
-        interp->result = "not connected";
+        interp->result = "search: not connected";
         return TCL_ERROR;
     }
-    odr_reset (p->odr_out);
     apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest);
     req = apdu->u.searchRequest;
 
@@ -1510,6 +1571,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         ident.proto = p->protocol_type;
         ident.class = CLASS_RECSYN;
         ident.value = *obj->set_inher.preferredRecordSyntax;
+        logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
         req->preferredRecordSyntax = odr_oiddup (p->odr_out, 
                                                  oid_getoidbyent (&ident));
     }
@@ -1569,28 +1631,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         interp->result = "unknown query method";
         return TCL_ERROR;
     }
-    if (!z_APDU (p->odr_out, &apdu, 0))
-    {
-        interp->result = odr_errlist [odr_geterror (p->odr_out)];
-        odr_reset (p->odr_out);
-        return TCL_ERROR;
-    } 
-    p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL);
-    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
-    {
-        interp->result = "cs_put failed in search";
-        return TCL_ERROR;
-    }
-    else if (r == 1)
-    {
-        ir_select_add_write (cs_fileno(p->cs_link), p);
-        logf (LOG_DEBUG, "Sent part of searchRequest (%d bytes)", p->slen);
-    }
-    else
-    {
-        logf (LOG_DEBUG, "Whole search request (%d bytes)", p->slen);
-    }
-    return TCL_OK;
+    return ir_tcl_send_APDU (interp, p, apdu, "search", argv[0]);
 }
 
 /*
@@ -1642,7 +1683,10 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp,
     IrTcl_SetObj *obj = o;
 
     if (argc <= 0)
+    {
+        obj->nextResultSetPosition = 0;
         return TCL_OK;
+    }
     return get_set_int (&obj->nextResultSetPosition, interp, argc, argv);
 }
 
@@ -1655,13 +1699,13 @@ static int do_setName (void *o, Tcl_Interp *interp,
     IrTcl_SetObj *obj = o;
 
     if (argc == 0)
-        return ir_strdup (interp, &obj->setName, "Default");
+        return ir_tcl_strdup (interp, &obj->setName, "Default");
     else if (argc == -1)
-        return ir_strdel (interp, &obj->setName);
+        return ir_tcl_strdel (interp, &obj->setName);
     if (argc == 3)
     {
         free (obj->setName);
-        if (ir_strdup (interp, &obj->setName, argv[2])
+        if (ir_tcl_strdup (interp, &obj->setName, argv[2])
             == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1856,6 +1900,76 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
     return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv);
 }
 
+/*
+ * do_getSutrs: Get SUTRS Record
+ */
+static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_SetObj *obj = o;
+    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_SUTRS)
+        return TCL_OK;
+    Tcl_AppendElement (interp, rl->u.dbrec.buf);
+    return TCL_OK;
+}
+
+
+/*
+ * do_getGrs: Get a GRS1 Record
+ */
+static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_SetObj *obj = o;
+    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_GRS1)
+        return TCL_OK;
+    return ir_tcl_get_grs (interp, rl->u.dbrec.u.grs1, argc, argv);
+}
+
 
 /*
  * do_responseStatus: Return response status (present or search)
@@ -1900,16 +2014,14 @@ static int do_responseStatus (void *o, Tcl_Interp *interp,
  * do_present: Perform Present Request
  */
 
-static int do_present (void *o, Tcl_Interp *interp,
-                       int argc, char **argv)
+static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
     IrTcl_SetObj *obj = o;
-    IrTcl_Obj *p = obj->parent;
+    IrTcl_Obj *p;
     Z_APDU *apdu;
     Z_PresentRequest *req;
     int start;
     int number;
-    int r;
 
     if (argc <= 0)
         return TCL_OK;
@@ -1927,12 +2039,13 @@ static int do_present (void *o, Tcl_Interp *interp,
     }
     else 
         number = 10;
+    p = obj->parent;
     if (!p->cs_link)
     {
-        interp->result = "not connected";
+        interp->result = "present: not connected";
         return TCL_ERROR;
     }
-    odr_reset (p->odr_out);
+
     obj->start = start;
     obj->number = number;
 
@@ -1946,32 +2059,21 @@ static int do_present (void *o, Tcl_Interp *interp,
     
     req->resultSetStartPoint = &start;
     req->numberOfRecordsRequested = &number;
-    req->preferredRecordSyntax = 0;
-
-    if (!z_APDU (p->odr_out, &apdu, 0))
-    {
-        interp->result = odr_errlist [odr_geterror (p->odr_out)];
-        odr_reset (p->odr_out);
-        return TCL_ERROR;
-    } 
-    p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL);
-    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
-    {
-        interp->result = "cs_put failed in present";
-        return TCL_ERROR;
-    }
-    else if (r == 1)
+    if (obj->set_inher.preferredRecordSyntax)
     {
-        ir_select_add_write (cs_fileno(p->cs_link), p);
-        logf (LOG_DEBUG, "Part of present request, start=%d, num=%d" 
-              " (%d bytes)", start, number, p->slen);
+        struct oident ident;
+
+        ident.proto = p->protocol_type;
+        ident.class = CLASS_RECSYN;
+        ident.value = *obj->set_inher.preferredRecordSyntax;
+        logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
+        req->preferredRecordSyntax = odr_oiddup (p->odr_out, 
+                                                 oid_getoidbyent (&ident));
     }
     else
-    {
-        logf (LOG_DEBUG, "Whole present request, start=%d, num=%d"
-              " (%d bytes)", start, number, p->slen);
-    }
-    return TCL_OK;
+        req->preferredRecordSyntax = 0;
+     
+    return ir_tcl_send_APDU (interp, p, apdu, "present", argv[0]);
 }
 
 /*
@@ -2005,6 +2107,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp,
         IrTcl_RecordList *rl;
 
         rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord);
+        rl->u.dbrec.type = VAL_USMARC;
         rl->u.dbrec.buf = buf;
 	rl->u.dbrec.size = size;
         no++;
@@ -2025,6 +2128,8 @@ static IrTcl_Method ir_set_method_tab[] = {
     { 0, "present",                 do_present },
     { 0, "type",                    do_type },
     { 0, "getMarc",                 do_getMarc },
+    { 0, "getSutrs",                do_getSutrs },
+    { 0, "getGrs",                  do_getGrs },
     { 0, "recordType",              do_recordType },
     { 0, "diag",                    do_diag },
     { 0, "responseStatus",          do_responseStatus },
@@ -2063,6 +2168,8 @@ static void ir_set_obj_delete (ClientData clientData)
     IrTcl_Methods tabs[3];
     IrTcl_SetObj *p = clientData;
 
+    logf (LOG_DEBUG, "ir set delete");
+
     tabs[0].tab = ir_set_method_tab;
     tabs[0].obj = p;
     tabs[1].tab = ir_set_c_method_tab;
@@ -2088,9 +2195,9 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
         interp->result = "wrong # args";
         return TCL_ERROR;
     }
-    if (!(obj = ir_malloc (interp, sizeof(*obj))))
-        return TCL_ERROR;
-    else if (argc == 3)
+    obj = ir_tcl_malloc (sizeof(*obj));
+    logf (LOG_DEBUG, "ir set create");
+    if (argc == 3)
     {
         Tcl_CmdInfo parent_info;
         int i;
@@ -2107,28 +2214,27 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
         dst = &obj->set_inher;
         src = &obj->parent->set_inher;
 
-        dst->num_databaseNames = src->num_databaseNames;
-        if (!(dst->databaseNames =
-              ir_malloc (interp, sizeof (*dst->databaseNames)
-                         * dst->num_databaseNames)))
-            return TCL_ERROR;
+        if ((dst->num_databaseNames = src->num_databaseNames))
+            dst->databaseNames =
+                ir_tcl_malloc (sizeof (*dst->databaseNames)
+                               * dst->num_databaseNames);
+        else
+            dst->databaseNames = NULL;
         for (i = 0; i < dst->num_databaseNames; i++)
-        {
-            if (ir_strdup (interp, &dst->databaseNames[i],
+            if (ir_tcl_strdup (interp, &dst->databaseNames[i],
                            src->databaseNames[i]) == TCL_ERROR)
                 return TCL_ERROR;
-        }
-        if (ir_strdup (interp, &dst->queryType, src->queryType)
+        if (ir_tcl_strdup (interp, &dst->queryType, src->queryType)
             == TCL_ERROR)
             return TCL_ERROR;
 
-        if (ir_strdup (interp, &dst->referenceId, src->referenceId)
+        if (ir_tcl_strdup (interp, &dst->referenceId, src->referenceId)
             == TCL_ERROR)
             return TCL_ERROR;
 
         if (src->preferredRecordSyntax && 
             (dst->preferredRecordSyntax 
-             = malloc (sizeof(*dst->preferredRecordSyntax))))
+             = ir_tcl_malloc (sizeof(*dst->preferredRecordSyntax))))
             *dst->preferredRecordSyntax = *src->preferredRecordSyntax;
         else
             dst->preferredRecordSyntax = NULL;
@@ -2163,7 +2269,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
     Z_APDU *apdu;
     IrTcl_ScanObj *obj = o;
     IrTcl_Obj *p = obj->parent;
-    int r;
     oident bib1;
 #if CCL2RPN
     struct ccl_rpn_node *rpn;
@@ -2172,7 +2277,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
 
     if (argc <= 0)
         return TCL_OK;
-    p->scan_child = o;
     if (argc != 3)
     {
         interp->result = "wrong # args";
@@ -2185,10 +2289,9 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
     }
     if (!p->cs_link)
     {
-        interp->result = "not connected";
+        interp->result = "scan: not connected";
 	return TCL_ERROR;
     }
-    odr_reset (p->odr_out);
 
     bib1.proto = p->protocol_type;
     bib1.class = CLASS_ATTSET;
@@ -2228,29 +2331,8 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
           *req->numberOfTermsRequested);
     logf (LOG_DEBUG, "preferredPositionInResponse=%d",
           *req->preferredPositionInResponse);
-
-    if (!z_APDU (p->odr_out, &apdu, 0))
-    {
-        interp->result = odr_errlist [odr_geterror (p->odr_out)];
-        odr_reset (p->odr_out);
-        return TCL_ERROR;
-    } 
-    p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL);
-    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
-    {
-        interp->result = "cs_put failed in scan";
-        return TCL_ERROR;
-    }
-    else if (r == 1)
-    {
-        ir_select_add_write (cs_fileno(p->cs_link), p);
-        logf (LOG_DEBUG, "Sent part of scanRequest (%d bytes)", p->slen);
-    }
-    else
-    {
-        logf (LOG_DEBUG, "Whole scan request (%d bytes)", p->slen);
-    }
-    return TCL_OK;
+    
+    return ir_tcl_send_APDU (interp, p, apdu, "scan", argv[0]);
 }
 
 /*
@@ -2465,9 +2547,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp,
         interp->result = "No parent";
 	return TCL_ERROR;
     }
-    if (!(obj = ir_malloc (interp, sizeof(*obj))))
-        return TCL_ERROR;
-
+    obj = ir_tcl_malloc (sizeof(*obj));
     obj->parent = (IrTcl_Obj *) parent_info.clientData;
 
     tabs[0].tab = ir_scan_method_tab;
@@ -2496,13 +2576,13 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
     get_referenceId (&p->set_inher.referenceId, initrs->referenceId);
 
     free (p->targetImplementationId);
-    ir_strdup (p->interp, &p->targetImplementationId,
+    ir_tcl_strdup (p->interp, &p->targetImplementationId,
                initrs->implementationId);
     free (p->targetImplementationName);
-    ir_strdup (p->interp, &p->targetImplementationName,
+    ir_tcl_strdup (p->interp, &p->targetImplementationName,
                initrs->implementationName);
     free (p->targetImplementationVersion);
-    ir_strdup (p->interp, &p->targetImplementationVersion,
+    ir_tcl_strdup (p->interp, &p->targetImplementationVersion,
                initrs->implementationVersion);
 
     p->maximumRecordSize = *initrs->maximumRecordSize;
@@ -2519,9 +2599,9 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
 
         if (initrs->userInformationField->which == ODR_EXTERNAL_octet && 
             (p->userInformationField =
-             malloc ((len = 
-                      initrs->userInformationField->u.octet_aligned->len)
-                     +1)))
+             ir_tcl_malloc ((len = 
+                             initrs->userInformationField->
+                             u.octet_aligned->len) +1)))
         {
             memcpy (p->userInformationField,
                     initrs->userInformationField->u.octet_aligned->buf,
@@ -2548,12 +2628,7 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
     char *addinfo;
 
     *dst_num = num;
-    *dst_list = malloc (sizeof(**dst_list) * num);
-    if (!*dst_list) 
-    {
-        *dst_num = 0;
-        return;
-    }
+    *dst_list = ir_tcl_malloc (sizeof(**dst_list) * num);
     for (i = 0; i<num; i++)
     {
         switch (list[i]->which)
@@ -2562,7 +2637,7 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
             (*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)))
+                ((*dst_list)[i].addinfo = ir_tcl_malloc (strlen(addinfo)+1)))
                 strcpy ((*dst_list)[i].addinfo, addinfo);
             break;
         default:
@@ -2572,10 +2647,9 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
     }
 }
 
-static void ir_handleRecords (void *o, Z_Records *zrs)
+static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj)
 {
     IrTcl_Obj *p = o;
-    IrTcl_SetObj *setobj = p->set_child;
 
     int offset;
     IrTcl_RecordList *rl;
@@ -2606,24 +2680,43 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
             else
             {
                 Z_DatabaseRecord *zr; 
-                Odr_external *oe;
+                Z_External *oe;
+                struct oident *ident;
                 
                 zr = zrs->u.databaseOrSurDiagnostics->records[offset]
                     ->u.databaseRecord;
-                oe = (Odr_external*) zr;
+                oe = (Z_External*) zr;
 		rl->u.dbrec.size = zr->u.octet_aligned->len;
-                rl->u.dbrec.type = VAL_USMARC;
+
+                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)
                 {
-                    const char *buf = (char*) zr->u.octet_aligned->buf;
-                    if ((rl->u.dbrec.buf = malloc (rl->u.dbrec.size)))
+                    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);
-                    if (oe->direct_reference)
+                }
+                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)))
                     {
-                        struct oident *ident = 
-                            oid_getentbyoid (oe->direct_reference);
-                        rl->u.dbrec.type = ident->value;
+                        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_read_grs (oe->u.grs1, &rl->u.dbrec.u.grs1);
+                    rl->u.dbrec.buf = NULL;
                 }
                 else
                     rl->u.dbrec.buf = NULL;
@@ -2651,10 +2744,9 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
     }
 }
 
-static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
+static void ir_searchResponse (void *o, Z_SearchResponse *searchrs,
+                               IrTcl_SetObj *setobj)
 {    
-    IrTcl_Obj *p = o;
-    IrTcl_SetObj *setobj = p->set_child;
     Z_Records *zrs = searchrs->records;
 
     logf (LOG_DEBUG, "Received search response");
@@ -2674,16 +2766,15 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
     logf (LOG_DEBUG, "Search response %d, %d hits", 
           setobj->searchStatus, setobj->resultCount);
     if (zrs)
-        ir_handleRecords (o, zrs);
+        ir_handleRecords (o, zrs, setobj);
     else
         setobj->recordFlag = 0;
 }
 
 
-static void ir_presentResponse (void *o, Z_PresentResponse *presrs)
+static void ir_presentResponse (void *o, Z_PresentResponse *presrs,
+                                IrTcl_SetObj *setobj)
 {
-    IrTcl_Obj *p = o;
-    IrTcl_SetObj *setobj = p->set_child;
     Z_Records *zrs = presrs->records;
     
     logf (LOG_DEBUG, "Received present response");
@@ -2696,7 +2787,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);
+        ir_handleRecords (o, zrs, setobj);
     else
     {
         setobj->recordFlag = 0;
@@ -2704,10 +2795,10 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs)
     }
 }
 
-static void ir_scanResponse (void *o, Z_ScanResponse *scanrs)
+static void ir_scanResponse (void *o, Z_ScanResponse *scanrs,
+                             IrTcl_ScanObj *scanobj)
 {
     IrTcl_Obj *p = o;
-    IrTcl_ScanObj *scanobj = p->scan_child;
     
     logf (LOG_DEBUG, "Received scanResponse");
 
@@ -2745,7 +2836,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs)
 	{
 	case Z_ListEntries_entries:
 	    scanobj->num_entries = scanrs->entries->u.entries->num_entries;
-	    scanobj->entries = malloc (scanobj->num_entries * 
+	    scanobj->entries = ir_tcl_malloc (scanobj->num_entries * 
 	                               sizeof(*scanobj->entries));
             for (i=0; i<scanobj->num_entries; i++)
 	    {
@@ -2757,7 +2848,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs)
 		    if (ze->u.termInfo->term->which == Z_Term_general)
 		    {
                         int l = ze->u.termInfo->term->u.general->len;
-                        scanobj->entries[i].u.term.buf = malloc (1+l);
+                        scanobj->entries[i].u.term.buf = ir_tcl_malloc (1+l);
 			memcpy (scanobj->entries[i].u.term.buf, 
 			        ze->u.termInfo->term->u.general->buf,
                                 l);
@@ -2802,8 +2893,11 @@ void ir_select_read (ClientData clientData)
     IrTcl_Obj *p = clientData;
     Z_APDU *apdu;
     int r;
+    IrTcl_Request *rq;
+    char *object_name;
+    Tcl_CmdInfo cmd_info;
 
-    if (p->connectFlag)
+    if (p->state == IR_TCL_R_Connecting)
     {
         r = cs_rcvconnect (p->cs_link);
         if (r == 1)
@@ -2811,82 +2905,127 @@ void ir_select_read (ClientData clientData)
             logf (LOG_WARN, "cs_rcvconnect returned 1");
             return;
         }
-        p->connectFlag = 0;
+        p->state = IR_TCL_R_Idle;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         if (r < 0)
         {
             logf (LOG_DEBUG, "cs_rcvconnect error");
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_CONNECT;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
             return;
         }
+        p->state = IR_TCL_R_Idle;
         if (p->callback)
 	    IrTcl_eval (p->interp, p->callback);
+        if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
+            ir_tcl_send_q (p, p->request_queue, "x");
         return;
     }
     do
     {
 	/* signal one more use of ir object - callbacks must not
 	   release the ir memory (p pointer) */
+        p->state = IR_TCL_R_Reading;
 	++(p->ref_count);
+
+        /* read incoming APDU */
         if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 0)
         {
             logf (LOG_DEBUG, "cs_get failed, code %d", r);
             ir_select_remove (cs_fileno (p->cs_link), p);
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_READ;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
 
-	    /* relase ir object now if callback deleted it */
+	    /* release ir object now if callback deleted it */
 	    ir_obj_delete (p);
             return;
         }        
         if (r == 1)
             return ;
+        /* got complete APDU. Now decode */
         odr_setbuf (p->odr_in, p->buf_in, r, 0);
         logf (LOG_DEBUG, "cs_get ok, got %d", r);
         if (!z_APDU (p->odr_in, &apdu, 0))
         {
             logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]);
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_IN_APDU;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
 
 	    /* release ir object now if failback deleted it */
 	    ir_obj_delete (p);
             return;
         }
-        switch(apdu->which)
+        /* handle APDU and invoke callback */
+        rq = p->request_queue;
+        if (!rq)
         {
-        case Z_APDU_initResponse:
-            ir_initResponse (p, apdu->u.initResponse);
-            break;
-        case Z_APDU_searchResponse:
-            ir_searchResponse (p, apdu->u.searchResponse);
-            break;
-        case Z_APDU_presentResponse:
-            ir_presentResponse (p, apdu->u.presentResponse);
-            break;
-        case Z_APDU_scanResponse:
-            ir_scanResponse (p, apdu->u.scanResponse);
-            break;
-        default:
-            logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which);
-            if (p->failback)
-                IrTcl_eval (p->interp, p->failback);
-            do_disconnect (p, NULL, 2, NULL);
+            logf (LOG_FATAL, "Internal error. No queue entry");
+            exit (1);
+        }
+        object_name = rq->object_name;
+        logf (LOG_DEBUG, "getCommandInfo (%s)", object_name);
+        if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info))
+        {
+            switch(apdu->which)
+            {
+            case Z_APDU_initResponse:
+                ir_initResponse (p, apdu->u.initResponse);
+                break;
+            case Z_APDU_searchResponse:
+                ir_searchResponse (p, apdu->u.searchResponse,
+                                   (IrTcl_SetObj *) cmd_info.clientData);
+                break;
+            case Z_APDU_presentResponse:
+                ir_presentResponse (p, apdu->u.presentResponse,
+                                    (IrTcl_SetObj *) cmd_info.clientData);
+                break;
+            case Z_APDU_scanResponse:
+                ir_scanResponse (p, apdu->u.scanResponse, 
+                                 (IrTcl_ScanObj *) cmd_info.clientData);
+                break;
+            default:
+                logf (LOG_WARN, "Received unknown APDU type (%d)",
+                      apdu->which);
+                if (p->failback)
+                {
+                    p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
+                    IrTcl_eval (p->interp, p->failback);
+                }
+                do_disconnect (p, NULL, 2, NULL);
+                return;
+            }
         }
+        p->request_queue = rq->next;
+        p->state = IR_TCL_R_Idle;
+        
+        if (rq->callback)
+            IrTcl_eval (p->interp, rq->callback);
+        free (rq->buf_out);
+        free (rq->callback);
+        free (rq->object_name);
+        free (rq);
         odr_reset (p->odr_in);
-        if (p->callback)
-	    IrTcl_eval (p->interp, p->callback);
 	if (p->ref_count == 1)
 	{
 	    ir_obj_delete (p);
 	    return;
 	}
 	--(p->ref_count);
-    } while (p->cs_link && cs_more (p->cs_link));    
+    } while (p->cs_link && cs_more (p->cs_link));
+    if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
+        ir_tcl_send_q (p, p->request_queue, "x");
 }
 
 /*
@@ -2896,20 +3035,24 @@ void ir_select_write (ClientData clientData)
 {
     IrTcl_Obj *p = clientData;
     int r;
+    IrTcl_Request *rq;
 
     logf (LOG_DEBUG, "In write handler");
-    if (p->connectFlag)
+    if (p->state == IR_TCL_R_Connecting)
     {
         r = cs_rcvconnect (p->cs_link);
         if (r == 1)
             return;
-        p->connectFlag = 0;
+        p->state = IR_TCL_R_Idle;
         if (r < 0)
         {
             logf (LOG_DEBUG, "cs_rcvconnect error");
             ir_select_remove_write (cs_fileno (p->cs_link), p);
             if (p->failback)
+            {
+                p->failInfo = IR_TCL_FAIL_CONNECT;
                 IrTcl_eval (p->interp, p->failback);
+            }
             do_disconnect (p, NULL, 2, NULL);
             return;
         }
@@ -2918,25 +3061,35 @@ void ir_select_write (ClientData clientData)
 	    IrTcl_eval (p->interp, p->callback);
         return;
     }
-    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
-    {   
+    rq = p->request_queue;
+    assert (rq);
+    if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0)
+    {
         logf (LOG_DEBUG, "select write fail");
         if (p->failback)
+        {
+            p->failInfo = IR_TCL_FAIL_WRITE;
             IrTcl_eval (p->interp, p->failback);
+        }
+        free (rq->buf_out);
+        rq->buf_out = NULL;
         do_disconnect (p, NULL, 2, NULL);
     }
     else if (r == 0)            /* remove select bit */
     {
+        p->state = IR_TCL_R_Waiting;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
+        free (rq->buf_out);
+        rq->buf_out = NULL;
     }
 }
 
 /* ------------------------------------------------------- */
 
 /*
- * ir_tcl_init: Registration of TCL commands.
+ * Irtcl_init: Registration of TCL commands.
  */
-int ir_tcl_init (Tcl_Interp *interp)
+int Irtcl_Init (Tcl_Interp *interp)
 {
     Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL,
                        (Tcl_CmdDeleteProc *) NULL);
@@ -2944,8 +3097,6 @@ 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;
 }
 
-