ir-tcl.c

   1 /*
   2  * IR toolkit for tcl/tk
   3  * (c) Index Data 1995
   4  * See the file LICENSE for details.
   5  * Sebastian Hammer, Adam Dickmeiss
   6  *
   7  * $Log: ir-tcl.c,v $
   8  * Revision 1.69  1996-01-04 16:12:12  adam
   9  * Setting PDUType renamed to eventType.
  10  *
  11  * Revision 1.68  1996/01/04  11:05:22  adam
  12  * New setting: PDUType - returns type of last PDU returned from the target.
  13  * Fixed a bug in configure/Makefile.
  14  *
  15  * Revision 1.67  1996/01/03  09:00:51  adam
  16  * Updated to use new version of Yaz (names changed to avoid C++ conflict).
  17  *
  18  * Revision 1.66  1995/11/28  17:26:39  adam
  19  * Removed Carriage return from ir-tcl.c!
  20  * Removed misc. debug logs.
  21  *
  22  * Revision 1.65  1995/11/28  13:53:00  quinn
  23  * Windows port.
  24  *
  25  * Revision 1.64  1995/11/13  15:39:18  adam
  26  * Bug fix: {small,medium}SetElementSetNames weren't set correctly.
  27  * Bug fix: idAuthentication weren't set correctly.
  28  *
  29  * Revision 1.63  1995/11/13  09:55:39  adam
  30  * Multiple records at a position in a result-set with differnt
  31  * element specs.
  32  *
  33  * Revision 1.62  1995/10/18  17:20:33  adam
  34  * Work on target setup in client.tcl.
  35  *
  36  * Revision 1.61  1995/10/18  16:42:42  adam
  37  * New settings: smallSetElementSetNames and mediumSetElementSetNames.
  38  *
  39  * Revision 1.60  1995/10/18  15:43:31  adam
  40  * In search: mediumSetElementSetNames and smallSetElementSetNames are
  41  * set to elementSetNames.
  42  *
  43  * Revision 1.59  1995/10/17  12:18:58  adam
  44  * Bug fix: when target connection closed, the connection was not
  45  * properly reestablished.
  46  *
  47  * Revision 1.58  1995/10/16  17:00:55  adam
  48  * New setting: elementSetNames.
  49  * Various client improvements. Medium presentation format looks better.
  50  *
  51  * Revision 1.57  1995/09/21  13:11:51  adam
  52  * Support of dynamic loading.
  53  * Test script uses load command if necessary.
  54  *
  55  * Revision 1.56  1995/08/29  15:30:14  adam
  56  * Work on GRS records.
  57  *
  58  * Revision 1.55  1995/08/28  09:43:25  adam
  59  * Minor changes. configure only searches for yaz beta 3 and versions after
  60  * that.
  61  *
  62  * Revision 1.54  1995/08/24  12:25:16  adam
  63  * Modified to work with yaz 1.0b3.
  64  *
  65  * Revision 1.53  1995/08/04  12:49:26  adam
  66  * Bug fix: reading uninitialized variable p.
  67  *
  68  * Revision 1.52  1995/08/04  11:32:38  adam
  69  * More work on output queue. Memory related routines moved
  70  * to mem.c
  71  *
  72  * Revision 1.51  1995/08/03  13:22:54  adam
  73  * Request queue.
  74  *
  75  * Revision 1.50  1995/07/20  08:09:49  adam
  76  * client.tcl: Targets removed from hotTargets list when targets
  77  *  are removed/modified.
  78  * ir-tcl.c: More work on triggerResourceControl.
  79  *
  80  * Revision 1.49  1995/06/30  12:39:21  adam
  81  * Bug fix: loadFile didn't set record type.
  82  * The MARC routines are a little less strict in the interpretation.
  83  * Script display.tcl replaces the old marc.tcl.
  84  * New interactive script: shell.tcl.
  85  *
  86  * Revision 1.48  1995/06/27  19:03:50  adam
  87  * Bug fix in do_present in ir-tcl.c: p->set_child member weren't set.
  88  * nextResultSetPosition used instead of setOffset.
  89  *
  90  * Revision 1.47  1995/06/25  10:25:04  adam
  91  * Working on triggerResourceControl. Description of compile/install
  92  * procedure moved to ir-tcl.sgml.
  93  *
  94  * Revision 1.46  1995/06/22  13:15:06  adam
  95  * Feature: SUTRS. Setting getSutrs implemented.
  96  * Work on display formats.
  97  * Preferred record syntax can be set by the user.
  98  *
  99  * Revision 1.45  1995/06/20  08:07:30  adam
 100  * New setting: failInfo.
 101  * Working on better cancel mechanism.
 102  *
 103  * Revision 1.44  1995/06/19  17:01:20  adam
 104  * Minor changes.
 105  *
 106  * Revision 1.43  1995/06/19  13:06:08  adam
 107  * New define: IR_TCL_VERSION.
 108  *
 109  * Revision 1.42  1995/06/19  08:08:52  adam
 110  * client.tcl: hotTargets now contain both database and target name.
 111  * ir-tcl.c: setting protocol edited. Errors in callbacks are logged
 112  * by logf(LOG_WARN, ...) calls.
 113  *
 114  * Revision 1.41  1995/06/16  12:28:16  adam
 115  * Implemented preferredRecordSyntax.
 116  * Minor changes in diagnostic handling.
 117  * Record list deleted when connection closes.
 118  *
 119  * Revision 1.40  1995/06/14  13:37:18  adam
 120  * Setting recordType implemented.
 121  * Setting implementationVersion implemented.
 122  * Settings implementationId / implementationName edited.
 123  *
 124  * Revision 1.39  1995/06/08  10:26:32  adam
 125  * Bug fix in ir_strdup.
 126  *
 127  * Revision 1.38  1995/06/01  16:36:47  adam
 128  * About buttons. Minor bug fixes.
 129  *
 130  * Revision 1.37  1995/06/01  07:31:20  adam
 131  * Rename of many typedefs -> IrTcl_...
 132  *
 133  * Revision 1.36  1995/05/31  13:09:59  adam
 134  * Client searches/presents may be interrupted.
 135  * New moving book-logo.
 136  *
 137  * Revision 1.35  1995/05/31  08:36:33  adam
 138  * Bug fix in client.tcl: didn't save options on clientrc.tcl.
 139  * New method: referenceId. More work on scan.
 140  *
 141  * Revision 1.34  1995/05/29  10:33:42  adam
 142  * README and rename of startup script.
 143  *
 144  * Revision 1.33  1995/05/29  09:15:11  quinn
 145  * Changed CS_SR to PROTO_SR, etc.
 146  *
 147  * Revision 1.32  1995/05/29  08:44:16  adam
 148  * Work on delete of objects.
 149  *
 150  * Revision 1.31  1995/05/26  11:44:10  adam
 151  * Bugs fixed. More work on MARC utilities and queries. Test
 152  * client is up-to-date again.
 153  *
 154  * Revision 1.30  1995/05/26  08:54:11  adam
 155  * New MARC utilities. Uses prefix query.
 156  *
 157  * Revision 1.29  1995/05/24  14:10:22  adam
 158  * Work on idAuthentication, protocolVersion and options.
 159  *
 160  * Revision 1.28  1995/05/23  15:34:48  adam
 161  * Many new settings, userInformationField, smallSetUpperBound, etc.
 162  * A number of settings are inherited when ir-set is executed.
 163  * This version is incompatible with the graphical test client (client.tcl).
 164  *
 165  * Revision 1.27  1995/05/11  15:34:47  adam
 166  * Scan request changed a bit. This version works with RLG.
 167  *
 168  * Revision 1.26  1995/04/18  16:11:51  adam
 169  * First version of graphical Scan. Some work on query-by-form.
 170  *
 171  * Revision 1.25  1995/04/17  09:37:17  adam
 172  * Further development of scan.
 173  *
 174  * Revision 1.24  1995/04/11  14:16:42  adam
 175  * Further work on scan. Response works. Entries aren't saved yet.
 176  *
 177  * Revision 1.23  1995/04/10  10:50:27  adam
 178  * Result-set name defaults to suffix of ir-set name.
 179  * Started working on scan. Not finished at this point.
 180  *
 181  * Revision 1.22  1995/03/31  10:43:03  adam
 182  * More robust when getting bad MARC records.
 183  *
 184  * Revision 1.21  1995/03/31  08:56:37  adam
 185  * New button "Search".
 186  *
 187  * Revision 1.20  1995/03/29  16:07:09  adam
 188  * Bug fix: Didn't use setName in present request.
 189  *
 190  * Revision 1.19  1995/03/28  12:45:23  adam
 191  * New ir method failback: called on disconnect/protocol error.
 192  * New ir set/get method: protocol: SR / Z3950.
 193  * Simple popup and disconnect when failback is invoked.
 194  *
 195  * Revision 1.18  1995/03/21  15:50:12  adam
 196  * Minor changes.
 197  *
 198  * Revision 1.17  1995/03/21  13:41:03  adam
 199  * Comstack cs_create not used too often. Non-blocking connect.
 200  *
 201  * Revision 1.16  1995/03/21  08:26:06  adam
 202  * New method, setName, to specify the result set name (other than Default).
 203  * New method, responseStatus, which returns diagnostic info, if any, after
 204  * present response / search response.
 205  *
 206  * Revision 1.15  1995/03/20  15:24:07  adam
 207  * Diagnostic records saved on searchResponse.
 208  *
 209  * Revision 1.14  1995/03/20  08:53:22  adam
 210  * Event loop in tclmain.c rewritten. New method searchStatus.
 211  *
 212  * Revision 1.13  1995/03/17  18:26:17  adam
 213  * Non-blocking i/o used now. Database names popup as cascade items.
 214  *
 215  * Revision 1.12  1995/03/17  15:45:00  adam
 216  * Improved target/database setup.
 217  *
 218  * Revision 1.11  1995/03/16  17:54:03  adam
 219  * Minor changes really.
 220  *
 221  * Revision 1.10  1995/03/15  16:14:50  adam
 222  * Blocking arg in cs_create changed.
 223  *
 224  * Revision 1.9  1995/03/15  13:59:24  adam
 225  * Minor changes.
 226  *
 227  * Revision 1.8  1995/03/15  08:25:16  adam
 228  * New method presentStatus to check for error on present. Misc. cleanup
 229  * of IrTcl_RecordList manipulations. Full MARC record presentation in
 230  * search.tcl.
 231  *
 232  * Revision 1.7  1995/03/14  17:32:29  adam
 233  * Presentation of full Marc record in popup window.
 234  *
 235  * Revision 1.6  1995/03/12  19:31:55  adam
 236  * Pattern matching implemented when retrieving MARC records. More
 237  * diagnostic functions.
 238  *
 239  * Revision 1.5  1995/03/10  18:00:15  adam
 240  * Actual presentation in line-by-line format. RPN query support.
 241  *
 242  * Revision 1.4  1995/03/09  16:15:08  adam
 243  * First presentRequest attempts. Hot-target list.
 244  *
 245  */
 246
 247 #include <stdlib.h>
 248 #include <stdio.h>
 249 #ifdef WINDOWS
 250 #include <time.h>
 251 #else
 252 #include <sys/time.h>
 253 #endif
 254 #include <assert.h>
 255
 256 #define CS_BLOCK 0
 257
 258 #include "ir-tclp.h"
 259
 260 typedef struct {
 261     int type;
 262     char *name;
 263     int (*method) (void *obj, Tcl_Interp *interp, int argc, char **argv);
 264 } IrTcl_Method;
 265
 266 typedef struct {
 267     void *obj;
 268     IrTcl_Method *tab;
 269 } IrTcl_Methods;
 270
 271 static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num);
 272 static int do_disconnect (void *obj, Tcl_Interp *interp,
 273                           int argc, char **argv);
 274
 275 static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj,
 276                                         int no, int which,
 277                                         const char *elements)
 278 {
 279     IrTcl_RecordList *rl;
 280
 281     for (rl = setobj->record_list; rl; rl = rl->next)
 282     {
 283         if (no == rl->no && (!rl->elements || !elements ||
 284                              !strcmp(elements, rl->elements)))
 285         {
 286             free (rl->elements);
 287             switch (rl->which)
 288             {
 289             case Z_NamePlusRecord_databaseRecord:
 290                 free (rl->u.dbrec.buf);
 291                 rl->u.dbrec.buf = NULL;
 292                 break;
 293             case Z_NamePlusRecord_surrogateDiagnostic:
 294                 ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
 295                                 &rl->u.surrogateDiagnostics.num);
 296                 break;
 297             }
 298             break;
 299         }
 300     }
 301     if (!rl)
 302     {
 303         rl = ir_tcl_malloc (sizeof(*rl));
 304         rl->next = setobj->record_list;
 305         rl->no = no;
 306         setobj->record_list = rl;
 307     }
 308     rl->which = which;
 309     ir_tcl_strdup (NULL, &rl->elements, elements);
 310     return rl;
 311 }
 312
 313 static struct {
 314     enum oid_value value;
 315     const char *name;
 316 } IrTcl_recordSyntaxTab[] = {
 317 { VAL_UNIMARC,    "UNIMARC" },
 318 { VAL_INTERMARC,  "INTERMARC" },
 319 { VAL_CCF,        "CCF" },
 320 { VAL_USMARC,     "USMARC" },
 321 { VAL_UKMARC,     "UKMARC" },
 322 { VAL_NORMARC,    "NORMARC" },
 323 { VAL_LIBRISMARC, "LIBRISMARC" },
 324 { VAL_DANMARC,    "DANMARC" },
 325 { VAL_FINMARC,    "FINMARC" },
 326 { VAL_MAB,        "MAB" },
 327 { VAL_CANMARC,    "CANMARC" },
 328 { VAL_SBN,        "SBN" },
 329 { VAL_PICAMARC,   "PICAMARC" },
 330 { VAL_AUSMARC,    "AUSMARC" },
 331 { VAL_IBERMARC,   "IBERMARC" },
 332 { VAL_SUTRS,      "SUTRS" },
 333 { VAL_GRS1,       "GRS1" },
 334 { 0, NULL }
 335 };
 336
 337 /*
 338  * IrTcl_eval
 339  */
 340 int IrTcl_eval (Tcl_Interp *interp, const char *command)
 341 {
 342     char *tmp = ir_tcl_malloc (strlen(command)+1);
 343     int r;
 344
 345     strcpy (tmp, command);
 346     r = Tcl_Eval (interp, tmp);
 347     if (r == TCL_ERROR)
 348         logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine,
 349               interp->result);
 350     Tcl_FreeResult (interp);
 351     free (tmp);
 352     return r;
 353 }
 354
 355 /*
 356  * IrTcl_getRecordSyntaxStr: Return record syntax name of object id
 357  */
 358 static const char *IrTcl_getRecordSyntaxStr (enum oid_value value)
 359 {
 360     int i;
 361     for (i = 0; IrTcl_recordSyntaxTab[i].name; i++)
 362         if (IrTcl_recordSyntaxTab[i].value == value)
 363             return IrTcl_recordSyntaxTab[i].name;
 364     return "USMARC";
 365 }
 366
 367 /*
 368  * IrTcl_getRecordSyntaxVal: Return record syntax value of string
 369  */
 370 static enum oid_value IrTcl_getRecordSyntaxVal (const char *name)
 371 {
 372     int i;
 373     for (i = 0; IrTcl_recordSyntaxTab[i].name; i++)
 374         if (!strcmp (IrTcl_recordSyntaxTab[i].name, name))
 375             return IrTcl_recordSyntaxTab[i].value;
 376     return 0;
 377 }
 378
 379 static IrTcl_RecordList *find_IR_record (IrTcl_SetObj *setobj, int no)
 380 {
 381     IrTcl_RecordList *rl;
 382
 383     for (rl = setobj->record_list; rl; rl = rl->next)
 384         if (no == rl->no &&
 385             (!setobj->recordElements || !rl->elements ||
 386              !strcmp (setobj->recordElements, rl->elements)))
 387             return rl;
 388     return NULL;
 389 }
 390
 391 static void delete_IR_records (IrTcl_SetObj *setobj)
 392 {
 393     IrTcl_RecordList *rl, *rl1;
 394
 395     for (rl = setobj->record_list; rl; rl = rl1)
 396     {
 397         switch (rl->which)
 398         {
 399         case Z_NamePlusRecord_databaseRecord:
 400             free (rl->u.dbrec.buf);
 401             break;
 402         case Z_NamePlusRecord_surrogateDiagnostic:
 403             ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
 404                             &rl->u.surrogateDiagnostics.num);
 405             break;
 406         }
 407         rl1 = rl->next;
 408         free (rl);
 409     }
 410     setobj->record_list = NULL;
 411 }
 412
 413 /*
 414  * get_set_int: Set/get integer value
 415  */
 416 static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
 417 {
 418     char buf[20];
 419
 420     if (argc == 3)
 421     {
 422         if (Tcl_GetInt (interp, argv[2], val)==TCL_ERROR)
 423             return TCL_ERROR;
 424     }
 425     sprintf (buf, "%d", *val);
 426     Tcl_AppendResult (interp, buf, NULL);
 427     return TCL_OK;
 428 }
 429
 430 /*
 431  * ir_method: Search for method in table and invoke method handler
 432  */
 433 int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
 434 {
 435     IrTcl_Methods *tab_i = tab;
 436     IrTcl_Method *t;
 437
 438     for (tab_i = tab; tab_i->tab; tab_i++)
 439         for (t = tab_i->tab; t->name; t++)
 440             if (argc <= 0)
 441             {
 442                 if ((*t->method)(tab_i->obj, interp, argc, argv) == TCL_ERROR)
 443                     return TCL_ERROR;
 444             }
 445             else
 446                 if (!strcmp (t->name, argv[1]))
 447                     return (*t->method)(tab_i->obj, interp, argc, argv);
 448
 449     if (argc <= 0)
 450         return TCL_OK;
 451     Tcl_AppendResult (interp, "Bad method: ", argv[1],
 452                       ". Possible methods:", NULL);
 453     for (tab_i = tab; tab_i->tab; tab_i++)
 454         for (t = tab_i->tab; t->name; t++)
 455             Tcl_AppendResult (interp, " ", t->name, NULL);
 456     return TCL_ERROR;
 457 }
 458
 459 /*
 460  * ir_method_r: Get status for all readable elements
 461  */
 462 int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv,
 463                  IrTcl_Method *tab)
 464 {
 465     char *argv_n[3];
 466     int argc_n;
 467
 468     argv_n[0] = argv[0];
 469     argc_n = 2;
 470     for (; tab->name; tab++)
 471         if (tab->type)
 472         {
 473             argv_n[1] = tab->name;
 474             Tcl_AppendResult (interp, "{", NULL);
 475             (*tab->method)(obj, interp, argc_n, argv_n);
 476             Tcl_AppendResult (interp, "} ", NULL);
 477         }
 478     return TCL_OK;
 479 }
 480
 481 /*
 482  *  ir_named_bits: get/set named bits
 483  */
 484 int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
 485                    Tcl_Interp *interp, int argc, char **argv)
 486 {
 487     struct ir_named_entry *ti;
 488     if (argc > 0)
 489     {
 490         int no;
 491         ODR_MASK_ZERO (ob);
 492         for (no = 0; no < argc; no++)
 493         {
 494             for (ti = tab; ti->name; ti++)
 495                 if (!strcmp (argv[no], ti->name))
 496                 {
 497                     ODR_MASK_SET (ob, ti->pos);
 498                     break;
 499                 }
 500             if (!ti->name)
 501             {
 502                 Tcl_AppendResult (interp, "Bad bit mask: ", argv[no], NULL);
 503                 return TCL_ERROR;
 504             }
 505         }
 506         return TCL_OK;
 507     }
 508     for (ti = tab; ti->name; ti++)
 509         if (ODR_MASK_GET (ob, ti->pos))
 510             Tcl_AppendElement (interp, ti->name);
 511     return TCL_OK;
 512 }
 513
 514 static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src)
 515 {
 516     if (!src || !*src)
 517         *dst = NULL;
 518     else
 519     {
 520         *dst = odr_malloc (o, sizeof(**dst));
 521         (*dst)->size = (*dst)->len = strlen(src);
 522         (*dst)->buf = odr_malloc (o, (*dst)->len);
 523         memcpy ((*dst)->buf, src, (*dst)->len);
 524     }
 525 }
 526
 527 static void get_referenceId (char **dst, Z_ReferenceId *src)
 528 {
 529     free (*dst);
 530     if (!src)
 531     {
 532         *dst = NULL;
 533         return;
 534     }
 535     *dst = ir_tcl_malloc (src->len+1);
 536     memcpy (*dst, src->buf, src->len);
 537     (*dst)[src->len] = '\0';
 538 }
 539
 540 /* ------------------------------------------------------- */
 541
 542 /*
 543  * do_init_request: init method on IR object
 544  */
 545 static int do_init_request (void *obj, Tcl_Interp *interp,
 546                             int argc, char **argv)
 547 {
 548     Z_APDU *apdu;
 549     IrTcl_Obj *p = obj;
 550     Z_InitRequest *req;
 551
 552     if (argc <= 0)
 553         return TCL_OK;
 554     if (!p->cs_link)
 555     {
 556         interp->result = "init: not connected";
 557         return TCL_ERROR;
 558     }
 559     apdu = zget_APDU (p->odr_out, Z_APDU_initRequest);
 560     req = apdu->u.initRequest;
 561
 562     set_referenceId (p->odr_out, &req->referenceId, p->set_inher.referenceId);
 563     req->options = &p->options;
 564     req->protocolVersion = &p->protocolVersion;
 565     req->preferredMessageSize = &p->preferredMessageSize;
 566     req->maximumRecordSize = &p->maximumRecordSize;
 567
 568     if (p->idAuthenticationGroupId)
 569     {
 570         Z_IdPass *pass = odr_malloc (p->odr_out, sizeof(*pass));
 571         Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth));
 572
 573         logf (LOG_DEBUG, "using pass authentication");
 574
 575         auth->which = Z_IdAuthentication_idPass;
 576         auth->u.idPass = pass;
 577         if (p->idAuthenticationGroupId && *p->idAuthenticationGroupId)
 578             pass->groupId = p->idAuthenticationGroupId;
 579         else
 580             pass->groupId = NULL;
 581         if (p->idAuthenticationUserId && *p->idAuthenticationUserId)
 582             pass->userId = p->idAuthenticationUserId;
 583         else
 584             pass->userId = NULL;
 585         if (p->idAuthenticationPassword && *p->idAuthenticationPassword)
 586             pass->password = p->idAuthenticationPassword;
 587         else
 588             pass->password = NULL;
 589         req->idAuthentication = auth;
 590     }
 591     else if (!p->idAuthenticationOpen || !*p->idAuthenticationOpen)
 592         req->idAuthentication = NULL;
 593     else
 594     {
 595         Z_IdAuthentication *auth = odr_malloc (p->odr_out, sizeof(*auth));
 596
 597         logf (LOG_DEBUG, "using open authentication");
 598         auth->which = Z_IdAuthentication_open;
 599         auth->u.open = p->idAuthenticationOpen;
 600         req->idAuthentication = auth;
 601     }
 602     req->implementationId = p->implementationId;
 603     req->implementationName = p->implementationName;
 604     req->implementationVersion = p->implementationVersion;
 605     req->userInformationField = 0;
 606
 607     return ir_tcl_send_APDU (interp, p, apdu, "init", argv[0]);
 608 }
 609
 610 /*
 611  * do_protocolVersion: Set protocol Version
 612  */
 613 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
 614                                int argc, char **argv)
 615 {
 616     int version, i;
 617     char buf[10];
 618     IrTcl_Obj *p = obj;
 619
 620     if (argc <= 0)
 621     {
 622         ODR_MASK_ZERO (&p->protocolVersion);
 623         ODR_MASK_SET (&p->protocolVersion, 0);
 624         ODR_MASK_SET (&p->protocolVersion, 1);
 625         return TCL_OK;
 626     }
 627     if (argc == 3)
 628     {
 629         if (Tcl_GetInt (interp, argv[2], &version)==TCL_ERROR)
 630             return TCL_ERROR;
 631         ODR_MASK_ZERO (&p->protocolVersion);
 632         for (i = 0; i<version; i++)
 633             ODR_MASK_SET (&p->protocolVersion, i);
 634     }
 635     for (i = 4; --i >= 0; )
 636         if (ODR_MASK_GET (&p->protocolVersion, i))
 637             break;
 638     sprintf (buf, "%d", i+1);
 639     interp->result = buf;
 640     return TCL_OK;
 641 }
 642
 643 /*
 644  * do_options: Set options
 645  */
 646 static int do_options (void *obj, Tcl_Interp *interp,
 647                        int argc, char **argv)
 648 {
 649     static struct ir_named_entry options_tab[] = {
 650     { "search", 0 },
 651     { "present", 1 },
 652     { "delSet", 2 },
 653     { "resourceReport", 3 },
 654     { "triggerResourceCtrl", 4},
 655     { "resourceCtrl", 5},
 656     { "accessCtrl", 6},
 657     { "scan", 7},
 658     { "sort", 8},
 659     { "extendedServices", 10},
 660     { "level-1Segmentation", 11},
 661     { "level-2Segmentation", 12},
 662     { "concurrentOperations", 13},
 663     { "namedResultSets", 14},
 664     { NULL, 0}
 665     };
 666     IrTcl_Obj *p = obj;
 667
 668     if (argc <= 0)
 669     {
 670         ODR_MASK_ZERO (&p->options);
 671         ODR_MASK_SET (&p->options, 0);
 672         ODR_MASK_SET (&p->options, 1);
 673         ODR_MASK_SET (&p->options, 4);
 674         ODR_MASK_SET (&p->options, 7);
 675         ODR_MASK_SET (&p->options, 14);
 676         return TCL_OK;
 677     }
 678     return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2);
 679 }
 680
 681 /*
 682  * do_failInfo: Get fail information
 683  */
 684 static int do_failInfo (void *obj, Tcl_Interp *interp, int argc, char **argv)
 685 {
 686     char buf[16], *cp;
 687     IrTcl_Obj *p = obj;
 688
 689     if (argc <= 0)
 690     {
 691         p->failInfo = 0;
 692         return TCL_OK;
 693     }
 694     sprintf (buf, "%d", p->failInfo);
 695     switch (p->failInfo)
 696     {
 697     case 0:
 698         cp = "ok";
 699         break;
 700     case IR_TCL_FAIL_CONNECT:
 701         cp = "connect failed";
 702         break;
 703     case IR_TCL_FAIL_READ:
 704         cp = "connection closed";
 705         break;
 706     case IR_TCL_FAIL_WRITE:
 707         cp = "connection closed";
 708         break;
 709     case IR_TCL_FAIL_IN_APDU:
 710         cp = "failed to decode incoming APDU";
 711         break;
 712     case IR_TCL_FAIL_UNKNOWN_APDU:
 713         cp = "unknown APDU";
 714         break;
 715     default:
 716         cp = "";
 717     }
 718     Tcl_AppendElement (interp, buf);
 719     Tcl_AppendElement (interp, cp);
 720     return TCL_OK;
 721 }
 722
 723 /*
 724  * do_preferredMessageSize: Set/get preferred message size
 725  */
 726 static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
 727                                     int argc, char **argv)
 728 {
 729     IrTcl_Obj *p = obj;
 730
 731     if (argc <= 0)
 732     {
 733         p->preferredMessageSize = 30000;
 734         return TCL_OK;
 735     }
 736     return get_set_int (&p->preferredMessageSize, interp, argc, argv);
 737 }
 738
 739 /*
 740  * do_maximumRecordSize: Set/get maximum record size
 741  */
 742 static int do_maximumRecordSize (void *obj, Tcl_Interp *interp,
 743                                  int argc, char **argv)
 744 {
 745     IrTcl_Obj *p = obj;
 746
 747     if (argc <= 0)
 748     {
 749         p->maximumRecordSize = 30000;
 750         return TCL_OK;
 751     }
 752     return get_set_int (&p->maximumRecordSize, interp, argc, argv);
 753 }
 754
 755 /*
 756  * do_initResult: Get init result
 757  */
 758 static int do_initResult (void *obj, Tcl_Interp *interp,
 759                           int argc, char **argv)
 760 {
 761     IrTcl_Obj *p = obj;
 762
 763     if (argc <= 0)
 764         return TCL_OK;
 765     return get_set_int (&p->initResult, interp, argc, argv);
 766 }
 767
 768
 769 /*
 770  * do_implementationName: Set/get Implementation Name.
 771  */
 772 static int do_implementationName (void *obj, Tcl_Interp *interp,
 773                                     int argc, char **argv)
 774 {
 775     IrTcl_Obj *p = obj;
 776
 777     if (argc == 0)
 778         return ir_tcl_strdup (interp, &p->implementationName,
 779                           "Index Data/IrTcl on YAZ");
 780     else if (argc == -1)
 781         return ir_tcl_strdel (interp, &p->implementationName);
 782     if (argc == 3)
 783     {
 784         free (p->implementationName);
 785         if (ir_tcl_strdup (interp, &p->implementationName, argv[2])
 786             == TCL_ERROR)
 787             return TCL_ERROR;
 788     }
 789     Tcl_AppendResult (interp, p->implementationName, (char*) NULL);
 790     return TCL_OK;
 791 }
 792
 793 /*
 794  * do_implementationId: Get Implementation Id.
 795  */
 796 static int do_implementationId (void *obj, Tcl_Interp *interp,
 797                                 int argc, char **argv)
 798 {
 799     IrTcl_Obj *p = obj;
 800
 801     if (argc == 0)
 802         return ir_tcl_strdup (interp, &p->implementationId, "YAZ (id=81)");
 803     else if (argc == -1)
 804         return ir_tcl_strdel (interp, &p->implementationId);
 805     Tcl_AppendResult (interp, p->implementationId, (char*) NULL);
 806     return TCL_OK;
 807 }
 808
 809 /*
 810  * do_implementationVersion: get Implementation Version.
 811  */
 812 static int do_implementationVersion (void *obj, Tcl_Interp *interp,
 813                                      int argc, char **argv)
 814 {
 815     IrTcl_Obj *p = obj;
 816
 817     if (argc == 0)
 818         return ir_tcl_strdup (interp, &p->implementationVersion,
 819                           "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
 820     else if (argc == -1)
 821         return ir_tcl_strdel (interp, &p->implementationVersion);
 822     Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
 823     return TCL_OK;
 824 }
 825
 826 /*
 827  * do_targetImplementationName: Get Implementation Name of target.
 828  */
 829 static int do_targetImplementationName (void *obj, Tcl_Interp *interp,
 830                                         int argc, char **argv)
 831 {
 832     IrTcl_Obj *p = obj;
 833
 834     if (argc == 0)
 835     {
 836         p->targetImplementationName = NULL;
 837         return TCL_OK;
 838     }
 839     else if (argc == -1)
 840         return ir_tcl_strdel (interp, &p->targetImplementationName);
 841     Tcl_AppendResult (interp, p->targetImplementationName, (char*) NULL);
 842     return TCL_OK;
 843 }
 844
 845 /*
 846  * do_targetImplementationId: Get Implementation Id of target
 847  */
 848 static int do_targetImplementationId (void *obj, Tcl_Interp *interp,
 849                                       int argc, char **argv)
 850 {
 851     IrTcl_Obj *p = obj;
 852
 853     if (argc == 0)
 854     {
 855         p->targetImplementationId = NULL;
 856         return TCL_OK;
 857     }
 858     else if (argc == -1)
 859         return ir_tcl_strdel (interp, &p->targetImplementationId);
 860     Tcl_AppendResult (interp, p->targetImplementationId, (char*) NULL);
 861     return TCL_OK;
 862 }
 863
 864 /*
 865  * do_targetImplementationVersion: Get Implementation Version of target
 866  */
 867 static int do_targetImplementationVersion (void *obj, Tcl_Interp *interp,
 868                                            int argc, char **argv)
 869 {
 870     IrTcl_Obj *p = obj;
 871
 872     if (argc == 0)
 873     {
 874         p->targetImplementationVersion = NULL;
 875         return TCL_OK;
 876     }
 877     else if (argc == -1)
 878         return ir_tcl_strdel (interp, &p->targetImplementationVersion);
 879     Tcl_AppendResult (interp, p->targetImplementationVersion, (char*) NULL);
 880     return TCL_OK;
 881 }
 882
 883 /*
 884  * do_idAuthentication: Set/get id Authentication
 885  */
 886 static int do_idAuthentication (void *obj, Tcl_Interp *interp,
 887                                 int argc, char **argv)
 888 {
 889     IrTcl_Obj *p = obj;
 890
 891     if (argc >= 3 || argc == -1)
 892     {
 893         free (p->idAuthenticationOpen);
 894         free (p->idAuthenticationGroupId);
 895         free (p->idAuthenticationUserId);
 896         free (p->idAuthenticationPassword);
 897     }
 898     if (argc >= 3 || argc <= 0)
 899     {
 900         p->idAuthenticationOpen = NULL;
 901         p->idAuthenticationGroupId = NULL;
 902         p->idAuthenticationUserId = NULL;
 903         p->idAuthenticationPassword = NULL;
 904     }
 905     if (argc <= 0)
 906         return TCL_OK;
 907     if (argc >= 3)
 908     {
 909         if (argc == 3)
 910         {
 911             if (argv[2][0] &&
 912                 ir_tcl_strdup (interp, &p->idAuthenticationOpen, argv[2])
 913                 == TCL_ERROR)
 914                 return TCL_ERROR;
 915         }
 916         else if (argc == 5)
 917         {
 918             if (argv[2][0] &&
 919                 ir_tcl_strdup (interp, &p->idAuthenticationGroupId, argv[2])
 920                 == TCL_ERROR)
 921                 return TCL_ERROR;
 922             if (argv[3][0] &&
 923                 ir_tcl_strdup (interp, &p->idAuthenticationUserId, argv[3])
 924                 == TCL_ERROR)
 925                 return TCL_ERROR;
 926             if (argv[4][0] &&
 927                 ir_tcl_strdup (interp, &p->idAuthenticationPassword, argv[4])
 928                 == TCL_ERROR)
 929                 return TCL_ERROR;
 930         }
 931     }
 932     if (p->idAuthenticationOpen)
 933         Tcl_AppendElement (interp, p->idAuthenticationOpen);
 934     else if (p->idAuthenticationGroupId)
 935     {
 936         Tcl_AppendElement (interp, p->idAuthenticationGroupId);
 937         Tcl_AppendElement (interp, p->idAuthenticationUserId);
 938         Tcl_AppendElement (interp, p->idAuthenticationPassword);
 939     }
 940     return TCL_OK;
 941 }
 942
 943 /*
 944  * do_connect: connect method on IR object
 945  */
 946 static int do_connect (void *obj, Tcl_Interp *interp,
 947                        int argc, char **argv)
 948 {
 949     void *addr;
 950     IrTcl_Obj *p = obj;
 951     int r;
 952
 953     if (argc <= 0)
 954         return TCL_OK;
 955     if (argc == 3)
 956     {
 957         if (p->hostname)
 958         {
 959             interp->result = "already connected";
 960             return TCL_ERROR;
 961         }
 962         if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
 963             return TCL_ERROR;
 964         if (!strcmp (p->cs_type, "tcpip"))
 965         {
 966             p->cs_link = cs_create (tcpip_type, CS_BLOCK, p->protocol_type);
 967             addr = tcpip_strtoaddr (argv[2]);
 968             if (!addr)
 969             {
 970                 interp->result = "tcpip_strtoaddr fail";
 971                 return TCL_ERROR;
 972             }
 973             logf (LOG_DEBUG, "tcp/ip connect %s", argv[2]);
 974         }
 975         else if (!strcmp (p->cs_type, "mosi"))
 976         {
 977 #if MOSI
 978             p->cs_link = cs_create (mosi_type, CS_BLOCK, p->protocol_type);
 979             addr = mosi_strtoaddr (argv[2]);
 980             if (!addr)
 981             {
 982                 interp->result = "mosi_strtoaddr fail";
 983                 return TCL_ERROR;
 984             }
 985             logf (LOG_DEBUG, "mosi connect %s", argv[2]);
 986 #else
 987             interp->result = "MOSI support not there";
 988             return TCL_ERROR;
 989 #endif
 990         }
 991         else
 992         {
 993             Tcl_AppendResult (interp, "Bad comstack type: ",
 994                               p->cs_type, NULL);
 995             return TCL_ERROR;
 996         }
 997         if ((r=cs_connect (p->cs_link, addr)) < 0)
 998         {
 999             interp->result = "connect fail";
1000             do_disconnect (p, NULL, 2, NULL);
1001             return TCL_ERROR;
1002         }
1003         p->eventType = "connect";
1004         ir_select_add (cs_fileno (p->cs_link), p);
1005         if (r == 1)
1006         {
1007             ir_select_add_write (cs_fileno (p->cs_link), p);
1008             p->state = IR_TCL_R_Connecting;
1009         }
1010         else
1011         {
1012             p->state = IR_TCL_R_Idle;
1013             if (p->callback)
1014                 IrTcl_eval (p->interp, p->callback);
1015         }
1016     }
1017     else
1018         Tcl_AppendResult (interp, p->hostname, NULL);
1019     return TCL_OK;
1020 }
1021
1022 /*
1023  * do_disconnect: disconnect method on IR object
1024  */
1025 static int do_disconnect (void *obj, Tcl_Interp *interp,
1026                           int argc, char **argv)
1027 {
1028     IrTcl_Obj *p = obj;
1029
1030     if (argc == 0)
1031     {
1032         p->state = IR_TCL_R_Idle;
1033         p->eventType = NULL;
1034         p->hostname = NULL;
1035         p->cs_link = NULL;
1036         return TCL_OK;
1037     }
1038     if (p->hostname)
1039     {
1040         free (p->hostname);
1041         p->hostname = NULL;
1042         ir_select_remove_write (cs_fileno (p->cs_link), p);
1043         ir_select_remove (cs_fileno (p->cs_link), p);
1044
1045         odr_reset (p->odr_in);
1046
1047         assert (p->cs_link);
1048         cs_close (p->cs_link);
1049         p->cs_link = NULL;
1050
1051         ODR_MASK_ZERO (&p->options);
1052         ODR_MASK_SET (&p->options, 0);
1053         ODR_MASK_SET (&p->options, 1);
1054         ODR_MASK_SET (&p->options, 4);
1055         ODR_MASK_SET (&p->options, 7);
1056         ODR_MASK_SET (&p->options, 14);
1057
1058         ODR_MASK_ZERO (&p->protocolVersion);
1059         ODR_MASK_SET (&p->protocolVersion, 0);
1060         ODR_MASK_SET (&p->protocolVersion, 1);
1061         ir_tcl_del_q (p);
1062     }
1063     assert (!p->cs_link);
1064     return TCL_OK;
1065 }
1066
1067 /*
1068  * do_comstack: Set/get comstack method on IR object
1069  */
1070 static int do_comstack (void *o, Tcl_Interp *interp,
1071                         int argc, char **argv)
1072 {
1073     IrTcl_Obj *obj = o;
1074
1075     if (argc == 0)
1076         return ir_tcl_strdup (interp, &obj->cs_type, "tcpip");
1077     else if (argc == -1)
1078         return ir_tcl_strdel (interp, &obj->cs_type);
1079     else if (argc == 3)
1080     {
1081         free (obj->cs_type);
1082         if (ir_tcl_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR)
1083             return TCL_ERROR;
1084     }
1085     Tcl_AppendElement (interp, obj->cs_type);
1086     return TCL_OK;
1087 }
1088
1089 /*
1090  * do_logLevel: Set log level
1091  */
1092 static int do_logLevel (void *o, Tcl_Interp *interp,
1093                         int argc, char **argv)
1094 {
1095     if (argc <= 2)
1096         return TCL_OK;
1097     if (argc == 3)
1098         log_init (log_mask_str (argv[2]), "", NULL);
1099     else if (argc == 4)
1100         log_init (log_mask_str (argv[2]), argv[3], NULL);
1101     else if (argc == 5)
1102         log_init (log_mask_str (argv[2]), argv[3], argv[4]);
1103     return TCL_OK;
1104 }
1105
1106
1107 /*
1108  * do_eventType: Return type of last event
1109  */
1110 static int do_eventType (void *obj, Tcl_Interp *interp,
1111                          int argc, char **argv)
1112 {
1113     IrTcl_Obj *p = obj;
1114
1115     if (argc <= 0)
1116     {
1117         p->eventType = NULL;
1118         return TCL_OK;
1119     }
1120     Tcl_AppendElement (interp, p->eventType ? p->eventType : "");
1121     return TCL_OK;
1122 }
1123
1124
1125 /*
1126  * do_callback: add callback
1127  */
1128 static int do_callback (void *obj, Tcl_Interp *interp,
1129                         int argc, char **argv)
1130 {
1131     IrTcl_Obj *p = obj;
1132
1133     if (argc == 0)
1134     {
1135         p->callback = NULL;
1136         return TCL_OK;
1137     }
1138     else if (argc == -1)
1139         return ir_tcl_strdel (interp, &p->callback);
1140     if (argc == 3)
1141     {
1142         free (p->callback);
1143         if (argv[2][0])
1144         {
1145             if (ir_tcl_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
1146                 return TCL_ERROR;
1147         }
1148         else
1149             p->callback = NULL;
1150     }
1151     return TCL_OK;
1152 }
1153
1154 /*
1155  * do_failback: add error handle callback
1156  */
1157 static int do_failback (void *obj, Tcl_Interp *interp,
1158                           int argc, char **argv)
1159 {
1160     IrTcl_Obj *p = obj;
1161
1162     if (argc == 0)
1163     {
1164         p->failback = NULL;
1165         return TCL_OK;
1166     }
1167     else if (argc == -1)
1168         return ir_tcl_strdel (interp, &p->failback);
1169     else if (argc == 3)
1170     {
1171         free (p->failback);
1172         if (argv[2][0])
1173         {
1174             if (ir_tcl_strdup (interp, &p->failback, argv[2]) == TCL_ERROR)
1175                 return TCL_ERROR;
1176         }
1177         else
1178             p->failback = NULL;
1179     }
1180     return TCL_OK;
1181 }
1182
1183 /*
1184  * do_protocol: Set/get protocol method on IR object
1185  */
1186 static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv)
1187 {
1188     IrTcl_Obj *p = o;
1189
1190     if (argc <= 0)
1191     {
1192         p->protocol_type = PROTO_Z3950;
1193         return TCL_OK;
1194     }
1195     else if (argc == 3)
1196     {
1197         if (!strcmp (argv[2], "Z39"))
1198             p->protocol_type = PROTO_Z3950;
1199         else if (!strcmp (argv[2], "SR"))
1200             p->protocol_type = PROTO_SR;
1201         else
1202         {
1203             Tcl_AppendResult (interp, "Bad protocol: ", argv[2], NULL);
1204             return TCL_ERROR;
1205         }
1206         return TCL_OK;
1207     }
1208     switch (p->protocol_type)
1209     {
1210     case PROTO_Z3950:
1211         Tcl_AppendElement (interp, "Z39");
1212         break;
1213     case PROTO_SR:
1214         Tcl_AppendElement (interp, "SR");
1215         break;
1216     }
1217     return TCL_OK;
1218 }
1219
1220 /*
1221  * do_triggerResourceControl:
1222  */
1223 static int do_triggerResourceControl (void *obj, Tcl_Interp *interp,
1224                                       int argc, char **argv)
1225 {
1226     IrTcl_Obj *p = obj;
1227     Z_APDU *apdu;
1228     Z_TriggerResourceControlRequest *req;
1229     bool_t is_false = 0;
1230
1231     if (argc <= 0)
1232         return TCL_OK;
1233     if (!p->cs_link)
1234     {
1235         interp->result = "triggerResourceControl: not connected";
1236         return TCL_ERROR;
1237     }
1238     apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest);
1239     req = apdu->u.triggerResourceControlRequest;
1240     *req->requestedAction = Z_TriggerResourceCtrl_cancel;
1241     req->resultSetWanted = &is_false;
1242
1243     return ir_tcl_send_APDU (interp, p, apdu, "triggerResourceControl",
1244                              argv[0]);
1245 }
1246
1247 /*
1248  * do_databaseNames: specify database names
1249  */
1250 static int do_databaseNames (void *obj, Tcl_Interp *interp,
1251                              int argc, char **argv)
1252 {
1253     int i;
1254     IrTcl_SetCObj *p = obj;
1255
1256     if (argc == -1)
1257     {
1258         for (i=0; i<p->num_databaseNames; i++)
1259             free (p->databaseNames[i]);
1260         free (p->databaseNames);
1261     }
1262     if (argc <= 0)
1263     {
1264         p->num_databaseNames = 0;
1265         p->databaseNames = NULL;
1266         return TCL_OK;
1267     }
1268     if (argc < 3)
1269     {
1270         for (i=0; i<p->num_databaseNames; i++)
1271             Tcl_AppendElement (interp, p->databaseNames[i]);
1272         return TCL_OK;
1273     }
1274     if (p->databaseNames)
1275     {
1276         for (i=0; i<p->num_databaseNames; i++)
1277             free (p->databaseNames[i]);
1278         free (p->databaseNames);
1279     }
1280     p->num_databaseNames = argc - 2;
1281     p->databaseNames =
1282         ir_tcl_malloc (sizeof(*p->databaseNames) * p->num_databaseNames);
1283     for (i=0; i<p->num_databaseNames; i++)
1284     {
1285         if (ir_tcl_strdup (interp, &p->databaseNames[i], argv[2+i])
1286             == TCL_ERROR)
1287             return TCL_ERROR;
1288     }
1289     return TCL_OK;
1290 }
1291
1292 /*
1293  * do_replaceIndicator: Set/get replace Set indicator
1294  */
1295 static int do_replaceIndicator (void *obj, Tcl_Interp *interp,
1296                                 int argc, char **argv)
1297 {
1298     IrTcl_SetCObj *p = obj;
1299
1300     if (argc <= 0)
1301     {
1302         p->replaceIndicator = 1;
1303         return TCL_OK;
1304     }
1305     return get_set_int (&p->replaceIndicator, interp, argc, argv);
1306 }
1307
1308 /*
1309  * do_queryType: Set/Get query method
1310  */
1311 static int do_queryType (void *obj, Tcl_Interp *interp,
1312                        int argc, char **argv)
1313 {
1314     IrTcl_SetCObj *p = obj;
1315
1316     if (argc == 0)
1317         return ir_tcl_strdup (interp, &p->queryType, "rpn");
1318     else if (argc == -1)
1319         return ir_tcl_strdel (interp, &p->queryType);
1320     if (argc == 3)
1321     {
1322         free (p->queryType);
1323         if (ir_tcl_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR)
1324             return TCL_ERROR;
1325     }
1326     Tcl_AppendResult (interp, p->queryType, NULL);
1327     return TCL_OK;
1328 }
1329
1330 /*
1331  * do_userInformationField: Get User information field
1332  */
1333 static int do_userInformationField (void *obj, Tcl_Interp *interp,
1334                                     int argc, char **argv)
1335 {
1336     IrTcl_Obj *p = obj;
1337
1338     if (argc == 0)
1339     {
1340         p->userInformationField = NULL;
1341         return TCL_OK;
1342     }
1343     else if (argc == -1)
1344         return ir_tcl_strdel (interp, &p->userInformationField);
1345     Tcl_AppendResult (interp, p->userInformationField, NULL);
1346     return TCL_OK;
1347 }
1348
1349 /*
1350  * do_smallSetUpperBound: Set/get small set upper bound
1351  */
1352 static int do_smallSetUpperBound (void *o, Tcl_Interp *interp,
1353                        int argc, char **argv)
1354 {
1355     IrTcl_SetCObj *p = o;
1356
1357     if (argc <= 0)
1358     {
1359         p->smallSetUpperBound = 0;
1360         return TCL_OK;
1361     }
1362     return get_set_int (&p->smallSetUpperBound, interp, argc, argv);
1363 }
1364
1365 /*
1366  * do_largeSetLowerBound: Set/get large set lower bound
1367  */
1368 static int do_largeSetLowerBound (void *o, Tcl_Interp *interp,
1369                                   int argc, char **argv)
1370 {
1371     IrTcl_SetCObj *p = o;
1372
1373     if (argc <= 0)
1374     {
1375         p->largeSetLowerBound = 2;
1376         return TCL_OK;
1377     }
1378     return get_set_int (&p->largeSetLowerBound, interp, argc, argv);
1379 }
1380
1381 /*
1382  * do_mediumSetPresentNumber: Set/get large set lower bound
1383  */
1384 static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp,
1385                                       int argc, char **argv)
1386 {
1387     IrTcl_SetCObj *p = o;
1388
1389     if (argc <= 0)
1390     {
1391         p->mediumSetPresentNumber = 0;
1392         return TCL_OK;
1393     }
1394     return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv);
1395 }
1396
1397 /*
1398  * do_referenceId: Set/Get referenceId
1399  */
1400 static int do_referenceId (void *obj, Tcl_Interp *interp,
1401                            int argc, char **argv)
1402 {
1403     IrTcl_SetCObj *p = obj;
1404
1405     if (argc == 0)
1406     {
1407         p->referenceId = NULL;
1408         return TCL_OK;
1409     }
1410     else if (argc == -1)
1411         return ir_tcl_strdel (interp, &p->referenceId);
1412     if (argc == 3)
1413     {
1414         free (p->referenceId);
1415         if (ir_tcl_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR)
1416             return TCL_ERROR;
1417     }
1418     Tcl_AppendResult (interp, p->referenceId, NULL);
1419     return TCL_OK;
1420 }
1421
1422 /*
1423  * do_preferredRecordSyntax: Set/get preferred record syntax
1424  */
1425 static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp,
1426                                      int argc, char **argv)
1427 {
1428     IrTcl_SetCObj *p = obj;
1429
1430     if (argc == 0)
1431     {
1432         p->preferredRecordSyntax = NULL;
1433         return TCL_OK;
1434     }
1435     else if (argc == -1)
1436     {
1437         free (p->preferredRecordSyntax);
1438         p->preferredRecordSyntax = NULL;
1439         return TCL_OK;
1440     }
1441     if (argc == 3)
1442     {
1443         free (p->preferredRecordSyntax);
1444         p->preferredRecordSyntax = NULL;
1445         if (argv[2][0] && (p->preferredRecordSyntax =
1446                            ir_tcl_malloc (sizeof(*p->preferredRecordSyntax))))
1447             *p->preferredRecordSyntax = IrTcl_getRecordSyntaxVal (argv[2]);
1448     }
1449     return TCL_OK;
1450
1451 }
1452
1453 /*
1454  * do_elementSetNames: Set/Get element Set Names
1455  */
1456 static int do_elementSetNames (void *obj, Tcl_Interp *interp,
1457                                int argc, char **argv)
1458 {
1459     IrTcl_SetCObj *p = obj;
1460
1461     if (argc == 0)
1462     {
1463         p->elementSetNames = NULL;
1464         return TCL_OK;
1465     }
1466     else if (argc == -1)
1467         return ir_tcl_strdel (interp, &p->elementSetNames);
1468     if (argc == 3)
1469     {
1470         free (p->elementSetNames);
1471         if (ir_tcl_strdup (interp, &p->elementSetNames, argv[2]) == TCL_ERROR)
1472             return TCL_ERROR;
1473     }
1474     Tcl_AppendResult (interp, p->elementSetNames, NULL);
1475     return TCL_OK;
1476 }
1477
1478 /*
1479  * do_smallSetElementSetNames: Set/Get small Set Element Set Names
1480  */
1481 static int do_smallSetElementSetNames (void *obj, Tcl_Interp *interp,
1482                                int argc, char **argv)
1483 {
1484     IrTcl_SetCObj *p = obj;
1485
1486     if (argc == 0)
1487     {
1488         p->smallSetElementSetNames = NULL;
1489         return TCL_OK;
1490     }
1491     else if (argc == -1)
1492         return ir_tcl_strdel (interp, &p->smallSetElementSetNames);
1493     if (argc == 3)
1494     {
1495         free (p->smallSetElementSetNames);
1496         if (ir_tcl_strdup (interp, &p->smallSetElementSetNames,
1497                            argv[2]) == TCL_ERROR)
1498             return TCL_ERROR;
1499     }
1500     Tcl_AppendResult (interp, p->smallSetElementSetNames, NULL);
1501     return TCL_OK;
1502 }
1503
1504 /*
1505  * do_mediumSetElementSetNames: Set/Get medium Set Element Set Names
1506  */
1507 static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp,
1508                                int argc, char **argv)
1509 {
1510     IrTcl_SetCObj *p = obj;
1511
1512     if (argc == 0)
1513     {
1514         p->mediumSetElementSetNames = NULL;
1515         return TCL_OK;
1516     }
1517     else if (argc == -1)
1518         return ir_tcl_strdel (interp, &p->mediumSetElementSetNames);
1519     if (argc == 3)
1520     {
1521         free (p->mediumSetElementSetNames);
1522         if (ir_tcl_strdup (interp, &p->mediumSetElementSetNames,
1523                            argv[2]) == TCL_ERROR)
1524             return TCL_ERROR;
1525     }
1526     Tcl_AppendResult (interp, p->mediumSetElementSetNames, NULL);
1527     return TCL_OK;
1528 }
1529
1530 static IrTcl_Method ir_method_tab[] = {
1531 { 1, "comstack",                    do_comstack },
1532 { 1, "protocol",                    do_protocol },
1533 { 0, "failback",                    do_failback },
1534 { 0, "failInfo",                    do_failInfo },
1535 { 0, "logLevel",                    do_logLevel },
1536
1537 { 0, "eventType",                   do_eventType },
1538 { 1, "connect",                     do_connect },
1539 { 0, "protocolVersion",             do_protocolVersion },
1540 { 1, "preferredMessageSize",        do_preferredMessageSize },
1541 { 1, "maximumRecordSize",           do_maximumRecordSize },
1542 { 1, "implementationName",          do_implementationName },
1543 { 1, "implementationId",            do_implementationId },
1544 { 1, "implementationVersion",       do_implementationVersion },
1545 { 0, "targetImplementationName",    do_targetImplementationName },
1546 { 0, "targetImplementationId",      do_targetImplementationId },
1547 { 0, "targetImplementationVersion", do_targetImplementationVersion },
1548 { 0, "userInformationField",        do_userInformationField },
1549 { 1, "idAuthentication",            do_idAuthentication },
1550 { 0, "options",                     do_options },
1551 { 0, "init",                        do_init_request },
1552 { 0, "initResult",                  do_initResult },
1553 { 0, "disconnect",                  do_disconnect },
1554 { 0, "callback",                    do_callback },
1555 { 0, "triggerResourceControl",      do_triggerResourceControl },
1556 { 0, NULL, NULL}
1557 };
1558
1559 static IrTcl_Method ir_set_c_method_tab[] = {
1560 { 0, "databaseNames",               do_databaseNames},
1561 { 0, "replaceIndicator",            do_replaceIndicator},
1562 { 0, "queryType",                   do_queryType },
1563 { 0, "preferredRecordSyntax",       do_preferredRecordSyntax },
1564 { 0, "smallSetUpperBound",          do_smallSetUpperBound},
1565 { 0, "largeSetLowerBound",          do_largeSetLowerBound},
1566 { 0, "mediumSetPresentNumber",      do_mediumSetPresentNumber},
1567 { 0, "referenceId",                 do_referenceId },
1568 { 0, "elementSetNames",             do_elementSetNames },
1569 { 0, "smallSetElementSetNames",     do_smallSetElementSetNames },
1570 { 0, "mediumSetElementSetNames",    do_mediumSetElementSetNames },
1571 { 0, NULL, NULL}
1572 };
1573
1574 /*
1575  * ir_obj_method: IR Object methods
1576  */
1577 static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
1578                           int argc, char **argv)
1579 {
1580     IrTcl_Methods tab[3];
1581     IrTcl_Obj *p = clientData;
1582
1583     if (argc < 2)
1584         return ir_method_r (clientData, interp, argc, argv, ir_method_tab);
1585
1586     tab[0].tab = ir_method_tab;
1587     tab[0].obj = p;
1588     tab[1].tab = ir_set_c_method_tab;
1589     tab[1].obj = &p->set_inher;
1590     tab[2].tab = NULL;
1591
1592     return ir_method (interp, argc, argv, tab);
1593 }
1594
1595 /*
1596  * ir_obj_delete: IR Object disposal
1597  */
1598 static void ir_obj_delete (ClientData clientData)
1599 {
1600     IrTcl_Obj *obj = clientData;
1601     IrTcl_Methods tab[3];
1602
1603     --(obj->ref_count);
1604     if (obj->ref_count > 0)
1605         return;
1606     assert (obj->ref_count == 0);
1607
1608     logf (LOG_DEBUG, "ir object delete");
1609     tab[0].tab = ir_method_tab;
1610     tab[0].obj = obj;
1611     tab[1].tab = ir_set_c_method_tab;
1612     tab[1].obj = &obj->set_inher;
1613     tab[2].tab = NULL;
1614
1615     ir_method (NULL, -1, NULL, tab);
1616
1617     ir_tcl_del_q (obj);
1618     odr_destroy (obj->odr_in);
1619     odr_destroy (obj->odr_out);
1620     odr_destroy (obj->odr_pr);
1621     free (obj);
1622 }
1623
1624 /*
1625  * ir_obj_mk: IR Object creation
1626  */
1627 static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
1628                       int argc, char **argv)
1629 {
1630     IrTcl_Methods tab[3];
1631     IrTcl_Obj *obj;
1632 #if CCL2RPN
1633     FILE *inf;
1634 #endif
1635
1636     if (argc != 2)
1637     {
1638         interp->result = "wrong # args";
1639         return TCL_ERROR;
1640     }
1641     obj = ir_tcl_malloc (sizeof(*obj));
1642     obj->ref_count = 1;
1643 #if CCL2RPN
1644     obj->bibset = ccl_qual_mk ();
1645     if ((inf = fopen ("default.bib", "r")))
1646     {
1647         ccl_qual_file (obj->bibset, inf);
1648         fclose (inf);
1649     }
1650 #endif
1651
1652     logf (LOG_DEBUG, "ir object create");
1653     obj->odr_in = odr_createmem (ODR_DECODE);
1654     obj->odr_out = odr_createmem (ODR_ENCODE);
1655     obj->odr_pr = odr_createmem (ODR_PRINT);
1656     obj->state = IR_TCL_R_Idle;
1657     obj->interp = interp;
1658
1659     obj->len_in = 0;
1660     obj->buf_in = NULL;
1661     obj->request_queue = NULL;
1662
1663     tab[0].tab = ir_method_tab;
1664     tab[0].obj = obj;
1665     tab[1].tab = ir_set_c_method_tab;
1666     tab[1].obj = &obj->set_inher;
1667     tab[2].tab = NULL;
1668
1669     if (ir_method (interp, 0, NULL, tab) == TCL_ERROR)
1670         return TCL_ERROR;
1671     Tcl_CreateCommand (interp, argv[1], ir_obj_method,
1672                        (ClientData) obj, ir_obj_delete);
1673     return TCL_OK;
1674 }
1675
1676 /* ------------------------------------------------------- */
1677 /*
1678  * do_search: Do search request
1679  */
1680 static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
1681 {
1682     Z_SearchRequest *req;
1683     Z_Query query;
1684     Z_APDU *apdu;
1685     Odr_oct ccl_query;
1686     IrTcl_SetObj *obj = o;
1687     IrTcl_Obj *p;
1688     int r;
1689     oident bib1;
1690
1691     if (argc <= 0)
1692         return TCL_OK;
1693
1694     p = obj->parent;
1695     if (argc != 3)
1696     {
1697         interp->result = "wrong # args";
1698         return TCL_ERROR;
1699     }
1700     if (!obj->set_inher.num_databaseNames)
1701     {
1702         interp->result = "no databaseNames";
1703         return TCL_ERROR;
1704     }
1705     if (!p->cs_link)
1706     {
1707         interp->result = "search: not connected";
1708         return TCL_ERROR;
1709     }
1710     apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest);
1711     req = apdu->u.searchRequest;
1712
1713     obj->start = 1;
1714
1715     bib1.proto = p->protocol_type;
1716     bib1.oclass = CLASS_ATTSET;
1717     bib1.value = VAL_BIB1;
1718
1719     set_referenceId (p->odr_out, &req->referenceId,
1720                      obj->set_inher.referenceId);
1721
1722     req->smallSetUpperBound = &obj->set_inher.smallSetUpperBound;
1723     req->largeSetLowerBound = &obj->set_inher.largeSetLowerBound;
1724     req->mediumSetPresentNumber = &obj->set_inher.mediumSetPresentNumber;
1725     req->replaceIndicator = &obj->set_inher.replaceIndicator;
1726     req->resultSetName = obj->setName ? obj->setName : "Default";
1727     logf (LOG_DEBUG, "Search, resultSetName %s", req->resultSetName);
1728     req->num_databaseNames = obj->set_inher.num_databaseNames;
1729     req->databaseNames = obj->set_inher.databaseNames;
1730     for (r=0; r < obj->set_inher.num_databaseNames; r++)
1731         logf (LOG_DEBUG, " Database %s", obj->set_inher.databaseNames[r]);
1732     if (obj->set_inher.preferredRecordSyntax)
1733     {
1734         struct oident ident;
1735
1736         ident.proto = p->protocol_type;
1737         ident.oclass = CLASS_RECSYN;
1738         ident.value = *obj->set_inher.preferredRecordSyntax;
1739         logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
1740         req->preferredRecordSyntax = odr_oiddup (p->odr_out,
1741                                                  oid_getoidbyent (&ident));
1742     }
1743     else
1744         req->preferredRecordSyntax = 0;
1745
1746     if (obj->set_inher.smallSetElementSetNames &&
1747         *obj->set_inher.smallSetElementSetNames)
1748     {
1749         Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn));
1750
1751         esn->which = Z_ElementSetNames_generic;
1752         esn->u.generic = obj->set_inher.smallSetElementSetNames;
1753         req->smallSetElementSetNames = esn;
1754     }
1755     else
1756         req->smallSetElementSetNames = NULL;
1757
1758     if (obj->set_inher.mediumSetElementSetNames &&
1759         *obj->set_inher.mediumSetElementSetNames)
1760     {
1761         Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn));
1762
1763         esn->which = Z_ElementSetNames_generic;
1764         esn->u.generic = obj->set_inher.mediumSetElementSetNames;
1765         req->mediumSetElementSetNames = esn;
1766     }
1767     else
1768         req->mediumSetElementSetNames = NULL;
1769
1770     req->query = &query;
1771
1772     if (!strcmp (obj->set_inher.queryType, "rpn"))
1773     {
1774         Z_RPNQuery *RPNquery;
1775
1776         RPNquery = p_query_rpn (p->odr_out, argv[2]);
1777         if (!RPNquery)
1778         {
1779             Tcl_AppendResult (interp, "Syntax error in query", NULL);
1780             return TCL_ERROR;
1781         }
1782         RPNquery->attributeSetId = oid_getoidbyent (&bib1);
1783         query.which = Z_Query_type_1;
1784         query.u.type_1 = RPNquery;
1785         logf (LOG_DEBUG, "RPN");
1786     }
1787 #if CCL2RPN
1788     else if (!strcmp (obj->set_inher.queryType, "cclrpn"))
1789     {
1790         int error;
1791         int pos;
1792         struct ccl_rpn_node *rpn;
1793         Z_RPNQuery *RPNquery;
1794
1795         rpn = ccl_find_str(p->bibset, argv[2], &error, &pos);
1796         if (error)
1797         {
1798             Tcl_AppendResult (interp, "CCL error: ",
1799                               ccl_err_msg(error), NULL);
1800             return TCL_ERROR;
1801         }
1802         ccl_pr_tree (rpn, stderr);
1803         fprintf (stderr, "\n");
1804         assert((RPNquery = ccl_rpn_query(rpn)));
1805         RPNquery->attributeSetId = oid_getoidbyent (&bib1);
1806         query.which = Z_Query_type_1;
1807         query.u.type_1 = RPNquery;
1808         logf (LOG_DEBUG, "CCLRPN");
1809     }
1810 #endif
1811     else if (!strcmp (obj->set_inher.queryType, "ccl"))
1812     {
1813         query.which = Z_Query_type_2;
1814         query.u.type_2 = &ccl_query;
1815         ccl_query.buf = (unsigned char *) argv[2];
1816         ccl_query.len = strlen (argv[2]);
1817         logf (LOG_DEBUG, "CCL");
1818     }
1819     else
1820     {
1821         interp->result = "unknown query method";
1822         return TCL_ERROR;
1823     }
1824     return ir_tcl_send_APDU (interp, p, apdu, "search", argv[0]);
1825 }
1826
1827 /*
1828  * do_resultCount: Get number of hits
1829  */
1830 static int do_resultCount (void *o, Tcl_Interp *interp,
1831                        int argc, char **argv)
1832 {
1833     IrTcl_SetObj *obj = o;
1834
1835     if (argc <= 0)
1836         return TCL_OK;
1837     return get_set_int (&obj->resultCount, interp, argc, argv);
1838 }
1839
1840 /*
1841  * do_searchStatus: Get search status (after search response)
1842  */
1843 static int do_searchStatus (void *o, Tcl_Interp *interp,
1844                             int argc, char **argv)
1845 {
1846     IrTcl_SetObj *obj = o;
1847
1848     if (argc <= 0)
1849         return TCL_OK;
1850     return get_set_int (&obj->searchStatus, interp, argc, argv);
1851 }
1852
1853 /*
1854  * do_presentStatus: Get search status (after search/present response)
1855  */
1856 static int do_presentStatus (void *o, Tcl_Interp *interp,
1857                             int argc, char **argv)
1858 {
1859     IrTcl_SetObj *obj = o;
1860
1861     if (argc <= 0)
1862         return TCL_OK;
1863     return get_set_int (&obj->presentStatus, interp, argc, argv);
1864 }
1865
1866 /*
1867  * do_nextResultSetPosition: Get next result set position
1868  *       (after search/present response)
1869  */
1870 static int do_nextResultSetPosition (void *o, Tcl_Interp *interp,
1871                                      int argc, char **argv)
1872 {
1873     IrTcl_SetObj *obj = o;
1874
1875     if (argc <= 0)
1876     {
1877         obj->nextResultSetPosition = 0;
1878         return TCL_OK;
1879     }
1880     return get_set_int (&obj->nextResultSetPosition, interp, argc, argv);
1881 }
1882
1883 /*
1884  * do_setName: Set result Set name
1885  */
1886 static int do_setName (void *o, Tcl_Interp *interp,
1887                        int argc, char **argv)
1888 {
1889     IrTcl_SetObj *obj = o;
1890
1891     if (argc == 0)
1892         return ir_tcl_strdup (interp, &obj->setName, "Default");
1893     else if (argc == -1)
1894         return ir_tcl_strdel (interp, &obj->setName);
1895     if (argc == 3)
1896     {
1897         free (obj->setName);
1898         if (ir_tcl_strdup (interp, &obj->setName, argv[2])
1899             == TCL_ERROR)
1900             return TCL_ERROR;
1901     }
1902     Tcl_AppendElement (interp, obj->setName);
1903     return TCL_OK;
1904 }
1905
1906 /*
1907  * do_numberOfRecordsReturned: Get number of records returned
1908  */
1909 static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp,
1910                                        int argc, char **argv)
1911 {
1912     IrTcl_SetObj *obj = o;
1913
1914     if (argc <= 0)
1915     {
1916         obj->numberOfRecordsReturned = 0;
1917         return TCL_OK;
1918     }
1919     return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv);
1920 }
1921
1922 /*
1923  * do_type: Return type (if any) at position.
1924  */
1925 static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv)
1926 {
1927     IrTcl_SetObj *obj = o;
1928     int offset;
1929     IrTcl_RecordList *rl;
1930
1931     if (argc == 0)
1932     {
1933         obj->record_list = NULL;
1934         return TCL_OK;
1935     }
1936     else if (argc == -1)
1937     {
1938         delete_IR_records (obj);
1939         return TCL_OK;
1940     }
1941     if (argc != 3)
1942     {
1943         sprintf (interp->result, "wrong # args");
1944         return TCL_ERROR;
1945     }
1946     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1947         return TCL_ERROR;
1948     rl = find_IR_record (obj, offset);
1949     if (!rl)
1950     {
1951         logf (LOG_DEBUG, "No record at position %d", offset);
1952         return TCL_OK;
1953     }
1954     switch (rl->which)
1955     {
1956     case Z_NamePlusRecord_databaseRecord:
1957         interp->result = "DB";
1958         break;
1959     case Z_NamePlusRecord_surrogateDiagnostic:
1960         interp->result = "SD";
1961         break;
1962     }
1963     return TCL_OK;
1964 }
1965
1966
1967 /*
1968  * do_recordType: Return record type (if any) at position.
1969  */
1970 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
1971 {
1972     IrTcl_SetObj *obj = o;
1973     int offset;
1974     IrTcl_RecordList *rl;
1975
1976     if (argc == 0)
1977     {
1978         return TCL_OK;
1979     }
1980     else if (argc == -1)
1981     {
1982         return TCL_OK;
1983     }
1984     if (argc != 3)
1985     {
1986         sprintf (interp->result, "wrong # args");
1987         return TCL_ERROR;
1988     }
1989     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1990         return TCL_ERROR;
1991     rl = find_IR_record (obj, offset);
1992     if (!rl)
1993         return TCL_OK;
1994     if (rl->which != Z_NamePlusRecord_databaseRecord)
1995     {
1996         Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
1997         return TCL_ERROR;
1998     }
1999     Tcl_AppendElement (interp, (char*)
2000                        IrTcl_getRecordSyntaxStr (rl->u.dbrec.type));
2001     return TCL_OK;
2002 }
2003
2004 /*
2005  * set record elements (for record extraction)
2006  */
2007 static int do_recordElements (void *o, Tcl_Interp *interp,
2008                               int argc, char **argv)
2009 {
2010     IrTcl_SetObj *obj = o;
2011
2012     if (argc == 0)
2013     {
2014         obj->recordElements = NULL;
2015         return TCL_OK;
2016     }
2017     else if (argc == -1)
2018         return ir_tcl_strdel (NULL, &obj->recordElements);
2019     if (argc > 3)
2020     {
2021         sprintf (interp->result, "wrong # args");
2022         return TCL_ERROR;
2023     }
2024     if (argc == 3)
2025     {
2026         free (obj->recordElements);
2027         return ir_tcl_strdup (NULL, &obj->recordElements,
2028                               (*argv[2] ? argv[2] : NULL));
2029     }
2030     Tcl_AppendResult (interp, obj->recordElements, NULL);
2031     return TCL_OK;
2032 }
2033
2034 /*
2035  * ir_diagResult
2036  */
2037 static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num)
2038 {
2039     char buf[20];
2040     int i;
2041     const char *cp;
2042
2043     for (i = 0; i<num; i++)
2044     {
2045         logf (LOG_DEBUG, "Diagnostic, code %d", list[i].condition);
2046         sprintf (buf, "%d", list[i].condition);
2047         Tcl_AppendElement (interp, buf);
2048         cp = diagbib1_str (list[i].condition);
2049         if (cp)
2050             Tcl_AppendElement (interp, (char*) cp);
2051         else
2052             Tcl_AppendElement (interp, "");
2053         if (list[i].addinfo)
2054             Tcl_AppendElement (interp, (char*) list[i].addinfo);
2055         else
2056             Tcl_AppendElement (interp, "");
2057     }
2058     return TCL_OK;
2059 }
2060
2061 /*
2062  * do_diag: Return diagnostic record info
2063  */
2064 static int do_diag (void *o, Tcl_Interp *interp, int argc, char **argv)
2065 {
2066     IrTcl_SetObj *obj = o;
2067     int offset;
2068     IrTcl_RecordList *rl;
2069
2070     if (argc <= 0)
2071         return TCL_OK;
2072     if (argc != 3)
2073     {
2074         sprintf (interp->result, "wrong # args");
2075         return TCL_ERROR;
2076     }
2077     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
2078         return TCL_ERROR;
2079     rl = find_IR_record (obj, offset);
2080     if (!rl)
2081     {
2082         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
2083         return TCL_ERROR;
2084     }
2085     if (rl->which != Z_NamePlusRecord_surrogateDiagnostic)
2086     {
2087         Tcl_AppendResult (interp, "No Diagnostic record at #", argv[2], NULL);
2088         return TCL_ERROR;
2089     }
2090     return ir_diagResult (interp, rl->u.surrogateDiagnostics.list,
2091                           rl->u.surrogateDiagnostics.num);
2092 }
2093
2094 /*
2095  * do_getMarc: Get ISO2709 Record lines/fields
2096  */
2097 static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
2098 {
2099     IrTcl_SetObj *obj = o;
2100     int offset;
2101     IrTcl_RecordList *rl;
2102
2103     if (argc <= 0)
2104         return TCL_OK;
2105     if (argc < 7)
2106     {
2107         sprintf (interp->result, "wrong # args");
2108         return TCL_ERROR;
2109     }
2110     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
2111         return TCL_ERROR;
2112     rl = find_IR_record (obj, offset);
2113     if (!rl)
2114     {
2115         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
2116         return TCL_ERROR;
2117     }
2118     if (rl->which != Z_NamePlusRecord_databaseRecord)
2119     {
2120         Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
2121         return TCL_ERROR;
2122     }
2123     return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv);
2124 }
2125
2126 /*
2127  * do_getSutrs: Get SUTRS Record
2128  */
2129 static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv)
2130 {
2131     IrTcl_SetObj *obj = o;
2132     int offset;
2133     IrTcl_RecordList *rl;
2134
2135     if (argc <= 0)
2136         return TCL_OK;
2137     if (argc != 3)
2138     {
2139         sprintf (interp->result, "wrong # args");
2140         return TCL_ERROR;
2141     }
2142     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
2143         return TCL_ERROR;
2144     rl = find_IR_record (obj, offset);
2145     if (!rl)
2146     {
2147         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
2148         return TCL_ERROR;
2149     }
2150     if (rl->which != Z_NamePlusRecord_databaseRecord)
2151     {
2152         Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
2153         return TCL_ERROR;
2154     }
2155     if (rl->u.dbrec.type != VAL_SUTRS)
2156         return TCL_OK;
2157     Tcl_AppendElement (interp, rl->u.dbrec.buf);
2158     return TCL_OK;
2159 }
2160
2161
2162 /*
2163  * do_getGrs: Get a GRS1 Record
2164  */
2165 static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
2166 {
2167     IrTcl_SetObj *obj = o;
2168     int offset;
2169     IrTcl_RecordList *rl;
2170
2171     if (argc <= 0)
2172         return TCL_OK;
2173     if (argc < 3)
2174     {
2175         sprintf (interp->result, "wrong # args");
2176         return TCL_ERROR;
2177     }
2178     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
2179         return TCL_ERROR;
2180     rl = find_IR_record (obj, offset);
2181     if (!rl)
2182     {
2183         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
2184         return TCL_ERROR;
2185     }
2186     if (rl->which != Z_NamePlusRecord_databaseRecord)
2187     {
2188         Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
2189         return TCL_ERROR;
2190     }
2191     if (rl->u.dbrec.type != VAL_GRS1)
2192         return TCL_OK;
2193     return ir_tcl_get_grs (interp, rl->u.dbrec.u.grs1, argc, argv);
2194 }
2195
2196
2197 /*
2198  * do_responseStatus: Return response status (present or search)
2199  */
2200 static int do_responseStatus (void *o, Tcl_Interp *interp,
2201                              int argc, char **argv)
2202 {
2203     IrTcl_SetObj *obj = o;
2204
2205     if (argc == 0)
2206     {
2207         obj->recordFlag = 0;
2208         obj->nonSurrogateDiagnosticNum = 0;
2209         obj->nonSurrogateDiagnosticList = NULL;
2210         return TCL_OK;
2211     }
2212     else if (argc == -1)
2213     {
2214         ir_deleteDiags (&obj->nonSurrogateDiagnosticList,
2215                         &obj->nonSurrogateDiagnosticNum);
2216         return TCL_OK;
2217     }
2218     if (!obj->recordFlag)
2219     {
2220         Tcl_AppendElement (interp, "OK");
2221         return TCL_OK;
2222     }
2223     switch (obj->which)
2224     {
2225     case Z_Records_DBOSD:
2226         Tcl_AppendElement (interp, "DBOSD");
2227         break;
2228     case Z_Records_NSD:
2229         Tcl_AppendElement (interp, "NSD");
2230         return ir_diagResult (interp, obj->nonSurrogateDiagnosticList,
2231                               obj->nonSurrogateDiagnosticNum);
2232     }
2233     return TCL_OK;
2234 }
2235
2236 /*
2237  * do_present: Perform Present Request
2238  */
2239
2240 static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
2241 {
2242     IrTcl_SetObj *obj = o;
2243     IrTcl_Obj *p;
2244     Z_APDU *apdu;
2245     Z_PresentRequest *req;
2246     int start;
2247     int number;
2248
2249     if (argc <= 0)
2250         return TCL_OK;
2251     if (argc >= 3)
2252     {
2253         if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
2254             return TCL_ERROR;
2255     }
2256     else
2257         start = 1;
2258     if (argc >= 4)
2259     {
2260         if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
2261             return TCL_ERROR;
2262     }
2263     else
2264         number = 10;
2265     p = obj->parent;
2266     if (!p->cs_link)
2267     {
2268         interp->result = "present: not connected";
2269         return TCL_ERROR;
2270     }
2271
2272     obj->start = start;
2273     obj->number = number;
2274
2275     apdu = zget_APDU (p->odr_out, Z_APDU_presentRequest);
2276     req = apdu->u.presentRequest;
2277
2278     set_referenceId (p->odr_out, &req->referenceId,
2279                      obj->set_inher.referenceId);
2280
2281     req->resultSetId = obj->setName ? obj->setName : "Default";
2282
2283     req->resultSetStartPoint = &start;
2284     req->numberOfRecordsRequested = &number;
2285     if (obj->set_inher.preferredRecordSyntax)
2286     {
2287         struct oident ident;
2288
2289         ident.proto = p->protocol_type;
2290         ident.oclass = CLASS_RECSYN;
2291         ident.value = *obj->set_inher.preferredRecordSyntax;
2292         logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
2293         req->preferredRecordSyntax = odr_oiddup (p->odr_out,
2294                                                  oid_getoidbyent (&ident));
2295     }
2296     else
2297         req->preferredRecordSyntax = 0;
2298
2299     if (obj->set_inher.elementSetNames && *obj->set_inher.elementSetNames)
2300     {
2301         Z_ElementSetNames *esn = odr_malloc (p->odr_out, sizeof(*esn));
2302         Z_RecordComposition *compo = odr_malloc (p->odr_out, sizeof(*compo));
2303
2304         esn->which = Z_ElementSetNames_generic;
2305         esn->u.generic = obj->set_inher.elementSetNames;
2306
2307         req->recordComposition = compo;
2308         compo->which = Z_RecordComp_simple;
2309         compo->u.simple = esn;
2310     }
2311     else
2312         req->recordComposition = NULL;
2313     return ir_tcl_send_APDU (interp, p, apdu, "present", argv[0]);
2314 }
2315
2316 /*
2317  * do_loadFile: Load result set from file
2318  */
2319
2320 static int do_loadFile (void *o, Tcl_Interp *interp,
2321                         int argc, char **argv)
2322 {
2323     IrTcl_SetObj *setobj = o;
2324     FILE *inf;
2325     size_t size;
2326     int  no = 1;
2327     char *buf;
2328
2329     if (argc <= 0)
2330         return TCL_OK;
2331     if (argc != 3)
2332     {
2333         interp->result = "wrong # args";
2334         return TCL_ERROR;
2335     }
2336     inf = fopen (argv[2], "r");
2337     if (!inf)
2338     {
2339         Tcl_AppendResult (interp, "Cannot open ", argv[2], NULL);
2340         return TCL_ERROR;
2341     }
2342     while ((buf = ir_tcl_fread_marc (inf, &size)))
2343     {
2344         IrTcl_RecordList *rl;
2345
2346         rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord, "F");
2347         rl->u.dbrec.type = VAL_USMARC;
2348         rl->u.dbrec.buf = buf;
2349         rl->u.dbrec.size = size;
2350         no++;
2351     }
2352     setobj->numberOfRecordsReturned = no-1;
2353     fclose (inf);
2354     return TCL_OK;
2355 }
2356
2357 static IrTcl_Method ir_set_method_tab[] = {
2358     { 0, "search",                  do_search },
2359     { 0, "searchStatus",            do_searchStatus },
2360     { 0, "presentStatus",           do_presentStatus },
2361     { 0, "nextResultSetPosition",   do_nextResultSetPosition },
2362     { 0, "setName",                 do_setName },
2363     { 0, "resultCount",             do_resultCount },
2364     { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned },
2365     { 0, "present",                 do_present },
2366     { 0, "type",                    do_type },
2367     { 0, "getMarc",                 do_getMarc },
2368     { 0, "getSutrs",                do_getSutrs },
2369     { 0, "getGrs",                  do_getGrs },
2370     { 0, "recordType",              do_recordType },
2371     { 0, "recordElements",          do_recordElements },
2372     { 0, "diag",                    do_diag },
2373     { 0, "responseStatus",          do_responseStatus },
2374     { 0, "loadFile",                do_loadFile },
2375     { 0, NULL, NULL}
2376 };
2377
2378 /*
2379  * ir_set_obj_method: IR Set Object methods
2380  */
2381 static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
2382                           int argc, char **argv)
2383 {
2384     IrTcl_Methods tabs[3];
2385     IrTcl_SetObj *p = clientData;
2386
2387     if (argc < 2)
2388     {
2389         interp->result = "wrong # args";
2390         return TCL_ERROR;
2391     }
2392     tabs[0].tab = ir_set_method_tab;
2393     tabs[0].obj = p;
2394     tabs[1].tab = ir_set_c_method_tab;
2395     tabs[1].obj = &p->set_inher;
2396     tabs[2].tab = NULL;
2397
2398     return ir_method (interp, argc, argv, tabs);
2399 }
2400
2401 /*
2402  * ir_set_obj_delete: IR Set Object disposal
2403  */
2404 static void ir_set_obj_delete (ClientData clientData)
2405 {
2406     IrTcl_Methods tabs[3];
2407     IrTcl_SetObj *p = clientData;
2408
2409     logf (LOG_DEBUG, "ir set delete");
2410
2411     tabs[0].tab = ir_set_method_tab;
2412     tabs[0].obj = p;
2413     tabs[1].tab = ir_set_c_method_tab;
2414     tabs[1].obj = &p->set_inher;
2415     tabs[2].tab = NULL;
2416
2417     ir_method (NULL, -1, NULL, tabs);
2418
2419     free (p);
2420 }
2421
2422 /*
2423  * ir_set_obj_mk: IR Set Object creation
2424  */
2425 static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
2426                           int argc, char **argv)
2427 {
2428     IrTcl_Methods tabs[3];
2429     IrTcl_SetObj *obj;
2430
2431     if (argc < 2 || argc > 3)
2432     {
2433         interp->result = "wrong # args";
2434         return TCL_ERROR;
2435     }
2436     obj = ir_tcl_malloc (sizeof(*obj));
2437     logf (LOG_DEBUG, "ir set create");
2438     if (argc == 3)
2439     {
2440         Tcl_CmdInfo parent_info;
2441         int i;
2442         IrTcl_SetCObj *dst;
2443         IrTcl_SetCObj *src;
2444
2445         if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
2446         {
2447             interp->result = "No parent";
2448             return TCL_ERROR;
2449         }
2450         obj->parent = (IrTcl_Obj *) parent_info.clientData;
2451
2452         dst = &obj->set_inher;
2453         src = &obj->parent->set_inher;
2454
2455         if ((dst->num_databaseNames = src->num_databaseNames))
2456             dst->databaseNames =
2457                 ir_tcl_malloc (sizeof (*dst->databaseNames)
2458                                * dst->num_databaseNames);
2459         else
2460             dst->databaseNames = NULL;
2461         for (i = 0; i < dst->num_databaseNames; i++)
2462             if (ir_tcl_strdup (interp, &dst->databaseNames[i],
2463                            src->databaseNames[i]) == TCL_ERROR)
2464                 return TCL_ERROR;
2465         if (ir_tcl_strdup (interp, &dst->queryType, src->queryType)
2466             == TCL_ERROR)
2467             return TCL_ERROR;
2468
2469         if (ir_tcl_strdup (interp, &dst->referenceId, src->referenceId)
2470             == TCL_ERROR)
2471             return TCL_ERROR;
2472
2473         if (ir_tcl_strdup (interp, &dst->elementSetNames, src->elementSetNames)
2474             == TCL_ERROR)
2475             return TCL_ERROR;
2476
2477         if (ir_tcl_strdup (interp, &dst->smallSetElementSetNames,
2478                            src->smallSetElementSetNames)
2479             == TCL_ERROR)
2480             return TCL_ERROR;
2481
2482         if (ir_tcl_strdup (interp, &dst->mediumSetElementSetNames,
2483                            src->mediumSetElementSetNames)
2484             == TCL_ERROR)
2485             return TCL_ERROR;
2486
2487         if (src->preferredRecordSyntax &&
2488             (dst->preferredRecordSyntax
2489              = ir_tcl_malloc (sizeof(*dst->preferredRecordSyntax))))
2490             *dst->preferredRecordSyntax = *src->preferredRecordSyntax;
2491         else
2492             dst->preferredRecordSyntax = NULL;
2493         dst->replaceIndicator = src->replaceIndicator;
2494         dst->smallSetUpperBound = src->smallSetUpperBound;
2495         dst->largeSetLowerBound = src->largeSetLowerBound;
2496         dst->mediumSetPresentNumber = src->mediumSetPresentNumber;
2497     }
2498     else
2499         obj->parent = NULL;
2500
2501     tabs[0].tab = ir_set_method_tab;
2502     tabs[0].obj = obj;
2503     tabs[1].tab = NULL;
2504
2505     if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR)
2506         return TCL_ERROR;
2507
2508     Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
2509                        (ClientData) obj, ir_set_obj_delete);
2510     return TCL_OK;
2511 }
2512
2513 /* ------------------------------------------------------- */
2514
2515 /*
2516  * do_scan: Perform scan
2517  */
2518 static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
2519 {
2520     Z_ScanRequest *req;
2521     Z_APDU *apdu;
2522     IrTcl_ScanObj *obj = o;
2523     IrTcl_Obj *p = obj->parent;
2524     oident bib1;
2525 #if CCL2RPN
2526     struct ccl_rpn_node *rpn;
2527     int pos;
2528 #endif
2529
2530     if (argc <= 0)
2531         return TCL_OK;
2532     if (argc != 3)
2533     {
2534         interp->result = "wrong # args";
2535         return TCL_ERROR;
2536     }
2537     if (!p->set_inher.num_databaseNames)
2538     {
2539         interp->result = "no databaseNames";
2540         return TCL_ERROR;
2541     }
2542     if (!p->cs_link)
2543     {
2544         interp->result = "scan: not connected";
2545         return TCL_ERROR;
2546     }
2547
2548     bib1.proto = p->protocol_type;
2549     bib1.oclass = CLASS_ATTSET;
2550     bib1.value = VAL_BIB1;
2551
2552     apdu = zget_APDU (p->odr_out, Z_APDU_scanRequest);
2553     req = apdu->u.scanRequest;
2554
2555     set_referenceId (p->odr_out, &req->referenceId, p->set_inher.referenceId);
2556     req->num_databaseNames = p->set_inher.num_databaseNames;
2557     req->databaseNames = p->set_inher.databaseNames;
2558     req->attributeSet = oid_getoidbyent (&bib1);
2559
2560 #if !CCL2RPN
2561     if (!(req->termListAndStartPoint = p_query_scan (p->odr_out, argv[2])))
2562     {
2563         Tcl_AppendResult (interp, "Syntax error in query", NULL);
2564         return TCL_ERROR;
2565     }
2566 #else
2567     rpn = ccl_find_str(p->bibset, argv[2], &r, &pos);
2568     if (r)
2569     {
2570         Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg (r), NULL);
2571         return TCL_ERROR;
2572     }
2573     ccl_pr_tree (rpn, stderr);
2574     fprintf (stderr, "\n");
2575     if (!(req->termListAndStartPoint = ccl_scan_query (rpn)))
2576         return TCL_ERROR;
2577 #endif
2578     req->stepSize = &obj->stepSize;
2579     req->numberOfTermsRequested = &obj->numberOfTermsRequested;
2580     req->preferredPositionInResponse = &obj->preferredPositionInResponse;
2581     logf (LOG_DEBUG, "stepSize=%d", *req->stepSize);
2582     logf (LOG_DEBUG, "numberOfTermsRequested=%d",
2583           *req->numberOfTermsRequested);
2584     logf (LOG_DEBUG, "preferredPositionInResponse=%d",
2585           *req->preferredPositionInResponse);
2586
2587     return ir_tcl_send_APDU (interp, p, apdu, "scan", argv[0]);
2588 }
2589
2590 /*
2591  * do_stepSize: Set/get replace Step Size
2592  */
2593 static int do_stepSize (void *obj, Tcl_Interp *interp,
2594                         int argc, char **argv)
2595 {
2596     IrTcl_ScanObj *p = obj;
2597     if (argc <= 0)
2598     {
2599         p->stepSize = 0;
2600         return TCL_OK;
2601     }
2602     return get_set_int (&p->stepSize, interp, argc, argv);
2603 }
2604
2605 /*
2606  * do_numberOfTermsRequested: Set/get Number of Terms requested
2607  */
2608 static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp,
2609                                       int argc, char **argv)
2610 {
2611     IrTcl_ScanObj *p = obj;
2612
2613     if (argc <= 0)
2614     {
2615         p->numberOfTermsRequested = 20;
2616         return TCL_OK;
2617     }
2618     return get_set_int (&p->numberOfTermsRequested, interp, argc, argv);
2619 }
2620
2621
2622 /*
2623  * do_preferredPositionInResponse: Set/get preferred Position
2624  */
2625 static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp,
2626                                            int argc, char **argv)
2627 {
2628     IrTcl_ScanObj *p = obj;
2629
2630     if (argc <= 0)
2631     {
2632         p->preferredPositionInResponse = 1;
2633         return TCL_OK;
2634     }
2635     return get_set_int (&p->preferredPositionInResponse, interp, argc, argv);
2636 }
2637
2638 /*
2639  * do_scanStatus: Get scan status
2640  */
2641 static int do_scanStatus (void *obj, Tcl_Interp *interp,
2642                           int argc, char **argv)
2643 {
2644     IrTcl_ScanObj *p = obj;
2645
2646     if (argc <= 0)
2647         return TCL_OK;
2648     return get_set_int (&p->scanStatus, interp, argc, argv);
2649 }
2650
2651 /*
2652  * do_numberOfEntriesReturned: Get number of Entries returned
2653  */
2654 static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp,
2655                                        int argc, char **argv)
2656 {
2657     IrTcl_ScanObj *p = obj;
2658
2659     if (argc <= 0)
2660         return TCL_OK;
2661     return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv);
2662 }
2663
2664 /*
2665  * do_positionOfTerm: Get position of Term
2666  */
2667 static int do_positionOfTerm (void *obj, Tcl_Interp *interp,
2668                               int argc, char **argv)
2669 {
2670     IrTcl_ScanObj *p = obj;
2671
2672     if (argc <= 0)
2673         return TCL_OK;
2674     return get_set_int (&p->positionOfTerm, interp, argc, argv);
2675 }
2676
2677 /*
2678  * do_scanLine: get Scan Line (surrogate or normal) after response
2679  */
2680 static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv)
2681 {
2682     IrTcl_ScanObj *p = obj;
2683     int i;
2684     char numstr[20];
2685
2686     if (argc == 0)
2687     {
2688         p->entries_flag = 0;
2689         p->entries = NULL;
2690         p->nonSurrogateDiagnosticNum = 0;
2691         p->nonSurrogateDiagnosticList = 0;
2692         return TCL_OK;
2693     }
2694     else if (argc == -1)
2695     {
2696         p->entries_flag = 0;
2697         /* release entries */
2698         p->entries = NULL;
2699
2700         ir_deleteDiags (&p->nonSurrogateDiagnosticList,
2701                         &p->nonSurrogateDiagnosticNum);
2702         return TCL_OK;
2703     }
2704     if (argc != 3)
2705     {
2706         interp->result = "wrong # args";
2707         return TCL_ERROR;
2708     }
2709     if (Tcl_GetInt (interp, argv[2], &i) == TCL_ERROR)
2710         return TCL_ERROR;
2711     if (!p->entries_flag || p->which != Z_ListEntries_entries || !p->entries
2712         || i >= p->num_entries || i < 0)
2713         return TCL_OK;
2714     switch (p->entries[i].which)
2715     {
2716     case Z_Entry_termInfo:
2717         Tcl_AppendElement (interp, "T");
2718         if (p->entries[i].u.term.buf)
2719             Tcl_AppendElement (interp, p->entries[i].u.term.buf);
2720         else
2721             Tcl_AppendElement (interp, "");
2722         sprintf (numstr, "%d", p->entries[i].u.term.globalOccurrences);
2723         Tcl_AppendElement (interp, numstr);
2724         break;
2725     case Z_Entry_surrogateDiagnostic:
2726         Tcl_AppendElement (interp, "SD");
2727         return ir_diagResult (interp, p->entries[i].u.diag.list,
2728                               p->entries[i].u.diag.num);
2729         break;
2730     }
2731     return TCL_OK;
2732 }
2733
2734 static IrTcl_Method ir_scan_method_tab[] = {
2735     { 0, "scan",                    do_scan },
2736     { 0, "stepSize",                do_stepSize },
2737     { 0, "numberOfTermsRequested",  do_numberOfTermsRequested },
2738     { 0, "preferredPositionInResponse", do_preferredPositionInResponse },
2739     { 0, "scanStatus",              do_scanStatus },
2740     { 0, "numberOfEntriesReturned", do_numberOfEntriesReturned },
2741     { 0, "positionOfTerm",          do_positionOfTerm },
2742     { 0, "scanLine",                do_scanLine },
2743     { 0, NULL, NULL}
2744 };
2745
2746 /*
2747  * ir_scan_obj_method: IR Scan Object methods
2748  */
2749 static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp,
2750                                int argc, char **argv)
2751 {
2752     IrTcl_Methods tabs[2];
2753
2754     if (argc < 2)
2755     {
2756         interp->result = "wrong # args";
2757         return TCL_ERROR;
2758     }
2759     tabs[0].tab = ir_scan_method_tab;
2760     tabs[0].obj = clientData;
2761     tabs[1].tab = NULL;
2762
2763     return ir_method (interp, argc, argv, tabs);
2764 }
2765
2766 /*
2767  * ir_scan_obj_delete: IR Scan Object disposal
2768  */
2769 static void ir_scan_obj_delete (ClientData clientData)
2770 {
2771     IrTcl_Methods tabs[2];
2772     IrTcl_ScanObj *obj = clientData;
2773
2774     tabs[0].tab = ir_scan_method_tab;
2775     tabs[0].obj = obj;
2776     tabs[1].tab = NULL;
2777
2778     ir_method (NULL, -1, NULL, tabs);
2779     free (obj);
2780 }
2781
2782 /*
2783  * ir_scan_obj_mk: IR Scan Object creation
2784  */
2785 static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp,
2786                            int argc, char **argv)
2787 {
2788     Tcl_CmdInfo parent_info;
2789     IrTcl_ScanObj *obj;
2790     IrTcl_Methods tabs[2];
2791
2792     if (argc != 3)
2793     {
2794         interp->result = "wrong # args";
2795         return TCL_ERROR;
2796     }
2797     if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
2798     {
2799         interp->result = "No parent";
2800         return TCL_ERROR;
2801     }
2802     obj = ir_tcl_malloc (sizeof(*obj));
2803     obj->parent = (IrTcl_Obj *) parent_info.clientData;
2804
2805     tabs[0].tab = ir_scan_method_tab;
2806     tabs[0].obj = obj;
2807     tabs[1].tab = NULL;
2808
2809     if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR)
2810         return TCL_ERROR;
2811     Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method,
2812                        (ClientData) obj, ir_scan_obj_delete);
2813     return TCL_OK;
2814 }
2815
2816 /* ------------------------------------------------------- */
2817
2818 static void ir_initResponse (void *obj, Z_InitResponse *initrs)
2819 {
2820     IrTcl_Obj *p = obj;
2821
2822     p->initResult = *initrs->result ? 1 : 0;
2823     if (!*initrs->result)
2824         logf (LOG_DEBUG, "Connection rejected by target");
2825     else
2826         logf (LOG_DEBUG, "Connection accepted by target");
2827
2828     get_referenceId (&p->set_inher.referenceId, initrs->referenceId);
2829
2830     free (p->targetImplementationId);
2831     ir_tcl_strdup (p->interp, &p->targetImplementationId,
2832                initrs->implementationId);
2833     free (p->targetImplementationName);
2834     ir_tcl_strdup (p->interp, &p->targetImplementationName,
2835                initrs->implementationName);
2836     free (p->targetImplementationVersion);
2837     ir_tcl_strdup (p->interp, &p->targetImplementationVersion,
2838                initrs->implementationVersion);
2839
2840     p->maximumRecordSize = *initrs->maximumRecordSize;
2841     p->preferredMessageSize = *initrs->preferredMessageSize;
2842
2843     memcpy (&p->options, initrs->options, sizeof(initrs->options));
2844     memcpy (&p->protocolVersion, initrs->protocolVersion,
2845             sizeof(initrs->protocolVersion));
2846     free (p->userInformationField);
2847     p->userInformationField = NULL;
2848     if (initrs->userInformationField)
2849     {
2850         int len;
2851
2852         if (initrs->userInformationField->which == ODR_EXTERNAL_octet &&
2853             (p->userInformationField =
2854              ir_tcl_malloc ((len =
2855                              initrs->userInformationField->
2856                              u.octet_aligned->len) +1)))
2857         {
2858             memcpy (p->userInformationField,
2859                     initrs->userInformationField->u.octet_aligned->buf,
2860                         len);
2861             (p->userInformationField)[len] = '\0';
2862         }
2863     }
2864 }
2865
2866 static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num)
2867 {
2868     int i;
2869     for (i = 0; i<*dst_num; i++)
2870         free (dst_list[i]->addinfo);
2871     free (*dst_list);
2872     *dst_list = NULL;
2873     *dst_num = 0;
2874 }
2875
2876 static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
2877                     Z_DiagRec **list, int num)
2878 {
2879     int i;
2880     char *addinfo;
2881
2882     *dst_num = num;
2883     *dst_list = ir_tcl_malloc (sizeof(**dst_list) * num);
2884     for (i = 0; i<num; i++)
2885     {
2886         switch (list[i]->which)
2887         {
2888         case Z_DiagRec_defaultFormat:
2889             (*dst_list)[i].condition = *list[i]->u.defaultFormat->condition;
2890             addinfo = list[i]->u.defaultFormat->addinfo;
2891             if (addinfo &&
2892                 ((*dst_list)[i].addinfo = ir_tcl_malloc (strlen(addinfo)+1)))
2893                 strcpy ((*dst_list)[i].addinfo, addinfo);
2894             break;
2895         default:
2896             (*dst_list)[i].addinfo = NULL;
2897             (*dst_list)[i].condition = 0;
2898         }
2899     }
2900 }
2901
2902 static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
2903                               const char *elements)
2904 {
2905     IrTcl_Obj *p = o;
2906
2907     int offset;
2908     IrTcl_RecordList *rl;
2909
2910     setobj->which = zrs->which;
2911     setobj->recordFlag = 1;
2912
2913     ir_deleteDiags (&setobj->nonSurrogateDiagnosticList,
2914                     &setobj->nonSurrogateDiagnosticNum);
2915     if (zrs->which == Z_Records_DBOSD)
2916     {
2917         setobj->numberOfRecordsReturned =
2918             zrs->u.databaseOrSurDiagnostics->num_records;
2919         logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned);
2920         for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
2921         {
2922             rl = new_IR_record (setobj, setobj->start + offset,
2923                                 zrs->u.databaseOrSurDiagnostics->
2924                                 records[offset]->which,
2925                                 elements);
2926             if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
2927             {
2928                 ir_handleDiags (&rl->u.surrogateDiagnostics.list,
2929                                 &rl->u.surrogateDiagnostics.num,
2930                                 &zrs->u.databaseOrSurDiagnostics->
2931                                 records[offset]->u.surrogateDiagnostic,
2932                                 1);
2933             }
2934             else
2935             {
2936                 Z_DatabaseRecord *zr;
2937                 Z_External *oe;
2938                 struct oident *ident;
2939
2940                 zr = zrs->u.databaseOrSurDiagnostics->records[offset]
2941                     ->u.databaseRecord;
2942                 oe = (Z_External*) zr;
2943                 rl->u.dbrec.size = zr->u.octet_aligned->len;
2944
2945                 if ((ident = oid_getentbyoid (oe->direct_reference)))
2946                     rl->u.dbrec.type = ident->value;
2947                 else
2948                     rl->u.dbrec.type = VAL_USMARC;
2949
2950                 if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
2951                 {
2952                     char *buf = (char*) zr->u.octet_aligned->buf;
2953                     if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
2954                         memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
2955                 }
2956                 else if (rl->u.dbrec.type == VAL_SUTRS &&
2957                          oe->which == Z_External_sutrs)
2958                 {
2959                     odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf,
2960                                 oe->u.single_ASN1_type->len, 0);
2961                     if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
2962                     {
2963                         memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
2964                                 oe->u.sutrs->len);
2965                         rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
2966                     }
2967                     rl->u.dbrec.size = oe->u.sutrs->len;
2968                 }
2969                 else if (rl->u.dbrec.type == VAL_GRS1 &&
2970                          oe->which == Z_External_grs1)
2971                 {
2972                     ir_tcl_read_grs (oe->u.grs1, &rl->u.dbrec.u.grs1);
2973                     rl->u.dbrec.buf = NULL;
2974                 }
2975                 else
2976                     rl->u.dbrec.buf = NULL;
2977             }
2978         }
2979     }
2980     else if (zrs->which == Z_Records_multipleNSD)
2981     {
2982         logf (LOG_DEBUG, "multipleNonSurrogateDiagnostic %d",
2983               zrs->u.multipleNonSurDiagnostics->num_diagRecs);
2984         setobj->numberOfRecordsReturned = 0;
2985         ir_handleDiags (&setobj->nonSurrogateDiagnosticList,
2986                         &setobj->nonSurrogateDiagnosticNum,
2987                         zrs->u.multipleNonSurDiagnostics->diagRecs,
2988                         zrs->u.multipleNonSurDiagnostics->num_diagRecs);
2989     }
2990     else
2991     {
2992         logf (LOG_DEBUG, "NonSurrogateDiagnostic");
2993         setobj->numberOfRecordsReturned = 0;
2994         ir_handleDiags (&setobj->nonSurrogateDiagnosticList,
2995                         &setobj->nonSurrogateDiagnosticNum,
2996                         &zrs->u.nonSurrogateDiagnostic,
2997                         1);
2998     }
2999 }
3000
3001 static void ir_searchResponse (void *o, Z_SearchResponse *searchrs,
3002                                IrTcl_SetObj *setobj)
3003 {
3004     Z_Records *zrs = searchrs->records;
3005
3006     logf (LOG_DEBUG, "Received search response");
3007     if (!setobj)
3008     {
3009         logf (LOG_DEBUG, "Search response, no object!");
3010         return;
3011     }
3012     setobj->searchStatus = searchrs->searchStatus ? 1 : 0;
3013     get_referenceId (&setobj->set_inher.referenceId, searchrs->referenceId);
3014     setobj->resultCount = *searchrs->resultCount;
3015     if (searchrs->presentStatus)
3016         setobj->presentStatus = *searchrs->presentStatus;
3017     if (searchrs->nextResultSetPosition)
3018         setobj->nextResultSetPosition = *searchrs->nextResultSetPosition;
3019
3020     logf (LOG_DEBUG, "Search response %d, %d hits",
3021           setobj->searchStatus, setobj->resultCount);
3022     if (zrs)
3023     {
3024         const char *es;
3025         if (setobj->resultCount <= setobj->set_inher.smallSetUpperBound)
3026             es = setobj->set_inher.smallSetElementSetNames;
3027         else
3028             es = setobj->set_inher.mediumSetElementSetNames;
3029         ir_handleRecords (o, zrs, setobj, es);
3030     }
3031     else
3032         setobj->recordFlag = 0;
3033 }
3034
3035
3036 static void ir_presentResponse (void *o, Z_PresentResponse *presrs,
3037                                 IrTcl_SetObj *setobj)
3038 {
3039     Z_Records *zrs = presrs->records;
3040
3041     logf (LOG_DEBUG, "Received present response");
3042     if (!setobj)
3043     {
3044         logf (LOG_DEBUG, "Present response, no object!");
3045         return;
3046     }
3047     setobj->presentStatus = *presrs->presentStatus;
3048     get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId);
3049     setobj->nextResultSetPosition = *presrs->nextResultSetPosition;
3050     if (zrs)
3051         ir_handleRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
3052     else
3053     {
3054         setobj->recordFlag = 0;
3055         logf (LOG_DEBUG, "No records!");
3056     }
3057 }
3058
3059 static void ir_scanResponse (void *o, Z_ScanResponse *scanrs,
3060                              IrTcl_ScanObj *scanobj)
3061 {
3062     IrTcl_Obj *p = o;
3063
3064     logf (LOG_DEBUG, "Received scanResponse");
3065
3066     get_referenceId (&p->set_inher.referenceId, scanrs->referenceId);
3067     scanobj->scanStatus = *scanrs->scanStatus;
3068     logf (LOG_DEBUG, "scanStatus=%d", scanobj->scanStatus);
3069
3070     if (scanrs->stepSize)
3071         scanobj->stepSize = *scanrs->stepSize;
3072     logf (LOG_DEBUG, "stepSize=%d", scanobj->stepSize);
3073
3074     scanobj->numberOfEntriesReturned = *scanrs->numberOfEntriesReturned;
3075     logf (LOG_DEBUG, "numberOfEntriesReturned=%d",
3076           scanobj->numberOfEntriesReturned);
3077
3078     if (scanrs->positionOfTerm)
3079         scanobj->positionOfTerm = *scanrs->positionOfTerm;
3080     else
3081         scanobj->positionOfTerm = -1;
3082     logf (LOG_DEBUG, "positionOfTerm=%d", scanobj->positionOfTerm);
3083
3084     free (scanobj->entries);
3085     scanobj->entries = NULL;
3086
3087     ir_deleteDiags (&scanobj->nonSurrogateDiagnosticList,
3088                     &scanobj->nonSurrogateDiagnosticNum);
3089     if (scanrs->entries)
3090     {
3091         int i;
3092         Z_Entry *ze;
3093
3094         scanobj->entries_flag = 1;
3095         scanobj->which = scanrs->entries->which;
3096         switch (scanobj->which)
3097         {
3098         case Z_ListEntries_entries:
3099             scanobj->num_entries = scanrs->entries->u.entries->num_entries;
3100             scanobj->entries = ir_tcl_malloc (scanobj->num_entries *
3101                                        sizeof(*scanobj->entries));
3102             for (i=0; i<scanobj->num_entries; i++)
3103             {
3104                 ze = scanrs->entries->u.entries->entries[i];
3105                 scanobj->entries[i].which = ze->which;
3106                 switch (ze->which)
3107                 {
3108                 case Z_Entry_termInfo:
3109                     if (ze->u.termInfo->term->which == Z_Term_general)
3110                     {
3111                         int l = ze->u.termInfo->term->u.general->len;
3112                         scanobj->entries[i].u.term.buf = ir_tcl_malloc (1+l);
3113                         memcpy (scanobj->entries[i].u.term.buf,
3114                                 ze->u.termInfo->term->u.general->buf,
3115                                 l);
3116                         scanobj->entries[i].u.term.buf[l] = '\0';
3117                     }
3118                     else
3119                         scanobj->entries[i].u.term.buf = NULL;
3120                     if (ze->u.termInfo->globalOccurrences)
3121                         scanobj->entries[i].u.term.globalOccurrences =
3122                             *ze->u.termInfo->globalOccurrences;
3123                     else
3124                         scanobj->entries[i].u.term.globalOccurrences = 0;
3125                     break;
3126                 case Z_Entry_surrogateDiagnostic:
3127                     ir_handleDiags (&scanobj->entries[i].u.diag.list,
3128                                     &scanobj->entries[i].u.diag.num,
3129                                     &ze->u.surrogateDiagnostic,
3130                                     1);
3131                     break;
3132                 }
3133             }
3134             break;
3135         case Z_ListEntries_nonSurrogateDiagnostics:
3136             ir_handleDiags (&scanobj->nonSurrogateDiagnosticList,
3137                             &scanobj->nonSurrogateDiagnosticNum,
3138                             scanrs->entries->u.nonSurrogateDiagnostics->
3139                             diagRecs,
3140                             scanrs->entries->u.nonSurrogateDiagnostics->
3141                             num_diagRecs);
3142             break;
3143         }
3144     }
3145     else
3146         scanobj->entries_flag = 0;
3147 }
3148
3149 /*
3150  * ir_select_read: handle incoming packages
3151  */
3152 void ir_select_read (ClientData clientData)
3153 {
3154     IrTcl_Obj *p = clientData;
3155     Z_APDU *apdu;
3156     int r;
3157     IrTcl_Request *rq;
3158     char *object_name;
3159     Tcl_CmdInfo cmd_info;
3160
3161     if (p->state == IR_TCL_R_Connecting)
3162     {
3163         r = cs_rcvconnect (p->cs_link);
3164         if (r == 1)
3165         {
3166             logf (LOG_WARN, "cs_rcvconnect returned 1");
3167             return;
3168         }
3169         p->state = IR_TCL_R_Idle;
3170         ir_select_remove_write (cs_fileno (p->cs_link), p);
3171         if (r < 0)
3172         {
3173             logf (LOG_DEBUG, "cs_rcvconnect error");
3174             if (p->failback)
3175             {
3176                 p->failInfo = IR_TCL_FAIL_CONNECT;
3177                 IrTcl_eval (p->interp, p->failback);
3178             }
3179             do_disconnect (p, NULL, 2, NULL);
3180             return;
3181         }
3182         p->state = IR_TCL_R_Idle;
3183         if (p->callback)
3184             IrTcl_eval (p->interp, p->callback);
3185         if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
3186             ir_tcl_send_q (p, p->request_queue, "x");
3187         return;
3188     }
3189     do
3190     {
3191         /* signal one more use of ir object - callbacks must not
3192            release the ir memory (p pointer) */
3193         p->state = IR_TCL_R_Reading;
3194         ++(p->ref_count);
3195
3196         /* read incoming APDU */
3197         if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 0)
3198         {
3199             logf (LOG_DEBUG, "cs_get failed, code %d", r);
3200             ir_select_remove (cs_fileno (p->cs_link), p);
3201             do_disconnect (p, NULL, 2, NULL);
3202             if (p->failback)
3203             {
3204                 p->failInfo = IR_TCL_FAIL_READ;
3205                 IrTcl_eval (p->interp, p->failback);
3206             }
3207             /* release ir object now if callback deleted it */
3208             ir_obj_delete (p);
3209             return;
3210         }
3211         if (r == 1)
3212             return ;
3213         /* got complete APDU. Now decode */
3214         odr_setbuf (p->odr_in, p->buf_in, r, 0);
3215         logf (LOG_DEBUG, "cs_get ok, got %d", r);
3216         if (!z_APDU (p->odr_in, &apdu, 0))
3217         {
3218             logf (LOG_DEBUG, "%s", odr_errmsg (odr_geterror (p->odr_in)));
3219             do_disconnect (p, NULL, 2, NULL);
3220             if (p->failback)
3221             {
3222                 p->failInfo = IR_TCL_FAIL_IN_APDU;
3223                 IrTcl_eval (p->interp, p->failback);
3224             }
3225             /* release ir object now if failback deleted it */
3226             ir_obj_delete (p);
3227             return;
3228         }
3229         /* handle APDU and invoke callback */
3230         rq = p->request_queue;
3231         if (!rq)
3232         {
3233             logf (LOG_FATAL, "Internal error. No queue entry");
3234             exit (1);
3235         }
3236         object_name = rq->object_name;
3237         logf (LOG_DEBUG, "getCommandInfo (%s)", object_name);
3238         if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info))
3239         {
3240             switch(apdu->which)
3241             {
3242             case Z_APDU_initResponse:
3243                 p->eventType = "init";
3244                 ir_initResponse (p, apdu->u.initResponse);
3245                 break;
3246             case Z_APDU_searchResponse:
3247                 p->eventType = "search";
3248                 ir_searchResponse (p, apdu->u.searchResponse,
3249                                    (IrTcl_SetObj *) cmd_info.clientData);
3250                 break;
3251             case Z_APDU_presentResponse:
3252                 p->eventType = "present";
3253                 ir_presentResponse (p, apdu->u.presentResponse,
3254                                     (IrTcl_SetObj *) cmd_info.clientData);
3255                 break;
3256             case Z_APDU_scanResponse:
3257                 p->eventType = "scan";
3258                 ir_scanResponse (p, apdu->u.scanResponse,
3259                                  (IrTcl_ScanObj *) cmd_info.clientData);
3260                 break;
3261             default:
3262                 logf (LOG_WARN, "Received unknown APDU type (%d)",
3263                       apdu->which);
3264                 do_disconnect (p, NULL, 2, NULL);
3265                 if (p->failback)
3266                 {
3267                     p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
3268                     IrTcl_eval (p->interp, p->failback);
3269                 }
3270                 return;
3271             }
3272         }
3273         p->request_queue = rq->next;
3274         p->state = IR_TCL_R_Idle;
3275
3276         if (rq->callback)
3277             IrTcl_eval (p->interp, rq->callback);
3278         free (rq->buf_out);
3279         free (rq->callback);
3280         free (rq->object_name);
3281         free (rq);
3282         odr_reset (p->odr_in);
3283         if (p->ref_count == 1)
3284         {
3285             ir_obj_delete (p);
3286             return;
3287         }
3288         --(p->ref_count);
3289     } while (p->cs_link && cs_more (p->cs_link));
3290     if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
3291         ir_tcl_send_q (p, p->request_queue, "x");
3292 }
3293
3294 /*
3295  * ir_select_write: handle outgoing packages - not yet written.
3296  */
3297 void ir_select_write (ClientData clientData)
3298 {
3299     IrTcl_Obj *p = clientData;
3300     int r;
3301     IrTcl_Request *rq;
3302
3303     logf (LOG_DEBUG, "In write handler");
3304     if (p->state == IR_TCL_R_Connecting)
3305     {
3306         r = cs_rcvconnect (p->cs_link);
3307         if (r == 1)
3308             return;
3309         p->state = IR_TCL_R_Idle;
3310         if (r < 0)
3311         {
3312             logf (LOG_DEBUG, "cs_rcvconnect error");
3313             ir_select_remove_write (cs_fileno (p->cs_link), p);
3314             if (p->failback)
3315             {
3316                 p->failInfo = IR_TCL_FAIL_CONNECT;
3317                 IrTcl_eval (p->interp, p->failback);
3318             }
3319             do_disconnect (p, NULL, 2, NULL);
3320             return;
3321         }
3322         ir_select_remove_write (cs_fileno (p->cs_link), p);
3323         if (p->callback)
3324             IrTcl_eval (p->interp, p->callback);
3325         return;
3326     }
3327     rq = p->request_queue;
3328     if (!rq || !rq->buf_out)
3329         return;
3330     assert (rq);
3331     if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0)
3332     {
3333         logf (LOG_DEBUG, "select write fail");
3334         if (p->failback)
3335         {
3336             p->failInfo = IR_TCL_FAIL_WRITE;
3337             IrTcl_eval (p->interp, p->failback);
3338         }
3339         free (rq->buf_out);
3340         rq->buf_out = NULL;
3341         do_disconnect (p, NULL, 2, NULL);
3342     }
3343     else if (r == 0)            /* remove select bit */
3344     {
3345         p->state = IR_TCL_R_Waiting;
3346         ir_select_remove_write (cs_fileno (p->cs_link), p);
3347         free (rq->buf_out);
3348         rq->buf_out = NULL;
3349     }
3350 }
3351
3352 /* ------------------------------------------------------- */
3353
3354 /*
3355  * Irtcl_init: Registration of TCL commands.
3356  */
3357 int Irtcl_Init (Tcl_Interp *interp)
3358 {
3359     Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL,
3360                        (Tcl_CmdDeleteProc *) NULL);
3361     Tcl_CreateCommand (interp, "ir-set", ir_set_obj_mk,
3362                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
3363     Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk,
3364                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
3365     return TCL_OK;
3366 }
3367