The Tcl_File structure is only manipulated in the Tk-event interface
[ir-tcl-moved-to-github.git] / ir-tcl.c
index f397668..2ac5a47 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,33 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.80  1996-02-23 17:31:39  adam
+ * Revision 1.86  1996-03-20 13:54:04  adam
+ * The Tcl_File structure is only manipulated in the Tk-event interface
+ * in tkinit.c.
+ *
+ * Revision 1.85  1996/03/15  11:15:48  adam
+ * Modified to use new prototypes for p_query_rpn and p_query_scan.
+ *
+ * Revision 1.84  1996/03/07  12:42:49  adam
+ * Better logging when callback is invoked.
+ *
+ * Revision 1.83  1996/03/05  09:21:09  adam
+ * Bug fix: memory used by GRS records wasn't freed.
+ * Rewrote some of the error handling code - the connection is always
+ * closed before failback is called.
+ * If failback is defined the send APDU methods (init, search, ...) will
+ * return OK but invoke failback (as is the case if the write operation
+ * fails).
+ * Bug fix: ref_count in assoc object could grow if fraction of PDU was
+ * read.
+ *
+ * Revision 1.82  1996/02/29  15:30:21  adam
+ * Export of IrTcl functionality to extensions.
+ *
+ * Revision 1.81  1996/02/26  18:38:32  adam
+ * Work on export of set methods.
+ *
+ * Revision 1.80  1996/02/23  17:31:39  adam
  * More functions made available to the wais tcl extension.
  *
  * Revision 1.79  1996/02/23  13:41:38  adam
 
 #define CS_BLOCK 0
 
-#define IRTCL_GENERIC_FILES 0
-
 #include "ir-tclp.h"
 
 static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num);
-static int do_disconnect (void *obj, Tcl_Interp *interp, 
-                          int argc, char **argv);
 
 static void ir_select_notify (ClientData clientData, int r, int w, int e);
 
@@ -321,6 +343,29 @@ void ir_select_remove_write (int fd, void *obj)
     ir_tcl_select_set (ir_select_notify, fd, obj, 1, 0, 0);
 }
 
+static void delete_IR_record (IrTcl_RecordList *rl)
+{
+    switch (rl->which)
+    {
+    case Z_NamePlusRecord_databaseRecord:
+        switch (rl->u.dbrec.type)
+        {
+        case VAL_GRS1:
+            ir_tcl_grs_del (&rl->u.dbrec.u.grs1);
+            break;
+        default:
+            break;
+        }
+        free (rl->u.dbrec.buf);
+        break;
+    case Z_NamePlusRecord_surrogateDiagnostic:
+        ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
+                        &rl->u.surrogateDiagnostics.num);
+        break;
+    }
+    free (rl->elements);
+}
+
 static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, 
                                         int no, int which, 
                                         const char *elements)
@@ -334,18 +379,7 @@ static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj,
         if (no == rl->no && (!rl->elements || !elements ||
                              !strcmp(elements, rl->elements)))
         {
-            free (rl->elements);
-            switch (rl->which)
-            {
-            case Z_NamePlusRecord_databaseRecord:
-                free (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;
-            }
+            delete_IR_record (rl);
             break;
         }
     }
@@ -369,6 +403,7 @@ int ir_tcl_eval (Tcl_Interp *interp, const char *command)
     char *tmp = ir_tcl_malloc (strlen(command)+1);
     int r;
 
+    logf (LOG_DEBUG, "Invoking %.23s ...", command);
     strcpy (tmp, command);
     r = Tcl_Eval (interp, tmp);
     if (r == TCL_ERROR)
@@ -425,16 +460,7 @@ static void delete_IR_records (IrTcl_SetObj *setobj)
 
     for (rl = setobj->record_list; rl; rl = rl1)
     {
-        switch (rl->which)
-        {
-        case Z_NamePlusRecord_databaseRecord:
-            free (rl->u.dbrec.buf);
-            break;
-        case Z_NamePlusRecord_surrogateDiagnostic:
-            ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
-                            &rl->u.surrogateDiagnostics.num);
-            break;
-        }
+        delete_IR_record (rl);
         rl1 = rl->next;
         free (rl);
     }
@@ -442,9 +468,9 @@ static void delete_IR_records (IrTcl_SetObj *setobj)
 }
 
 /*
- * get_set_int: Set/get integer value
+ * ir_tcl_get_set_int: Set/get integer value
  */
-static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
+int ir_tcl_get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
 {
     char buf[20];
     
@@ -461,7 +487,8 @@ static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
 /*
  * ir_tcl_method: Search for method in table and invoke method handler
  */
-int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
+int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv,
+                   IrTcl_Methods *tab, int *ret)
 {
     IrTcl_Methods *tab_i = tab;
     IrTcl_Method *t;
@@ -475,7 +502,10 @@ int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab
             }
             else
                 if (!strcmp (t->name, argv[1]))
-                    return (*t->method)(tab_i->obj, interp, argc, argv);
+                {
+                    *ret = (*t->method)(tab_i->obj, interp, argc, argv);
+                    return TCL_OK;
+                }
 
     if (argc <= 0)
         return TCL_OK;
@@ -486,14 +516,15 @@ int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab
         for (t = tab_i->tab; t->name; t++)
             Tcl_AppendResult (interp, " ", t->name, NULL);
 #endif
+    *ret = TCL_ERROR;
     return TCL_ERROR;
 }
 
 /*
- *  ir_named_bits: get/set named bits
+ *  ir_tcl_named_bits: get/set named bits
  */
-int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
-                   Tcl_Interp *interp, int argc, char **argv)
+int ir_tcl_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
+                       Tcl_Interp *interp, int argc, char **argv)
 {
     struct ir_named_entry *ti;
     if (argc > 0)
@@ -686,7 +717,7 @@ static int do_options (void *obj, Tcl_Interp *interp,
         ODR_MASK_SET (&p->options, 14);
         return TCL_OK;
     }
-    return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2);
+    return ir_tcl_named_bits (options_tab, &p->options, interp, argc-2, argv+2);
 }
 
 /*
@@ -792,7 +823,7 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
         p->preferredMessageSize = 30000;
         return TCL_OK;
     }
-    return get_set_int (&p->preferredMessageSize, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->preferredMessageSize, interp, argc, argv);
 }
 
 /*
@@ -808,7 +839,7 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp,
         p->maximumRecordSize = 30000;
         return TCL_OK;
     }
-    return get_set_int (&p->maximumRecordSize, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->maximumRecordSize, interp, argc, argv);
 }
 
 /*
@@ -821,7 +852,7 @@ static int do_initResult (void *obj, Tcl_Interp *interp,
    
     if (argc <= 0)
         return TCL_OK;
-    return get_set_int (&p->initResult, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->initResult, interp, argc, argv);
 }
 
 
@@ -1053,34 +1084,19 @@ static int do_connect (void *obj, Tcl_Interp *interp,
         }
         if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
-#if IRTCL_GENERIC_FILES
-#ifdef WINDOWS
-        p->csFile = Tcl_GetFile (cs_fileno(p->cs_link), TCL_WIN_SOCKET);
-#else
-        p->csFile = Tcl_GetFile (cs_fileno(p->cs_link), TCL_UNIX_FD);
-#endif
-#endif
         if ((r=cs_connect (p->cs_link, addr)) < 0)
         {
             interp->result = "connect fail";
-            do_disconnect (p, NULL, 2, NULL);
+            ir_tcl_disconnect (p);
             return TCL_ERROR;
         }
-       logf(LOG_DEBUG, "cs_connect() returned %d fd=%d", r,
+        logf(LOG_DEBUG, "cs_connect() returned %d fd=%d", r,
              cs_fileno(p->cs_link));
         p->eventType = "connect";
-#if IRTCL_GENERIC_FILES
-        ir_select_add (p->csFile, p);
-#else
         ir_select_add (cs_fileno (p->cs_link), p);
-#endif
         if (r == 1)
         {
-#if IRTCL_GENERIC_FILES
-            ir_select_add_write (p->csFile, p);
-#else
             ir_select_add_write (cs_fileno (p->cs_link), p);
-#endif
             p->state = IR_TCL_R_Connecting;
         }
         else
@@ -1095,47 +1111,24 @@ static int do_connect (void *obj, Tcl_Interp *interp,
     return TCL_OK;
 }
 
-/*
- * do_disconnect: disconnect method on IR object
+/* 
+ * ir_tcl_disconnect: close connection
  */
-static int do_disconnect (void *obj, Tcl_Interp *interp,
-                          int argc, char **argv)
+void ir_tcl_disconnect (IrTcl_Obj *p)
 {
-    IrTcl_Obj *p = obj;
-
-    if (argc == 0)
-    {
-        p->state = IR_TCL_R_Idle;
-        p->eventType = NULL;
-        p->hostname = NULL;
-        p->cs_link = NULL;
-#if IRTCL_GENERIC_FILES
-        p->csFile = 0;
-#endif
-        return TCL_OK;
-    }
     if (p->hostname)
     {
-       logf(LOG_DEBUG, "Closing connection to %s", p->hostname);
+        logf(LOG_DEBUG, "Closing connection to %s", p->hostname);
         free (p->hostname);
         p->hostname = NULL;
-#if IRTCL_GENERIC_FILES
-        ir_select_remove_write (p->csFile, p);
-        ir_select_remove (p->csFile, p);
-#else
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         ir_select_remove (cs_fileno (p->cs_link), p);
-#endif
 
         odr_reset (p->odr_in);
 
         assert (p->cs_link);
         cs_close (p->cs_link);
         p->cs_link = NULL;
-#if IRTCL_GENERIC_FILES
-        Tcl_FreeFile (p->csFile);
-        p->csFile = NULL;
-#endif
 
         ODR_MASK_ZERO (&p->options);
         ODR_MASK_SET (&p->options, 0);
@@ -1150,6 +1143,25 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
         ir_tcl_del_q (p);
     }
     assert (!p->cs_link);
+}
+
+/*
+ * do_disconnect: disconnect method on IR object
+ */
+static int do_disconnect (void *obj, Tcl_Interp *interp,
+                          int argc, char **argv)
+{
+    IrTcl_Obj *p = obj;
+
+    if (argc == 0)
+    {
+        p->state = IR_TCL_R_Idle;
+        p->eventType = NULL;
+        p->hostname = NULL;
+        p->cs_link = NULL;
+        return TCL_OK;
+    }
+    ir_tcl_disconnect (p);
     return TCL_OK;
 }
 
@@ -1396,13 +1408,14 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp,
     }
     p->num_databaseNames = argc - 2;
     p->databaseNames =
-        ir_tcl_malloc (sizeof(*p->databaseNames) * p->num_databaseNames);
+        ir_tcl_malloc (sizeof(*p->databaseNames) * (1+p->num_databaseNames));
     for (i=0; i<p->num_databaseNames; i++)
     {
         if (ir_tcl_strdup (interp, &p->databaseNames[i], argv[2+i]) 
             == TCL_ERROR)
             return TCL_ERROR;
     }
+    p->databaseNames[i] = NULL;
     return TCL_OK;
 }
 
@@ -1419,7 +1432,7 @@ static int do_replaceIndicator (void *obj, Tcl_Interp *interp,
         p->replaceIndicator = 1;
         return TCL_OK;
     }
-    return get_set_int (&p->replaceIndicator, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->replaceIndicator, interp, argc, argv);
 }
 
 /*
@@ -1476,7 +1489,7 @@ static int do_smallSetUpperBound (void *o, Tcl_Interp *interp,
         p->smallSetUpperBound = 0;
         return TCL_OK;
     }
-    return get_set_int (&p->smallSetUpperBound, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->smallSetUpperBound, interp, argc, argv);
 }
 
 /*
@@ -1492,7 +1505,7 @@ static int do_largeSetLowerBound (void *o, Tcl_Interp *interp,
         p->largeSetLowerBound = 2;
         return TCL_OK;
     }
-    return get_set_int (&p->largeSetLowerBound, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->largeSetLowerBound, interp, argc, argv);
 }
 
 /*
@@ -1508,7 +1521,7 @@ static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp,
         p->mediumSetPresentNumber = 0;
         return TCL_OK;
     }
-    return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->mediumSetPresentNumber, interp, argc, argv);
 }
 
 /*
@@ -1565,8 +1578,9 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp,
     }
     else if (argc == 2)
     {
-        Tcl_AppendElement (interp, IrTcl_getRecordSyntaxStr
-                           (*p->preferredRecordSyntax));
+        Tcl_AppendElement
+            (interp,!p->preferredRecordSyntax ? "" :
+             IrTcl_getRecordSyntaxStr(*p->preferredRecordSyntax));
     }
     return TCL_OK;
             
@@ -1704,6 +1718,7 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
 {
     IrTcl_Methods tab[3];
     IrTcl_Obj *p = clientData;
+    int r;
 
     if (argc < 2)
         return TCL_ERROR;
@@ -1714,7 +1729,8 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
     tab[1].obj = &p->set_inher;
     tab[2].tab = NULL;
     
-    return ir_tcl_method (interp, argc, argv, tab);
+    ir_tcl_method (interp, argc, argv, tab, &r);
+    return r;
 }
 
 /* 
@@ -1737,7 +1753,7 @@ static void ir_obj_delete (ClientData clientData)
     tab[1].obj = &obj->set_inher;
     tab[2].tab = NULL;
 
-    ir_tcl_method (NULL, -1, NULL, tab);
+    ir_tcl_method (NULL, -1, NULL, tab, NULL);
 
     ir_tcl_del_q (obj);
     odr_destroy (obj->odr_in);
@@ -1750,7 +1766,8 @@ static void ir_obj_delete (ClientData clientData)
  * ir_obj_init: IR Object initialization
  */
 int ir_obj_init (ClientData clientData, Tcl_Interp *interp,
-                 int argc, char **argv, ClientData *subData)
+                 int argc, char **argv, ClientData *subData,
+                 ClientData parentData)
 {
     IrTcl_Methods tab[3];
     IrTcl_Obj *obj;
@@ -1791,7 +1808,7 @@ int ir_obj_init (ClientData clientData, Tcl_Interp *interp,
     tab[1].obj = &obj->set_inher;
     tab[2].tab = NULL;
 
-    if (ir_tcl_method (interp, 0, NULL, tab) == TCL_ERROR)
+    if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
     {
         Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
         return TCL_ERROR;
@@ -1808,7 +1825,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
                       int argc, char **argv)
 {
     ClientData subData;
-    int r = ir_obj_init (clientData, interp, argc, argv, &subData);
+    int r = ir_obj_init (clientData, interp, argc, argv, &subData, 0);
     
     if (r == TCL_ERROR)
         return TCL_ERROR;
@@ -1838,7 +1855,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
     IrTcl_SetObj *obj = o;
     IrTcl_Obj *p;
     int r;
-    oident bib1;
 
     if (argc <= 0)
         return TCL_OK;
@@ -1864,10 +1880,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
 
     obj->start = 1;
 
-    bib1.proto = p->protocol_type;
-    bib1.oclass = CLASS_ATTSET;
-    bib1.value = VAL_BIB1;
-
     set_referenceId (p->odr_out, &req->referenceId,
                      obj->set_inher.referenceId);
 
@@ -1925,13 +1937,12 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
     {
         Z_RPNQuery *RPNquery;
 
-        RPNquery = p_query_rpn (p->odr_out, argv[2]);
+        RPNquery = p_query_rpn (p->odr_out, p->protocol_type, argv[2]);
         if (!RPNquery)
         {
             Tcl_AppendResult (interp, "Syntax error in query", NULL);
             return TCL_ERROR;
         }
-        RPNquery->attributeSetId = oid_getoidbyent (&bib1);
         query.which = Z_Query_type_1;
         query.u.type_1 = RPNquery;
         logf (LOG_DEBUG, "RPN");
@@ -1943,6 +1954,11 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         int pos;
         struct ccl_rpn_node *rpn;
         Z_RPNQuery *RPNquery;
+        oident bib1;
+
+        bib1.proto = p->protocol_type;
+        bib1.oclass = CLASS_ATTSET;
+        bib1.value = VAL_BIB1;
 
         rpn = ccl_find_str(p->bibset, argv[2], &error, &pos);
         if (error)
@@ -2049,7 +2065,7 @@ static int do_resultCount (void *o, Tcl_Interp *interp,
         obj->resultCount = 0;
         return TCL_OK;
     }
-    return get_set_int (&obj->resultCount, interp, argc, argv);
+    return ir_tcl_get_set_int (&obj->resultCount, interp, argc, argv);
 }
 
 /*
@@ -2062,7 +2078,7 @@ static int do_searchStatus (void *o, Tcl_Interp *interp,
 
     if (argc <= 0)
         return TCL_OK;
-    return get_set_int (&obj->searchStatus, interp, argc, argv);
+    return ir_tcl_get_set_int (&obj->searchStatus, interp, argc, argv);
 }
 
 /*
@@ -2075,7 +2091,7 @@ static int do_presentStatus (void *o, Tcl_Interp *interp,
 
     if (argc <= 0)
         return TCL_OK;
-    return get_set_int (&obj->presentStatus, interp, argc, argv);
+    return ir_tcl_get_set_int (&obj->presentStatus, interp, argc, argv);
 }
 
 /*
@@ -2092,7 +2108,8 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp,
         obj->nextResultSetPosition = 0;
         return TCL_OK;
     }
-    return get_set_int (&obj->nextResultSetPosition, interp, argc, argv);
+    return ir_tcl_get_set_int (&obj->nextResultSetPosition, interp,
+                               argc, argv);
 }
 
 /*
@@ -2131,7 +2148,8 @@ static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp,
         obj->numberOfRecordsReturned = 0;
         return TCL_OK;
     }
-    return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv);
+    return ir_tcl_get_set_int (&obj->numberOfRecordsReturned, interp,
+                               argc, argv);
 }
 
 /*
@@ -2600,6 +2618,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
 {
     IrTcl_Methods tabs[3];
     IrTcl_SetObj *p = clientData;
+    int r;
 
     if (argc < 2)
     {
@@ -2612,7 +2631,8 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
     tabs[1].obj = &p->set_inher;
     tabs[2].tab = NULL;
 
-    return ir_tcl_method (interp, argc, argv, tabs);
+    ir_tcl_method (interp, argc, argv, tabs, &r);
+    return r;
 }
 
 /* 
@@ -2631,16 +2651,17 @@ static void ir_set_obj_delete (ClientData clientData)
     tabs[1].obj = &p->set_inher;
     tabs[2].tab = NULL;
 
-    ir_tcl_method (NULL, -1, NULL, tabs);
+    ir_tcl_method (NULL, -1, NULL, tabs, NULL);
 
     free (p);
 }
 
 /*
- * ir_set_obj_mk: IR Set Object creation
+ * ir_set_obj_init: IR Set Object initialization
  */
-static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
-                          int argc, char **argv)
+static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp,
+                            int argc, char **argv, ClientData *subData,
+                            ClientData parentData)
 {
     IrTcl_Methods tabs[3];
     IrTcl_SetObj *obj;
@@ -2652,33 +2673,30 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
     }
     obj = ir_tcl_malloc (sizeof(*obj));
     logf (LOG_DEBUG, "ir set create");
-    if (argc == 3)
+    if (parentData)
     {
-        Tcl_CmdInfo parent_info;
         int i;
         IrTcl_SetCObj *dst;
         IrTcl_SetCObj *src;
 
-        if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
-        {
-            interp->result = "No parent";
-            return TCL_ERROR;
-        }
-        obj->parent = (IrTcl_Obj *) parent_info.clientData;
+        obj->parent = (IrTcl_Obj *) parentData;
 
         dst = &obj->set_inher;
         src = &obj->parent->set_inher;
 
         if ((dst->num_databaseNames = src->num_databaseNames))
+        {
             dst->databaseNames =
                 ir_tcl_malloc (sizeof (*dst->databaseNames)
-                               * dst->num_databaseNames);
+                               * (1+dst->num_databaseNames));
+            for (i = 0; i < dst->num_databaseNames; i++)
+                if (ir_tcl_strdup (interp, &dst->databaseNames[i],
+                                   src->databaseNames[i]) == TCL_ERROR)
+                    return TCL_ERROR;
+            dst->databaseNames[i] = NULL;
+        }
         else
             dst->databaseNames = NULL;
-        for (i = 0; i < dst->num_databaseNames; i++)
-            if (ir_tcl_strdup (interp, &dst->databaseNames[i],
-                           src->databaseNames[i]) == TCL_ERROR)
-                return TCL_ERROR;
         if (ir_tcl_strdup (interp, &dst->queryType, src->queryType)
             == TCL_ERROR)
             return TCL_ERROR;
@@ -2719,14 +2737,48 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
     tabs[0].obj = obj;
     tabs[1].tab = NULL;
 
-    if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR)
+    if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR)
         return TCL_ERROR;
 
+    *subData = obj;
+    return TCL_OK;
+}
+
+/*
+ * ir_set_obj_mk: IR Set Object creation
+ */
+static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
+                          int argc, char **argv)
+{
+    ClientData subData;
+    ClientData parentData = 0;
+    int r;
+
+    if (argc == 3)
+    {
+        Tcl_CmdInfo parent_info;
+        if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
+        {
+            interp->result = "No parent";
+            return TCL_ERROR;
+        }
+        parentData = parent_info.clientData;
+    }
+    r = ir_set_obj_init (clientData, interp, argc, argv, &subData, parentData);
+    if (r == TCL_ERROR)
+        return TCL_ERROR;
     Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
-                       (ClientData) obj, ir_set_obj_delete);
+                       subData, ir_set_obj_delete);
     return TCL_OK;
 }
 
+IrTcl_Class ir_set_obj_class = {
+    "ir-set",
+    ir_set_obj_init,
+    ir_set_obj_method,
+    ir_set_obj_delete
+};
+
 /* ------------------------------------------------------- */
 
 /*
@@ -2738,8 +2790,8 @@ 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;
-    oident bib1;
 #if CCL2RPN
+    oident bib1;
     struct ccl_rpn_node *rpn;
     int pos;
 #endif
@@ -2762,20 +2814,17 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
         return TCL_ERROR;
     }
 
-    bib1.proto = p->protocol_type;
-    bib1.oclass = CLASS_ATTSET;
-    bib1.value = VAL_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, p->protocol_type,
+                        &req->attributeSet, argv[2])))
     {
         Tcl_AppendResult (interp, "Syntax error in query", NULL);
         return TCL_ERROR;
@@ -2787,6 +2836,11 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
         Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg (r), NULL);
         return TCL_ERROR;
     }
+    bib1.proto = p->protocol_type;
+    bib1.oclass = CLASS_ATTSET;
+    bib1.value = VAL_BIB1;
+
+    req->attributeSet = oid_getoidbyent (&bib1);
     ccl_pr_tree (rpn, stderr);
     fprintf (stderr, "\n");
     if (!(req->termListAndStartPoint = ccl_scan_query (rpn)))
@@ -2846,7 +2900,7 @@ static int do_stepSize (void *obj, Tcl_Interp *interp,
         p->stepSize = 0;
         return TCL_OK;
     }
-    return get_set_int (&p->stepSize, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->stepSize, interp, argc, argv);
 }
 
 /*
@@ -2862,7 +2916,7 @@ static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp,
         p->numberOfTermsRequested = 20;
         return TCL_OK;
     }
-    return get_set_int (&p->numberOfTermsRequested, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->numberOfTermsRequested, interp, argc, argv);
 }
 
 
@@ -2879,7 +2933,8 @@ static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp,
         p->preferredPositionInResponse = 1;
         return TCL_OK;
     }
-    return get_set_int (&p->preferredPositionInResponse, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->preferredPositionInResponse, interp,
+                               argc, argv);
 }
 
 /*
@@ -2892,7 +2947,7 @@ static int do_scanStatus (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
         return TCL_OK;
-    return get_set_int (&p->scanStatus, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->scanStatus, interp, argc, argv);
 }
 
 /*
@@ -2905,7 +2960,8 @@ static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
         return TCL_OK;
-    return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->numberOfEntriesReturned, interp,
+                               argc, argv);
 }
 
 /*
@@ -2918,7 +2974,7 @@ static int do_positionOfTerm (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
         return TCL_OK;
-    return get_set_int (&p->positionOfTerm, interp, argc, argv);
+    return ir_tcl_get_set_int (&p->positionOfTerm, interp, argc, argv);
 }
 
 /*
@@ -2998,6 +3054,7 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp,
                                int argc, char **argv)
 {
     IrTcl_Methods tabs[2];
+    int r;
 
     if (argc < 2)
     {
@@ -3008,7 +3065,8 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp,
     tabs[0].obj = clientData;
     tabs[1].tab = NULL;
 
-    return ir_tcl_method (interp, argc, argv, tabs);
+    ir_tcl_method (interp, argc, argv, tabs, &r);
+    return r;
 }
 
 /* 
@@ -3023,7 +3081,7 @@ static void ir_scan_obj_delete (ClientData clientData)
     tabs[0].obj = obj;
     tabs[1].tab = NULL;
 
-    ir_tcl_method (NULL, -1, NULL, tabs);
+    ir_tcl_method (NULL, -1, NULL, tabs, NULL);
     free (obj);
 }
 
@@ -3054,7 +3112,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp,
     tabs[0].obj = obj;
     tabs[1].tab = NULL;
 
-    if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR)
+    if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR)
         return TCL_ERROR;
     Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method,
                        (ClientData) obj, ir_scan_obj_delete);
@@ -3217,7 +3275,7 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
                 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);
+                    ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
                     rl->u.dbrec.buf = NULL;
                 }
                 else
@@ -3410,7 +3468,7 @@ static void ir_select_read (ClientData clientData)
     logf(LOG_DEBUG, "Read handler fd=%d", cs_fileno(p->cs_link));
     if (p->state == IR_TCL_R_Connecting)
     {
-       logf(LOG_DEBUG, "Connect handler");
+        logf(LOG_DEBUG, "read: connect");
         r = cs_rcvconnect (p->cs_link);
         if (r == 1)
         {
@@ -3418,46 +3476,46 @@ static void ir_select_read (ClientData clientData)
             return;
         }
         p->state = IR_TCL_R_Idle;
-#if IRTCL_GENERIC_FILES
-        ir_select_remove_write (p->csFile, p);
-#else
+        p->ref_count = 2;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
-#endif
         if (r < 0)
         {
             logf (LOG_DEBUG, "cs_rcvconnect error");
+            ir_tcl_disconnect (p);
             if (p->failback)
             {
                 p->failInfo = IR_TCL_FAIL_CONNECT;
                 ir_tcl_eval (p->interp, p->failback);
             }
-            do_disconnect (p, NULL, 2, NULL);
+            ir_obj_delete (p);
             return;
         }
-        p->state = IR_TCL_R_Idle;
         if (p->callback)
             ir_tcl_eval (p->interp, p->callback);
-        if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
+        if (p->ref_count == 2 && p->cs_link && p->request_queue
+            && p->state == IR_TCL_R_Idle)
             ir_tcl_send_q (p, p->request_queue, "x");
+        ir_obj_delete (p);
         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)
+        if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) == 1)
+        {
+            logf(LOG_DEBUG, "PDU Fraction read");
+            return ;
+        }
+        /* signal one more use of ir object - callbacks must not
+           release the ir memory (p pointer) */
+        p->ref_count = 2;
+        if (r <= 0)
         {
             logf (LOG_DEBUG, "cs_get failed, code %d", r);
-#if IRTCL_GENERIC_FILES
-            ir_select_remove (p->csFile, p);
-#else
             ir_select_remove (cs_fileno (p->cs_link), p);
-#endif
-            do_disconnect (p, NULL, 2, NULL);
+            ir_tcl_disconnect (p);
             if (p->failback)
             {
                 p->failInfo = IR_TCL_FAIL_READ;
@@ -3467,11 +3525,6 @@ static void ir_select_read (ClientData clientData)
             ir_obj_delete (p);
             return;
         }        
-        if (r == 1)
-       {
-           logf(LOG_DEBUG, "PDU Fraction read");
-            return ;
-       }
         /* got complete APDU. Now decode */
         p->apduLen = r;
         p->apduOffset = -1;
@@ -3480,8 +3533,8 @@ static void ir_select_read (ClientData clientData)
         if (!z_APDU (p->odr_in, &apdu, 0))
         {
             logf (LOG_DEBUG, "cs_get failed: %s",
-               odr_errmsg (odr_geterror (p->odr_in)));
-            do_disconnect (p, NULL, 2, NULL);
+                odr_errmsg (odr_geterror (p->odr_in)));
+            ir_tcl_disconnect (p);
             if (p->failback)
             {
                 p->failInfo = IR_TCL_FAIL_IN_APDU;
@@ -3492,7 +3545,7 @@ static void ir_select_read (ClientData clientData)
             ir_obj_delete (p);
             return;
         }
-       logf(LOG_DEBUG, "Decoded ok");
+        logf(LOG_DEBUG, "Decoded ok");
         /* handle APDU and invoke callback */
         rq = p->request_queue;
         if (!rq)
@@ -3510,7 +3563,7 @@ static void ir_select_read (ClientData clientData)
             case Z_APDU_initResponse:
                 p->eventType = "init";
                 ir_initResponse (p, apdu->u.initResponse);
-               apdu_call = p->initResponse;
+                apdu_call = p->initResponse;
                 break;
             case Z_APDU_searchResponse:
                 p->eventType = "search";
@@ -3536,7 +3589,7 @@ static void ir_select_read (ClientData clientData)
             default:
                 logf (LOG_WARN, "Received unknown APDU type (%d)",
                       apdu->which);
-                do_disconnect (p, NULL, 2, NULL);
+                ir_tcl_disconnect (p);
                 if (p->failback)
                 {
                     p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
@@ -3562,7 +3615,7 @@ static void ir_select_read (ClientData clientData)
             ir_obj_delete (p);
             return;
         }
-        --(p->ref_count);
+        ir_obj_delete (p);
     } 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");
@@ -3580,34 +3633,31 @@ static void ir_select_write (ClientData clientData)
     logf (LOG_DEBUG, "Write handler fd=%d", cs_fileno(p->cs_link));
     if (p->state == IR_TCL_R_Connecting)
     {
-       logf(LOG_DEBUG, "Connect handler");
+        logf(LOG_DEBUG, "write: connect");
         r = cs_rcvconnect (p->cs_link);
         if (r == 1)
+        {
+            logf (LOG_DEBUG, "cs_rcvconnect returned 1");
             return;
+        }
         p->state = IR_TCL_R_Idle;
+        p->ref_count = 2;
+        ir_select_remove_write (cs_fileno (p->cs_link), p);
         if (r < 0)
         {
             logf (LOG_DEBUG, "cs_rcvconnect error");
-#if IRTCL_GENERIC_FILES
-            ir_select_remove_write (p->csFile, p);
-#else
-            ir_select_remove_write (cs_fileno (p->cs_link), p);
-#endif
+            ir_tcl_disconnect (p);
             if (p->failback)
             {
                 p->failInfo = IR_TCL_FAIL_CONNECT;
                 ir_tcl_eval (p->interp, p->failback);
             }
-            do_disconnect (p, NULL, 2, NULL);
+            ir_obj_delete (p);
             return;
         }
-#if IRTCL_GENERIC_FILES
-        ir_select_remove_write (p->csFile, p);
-#else
-        ir_select_remove_write (cs_fileno (p->cs_link), p);
-#endif
         if (p->callback)
             ir_tcl_eval (p->interp, p->callback);
+        ir_obj_delete (p);
         return;
     }
     rq = p->request_queue;
@@ -3617,24 +3667,22 @@ static void ir_select_write (ClientData clientData)
     if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0)
     {
         logf (LOG_DEBUG, "cs_put write fail");
+        p->ref_count = 2;
+        free (rq->buf_out);
+        rq->buf_out = NULL;
+        ir_tcl_disconnect (p);
         if (p->failback)
         {
             p->failInfo = IR_TCL_FAIL_WRITE;
             ir_tcl_eval (p->interp, p->failback);
         }
-        free (rq->buf_out);
-        rq->buf_out = NULL;
-        do_disconnect (p, NULL, 2, NULL);
+        ir_obj_delete (p);
     }
     else if (r == 0)            /* remove select bit */
     {
-       logf(LOG_DEBUG, "Write completed");
+        logf (LOG_DEBUG, "Write completed");
         p->state = IR_TCL_R_Waiting;
-#if IRTCL_GENERIC_FILES
-        ir_select_remove_write (p->csFile, p);
-#else
         ir_select_remove_write (cs_fileno (p->cs_link), p);
-#endif
         free (rq->buf_out);
         rq->buf_out = NULL;
     }
@@ -3644,7 +3692,7 @@ static void ir_select_notify (ClientData clientData, int r, int w, int e)
 {
     if (r)
         ir_select_read (clientData);
-    if (w)
+    else if (w)
         ir_select_write (clientData);
 }