ir-tcl.c

   1 /*
   2  * IR toolkit for tcl/tk
   3  * (c) Index Data 1995
   4  * Sebastian Hammer, Adam Dickmeiss
   5  *
   6  * $Log: ir-tcl.c,v $
   7  * Revision 1.27  1995-05-11 15:34:47  adam
   8  * Scan request changed a bit. This version works with RLG.
   9  *
  10  * Revision 1.26  1995/04/18  16:11:51  adam
  11  * First version of graphical Scan. Some work on query-by-form.
  12  *
  13  * Revision 1.25  1995/04/17  09:37:17  adam
  14  * Further development of scan.
  15  *
  16  * Revision 1.24  1995/04/11  14:16:42  adam
  17  * Further work on scan. Response works. Entries aren't saved yet.
  18  *
  19  * Revision 1.23  1995/04/10  10:50:27  adam
  20  * Result-set name defaults to suffix of ir-set name.
  21  * Started working on scan. Not finished at this point.
  22  *
  23  * Revision 1.22  1995/03/31  10:43:03  adam
  24  * More robust when getting bad MARC records.
  25  *
  26  * Revision 1.21  1995/03/31  08:56:37  adam
  27  * New button "Search".
  28  *
  29  * Revision 1.20  1995/03/29  16:07:09  adam
  30  * Bug fix: Didn't use setName in present request.
  31  *
  32  * Revision 1.19  1995/03/28  12:45:23  adam
  33  * New ir method failback: called on disconnect/protocol error.
  34  * New ir set/get method: protocol: SR / Z3950.
  35  * Simple popup and disconnect when failback is invoked.
  36  *
  37  * Revision 1.18  1995/03/21  15:50:12  adam
  38  * Minor changes.
  39  *
  40  * Revision 1.17  1995/03/21  13:41:03  adam
  41  * Comstack cs_create not used too often. Non-blocking connect.
  42  *
  43  * Revision 1.16  1995/03/21  08:26:06  adam
  44  * New method, setName, to specify the result set name (other than Default).
  45  * New method, responseStatus, which returns diagnostic info, if any, after
  46  * present response / search response.
  47  *
  48  * Revision 1.15  1995/03/20  15:24:07  adam
  49  * Diagnostic records saved on searchResponse.
  50  *
  51  * Revision 1.14  1995/03/20  08:53:22  adam
  52  * Event loop in tclmain.c rewritten. New method searchStatus.
  53  *
  54  * Revision 1.13  1995/03/17  18:26:17  adam
  55  * Non-blocking i/o used now. Database names popup as cascade items.
  56  *
  57  * Revision 1.12  1995/03/17  15:45:00  adam
  58  * Improved target/database setup.
  59  *
  60  * Revision 1.11  1995/03/16  17:54:03  adam
  61  * Minor changes really.
  62  *
  63  * Revision 1.10  1995/03/15  16:14:50  adam
  64  * Blocking arg in cs_create changed.
  65  *
  66  * Revision 1.9  1995/03/15  13:59:24  adam
  67  * Minor changes.
  68  *
  69  * Revision 1.8  1995/03/15  08:25:16  adam
  70  * New method presentStatus to check for error on present. Misc. cleanup
  71  * of IRRecordList manipulations. Full MARC record presentation in
  72  * search.tcl.
  73  *
  74  * Revision 1.7  1995/03/14  17:32:29  adam
  75  * Presentation of full Marc record in popup window.
  76  *
  77  * Revision 1.6  1995/03/12  19:31:55  adam
  78  * Pattern matching implemented when retrieving MARC records. More
  79  * diagnostic functions.
  80  *
  81  * Revision 1.5  1995/03/10  18:00:15  adam
  82  * Actual presentation in line-by-line format. RPN query support.
  83  *
  84  * Revision 1.4  1995/03/09  16:15:08  adam
  85  * First presentRequest attempts. Hot-target list.
  86  *
  87  */
  88
  89 #include <stdlib.h>
  90 #include <stdio.h>
  91 #include <sys/time.h>
  92 #include <assert.h>
  93
  94 #include <tcl.h>
  95
  96 #include <yaz-ccl.h>
  97 #include <iso2709.h>
  98 #include <comstack.h>
  99 #include <tcpip.h>
 100
 101 #if MOSI
 102 #include <xmosi.h>
 103 #endif
 104
 105 #include <odr.h>
 106 #include <proto.h>
 107 #include <oid.h>
 108 #include <diagbib1.h>
 109
 110 #include "ir-tcl.h"
 111
 112 #define CS_BLOCK 0
 113
 114 typedef struct {
 115     char       *cs_type;
 116     char       *protocol_type;
 117     int         connectFlag;
 118     COMSTACK    cs_link;
 119
 120     int         preferredMessageSize;
 121     int         maximumRecordSize;
 122     Odr_bitmask options;
 123     Odr_bitmask protocolVersion;
 124     char       *idAuthentication;
 125     char       *implementationName;
 126     char       *implementationId;
 127
 128     char       *hostname;
 129
 130     char       *buf_out;
 131     int         len_out;
 132
 133     char       *buf_in;
 134     int         len_in;
 135
 136     char       *sbuf;
 137     int         slen;
 138
 139     ODR         odr_in;
 140     ODR         odr_out;
 141     ODR         odr_pr;
 142
 143     Tcl_Interp *interp;
 144     char       *callback;
 145     char       *failback;
 146
 147     int         smallSetUpperBound;
 148     int         largeSetLowerBound;
 149     int         mediumSetPresentNumber;
 150     int         replaceIndicator;
 151     char      **databaseNames;
 152     int         num_databaseNames;
 153     char       *query_method;
 154
 155     CCL_bibset  bibset;
 156     oident      bib1;
 157
 158     struct IRSetObj_ *set_child;
 159     struct IRScanObj_ *scan_child;
 160 } IRObj;
 161
 162 typedef struct IRRecordList_ {
 163     int no;
 164     int which;
 165     union {
 166         struct {
 167             Iso2709Rec rec;
 168         } marc;
 169         struct {
 170             int  condition;
 171             char *addinfo;
 172         } diag;
 173     } u;
 174     struct IRRecordList_ *next;
 175 } IRRecordList;
 176
 177 typedef struct IRSetObj_ {
 178     IRObj      *parent;
 179     int         searchStatus;
 180     int         resultCount;
 181     int         start;
 182     int         number;
 183     int         numberOfRecordsReturned;
 184     char       *setName;
 185     int         recordFlag;
 186     int         which;
 187     int         condition;
 188     char       *addinfo;
 189     IRRecordList *record_list;
 190 } IRSetObj;
 191
 192 typedef struct IRScanEntry_ {
 193     int         which;
 194     union {
 195         struct {
 196             char *buf;
 197             int  globalOccurrences;
 198         } term;
 199         struct {
 200             int  condition;
 201             char *addinfo;
 202         } diag;
 203     } u;
 204 } IRScanEntry;
 205
 206 typedef struct IRScanDiag_ {
 207     int         dummy;
 208 } IRScanDiag;
 209
 210 typedef struct IRScanObj_ {
 211     IRObj      *parent;
 212     int         stepSize;
 213     int         numberOfTermsRequested;
 214     int         preferredPositionInResponse;
 215
 216     int         scanStatus;
 217     int         numberOfEntriesReturned;
 218     int         positionOfTerm;
 219
 220     int         entries_flag;
 221     int         which;
 222
 223     int         num_entries;
 224     int         num_diagRecs;
 225
 226     IRScanEntry *entries;
 227     IRScanDiag  *nonSurrogateDiagnostics;
 228 } IRScanObj;
 229
 230 typedef struct {
 231     int type;
 232     char *name;
 233     int (*method) (void *obj, Tcl_Interp *interp, int argc, char **argv);
 234 } IRMethod;
 235
 236 static int do_disconnect (void *obj,Tcl_Interp *interp, int argc, char **argv);
 237
 238 static IRRecordList *new_IR_record (IRSetObj *setobj, int no, int which)
 239 {
 240     IRRecordList *rl;
 241
 242     for (rl = setobj->record_list; rl; rl = rl->next)
 243     {
 244         if (no == rl->no)
 245         {
 246             switch (rl->which)
 247             {
 248             case Z_NamePlusRecord_databaseRecord:
 249                 iso2709_rm (rl->u.marc.rec);
 250                 break;
 251             case Z_NamePlusRecord_surrogateDiagnostic:
 252                 free (rl->u.diag.addinfo);
 253                 rl->u.diag.addinfo = NULL;
 254                 break;
 255             }
 256             break;
 257         }
 258     }
 259     if (!rl)
 260     {
 261         rl = malloc (sizeof(*rl));
 262         assert (rl);
 263         rl->next = setobj->record_list;
 264         rl->no = no;
 265         setobj->record_list = rl;
 266     }
 267     rl->which = which;
 268     return rl;
 269 }
 270
 271 static IRRecordList *find_IR_record (IRSetObj *setobj, int no)
 272 {
 273     IRRecordList *rl;
 274
 275     for (rl = setobj->record_list; rl; rl = rl->next)
 276         if (no == rl->no)
 277             return rl;
 278     return NULL;
 279 }
 280
 281 /*
 282  * getsetint: Set/get integer value
 283  */
 284 static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
 285 {
 286     char buf[20];
 287
 288     if (argc == 3)
 289     {
 290         if (Tcl_GetInt (interp, argv[2], val)==TCL_ERROR)
 291             return TCL_ERROR;
 292     }
 293     sprintf (buf, "%d", *val);
 294     Tcl_AppendResult (interp, buf, NULL);
 295     return TCL_OK;
 296 }
 297
 298 /*
 299  * mk_nonSurrogateDiagnostics: Make Tcl result with diagnostic info
 300  */
 301 static int mk_nonSurrogateDiagnostics (Tcl_Interp *interp,
 302                                        int condition,
 303                                        const char *addinfo)
 304 {
 305     char buf[20];
 306     const char *cp;
 307
 308     Tcl_AppendElement (interp, "NSD");
 309     sprintf (buf, "%d", condition);
 310     Tcl_AppendElement (interp, buf);
 311     cp = diagbib1_str (condition);
 312     if (cp)
 313         Tcl_AppendElement (interp, (char*) cp);
 314     else
 315         Tcl_AppendElement (interp, "");
 316     if (addinfo)
 317         Tcl_AppendElement (interp, (char*) addinfo);
 318     else
 319         Tcl_AppendElement (interp, "");
 320     return TCL_OK;
 321 }
 322
 323 /*
 324  * get_parent_info: Returns information about parent object.
 325  */
 326 static int get_parent_info (Tcl_Interp *interp, const char *name,
 327                             Tcl_CmdInfo *parent_info,
 328                             const char **suffix)
 329 {
 330     char parent_name[128];
 331     const char *csep = strrchr (name, '.');
 332     int pos;
 333
 334     if (!csep)
 335     {
 336         interp->result = "missing .";
 337         return TCL_ERROR;
 338     }
 339     if (suffix)
 340         *suffix = csep+1;
 341     pos = csep-name;
 342     if (pos > 127)
 343         pos = 127;
 344     memcpy (parent_name, name, pos);
 345     parent_name[pos] = '\0';
 346     if (!Tcl_GetCommandInfo (interp, parent_name, parent_info))
 347     {
 348         interp->result = "No parent";
 349         return TCL_ERROR;
 350     }
 351     return TCL_OK;
 352 }
 353
 354 /*
 355  * ir_method: Search for method in table and invoke method handler
 356  */
 357 int ir_method (void *obj, Tcl_Interp *interp, int argc, char **argv,
 358                IRMethod *tab)
 359 {
 360     IRMethod *t;
 361     for (t = tab; t->name; t++)
 362         if (!strcmp (t->name, argv[1]))
 363             return (*t->method)(obj, interp, argc, argv);
 364     Tcl_AppendResult (interp, "Bad method. Possible values:", NULL);
 365     for (t = tab; t->name; t++)
 366         Tcl_AppendResult (interp, " ", t->name, NULL);
 367     return TCL_ERROR;
 368 }
 369
 370 /*
 371  * ir_method_r: Get status for all readable elements
 372  */
 373 int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv,
 374                  IRMethod *tab)
 375 {
 376     char *argv_n[3];
 377     int argc_n;
 378
 379     argv_n[0] = argv[0];
 380     argc_n = 2;
 381     for (; tab->name; tab++)
 382         if (tab->type)
 383         {
 384             argv_n[1] = tab->name;
 385             Tcl_AppendResult (interp, "{", NULL);
 386             (*tab->method)(obj, interp, argc_n, argv_n);
 387             Tcl_AppendResult (interp, "} ", NULL);
 388         }
 389     return TCL_OK;
 390 }
 391
 392 /*
 393  * ir_asc2bitmask: Ascii to ODR bitmask conversion
 394  */
 395 int ir_asc2bitmask (const char *asc, Odr_bitmask *ob)
 396 {
 397     const char *cp = asc + strlen(asc);
 398     int bitno = 0;
 399
 400     ODR_MASK_ZERO (ob);
 401     do
 402     {
 403         if (*--cp == '1')
 404             ODR_MASK_SET (ob, bitno);
 405         bitno++;
 406     } while (cp != asc);
 407     return bitno;
 408 }
 409
 410 /*
 411  * ir_strdup: Duplicate string
 412  */
 413 int ir_strdup (Tcl_Interp *interp, char** p, const char *s)
 414 {
 415     *p = malloc (strlen(s)+1);
 416     if (!*p)
 417     {
 418         interp->result = "strdup fail";
 419         return TCL_ERROR;
 420     }
 421     strcpy (*p, s);
 422     return TCL_OK;
 423 }
 424
 425 /*
 426  * ir_malloc: Malloc function
 427  */
 428 void *ir_malloc (Tcl_Interp *interp, size_t size)
 429 {
 430     static char buf[128];
 431     void *p = malloc (size);
 432
 433     if (!p)
 434     {
 435         sprintf (buf, "Malloc fail. %ld bytes requested", (long) size);
 436         interp->result = buf;
 437         return NULL;
 438     }
 439     return p;
 440 }
 441
 442 /* ------------------------------------------------------- */
 443
 444 /*
 445  * do_init_request: init method on IR object
 446  */
 447 static int do_init_request (void *obj, Tcl_Interp *interp,
 448                        int argc, char **argv)
 449 {
 450     Z_APDU apdu, *apdup = &apdu;
 451     IRObj *p = obj;
 452     Z_InitRequest req;
 453     int r;
 454
 455     if (!p->cs_link)
 456     {
 457         interp->result = "not connected";
 458         return TCL_ERROR;
 459     }
 460     req.referenceId = 0;
 461     req.options = &p->options;
 462     req.protocolVersion = &p->protocolVersion;
 463     req.preferredMessageSize = &p->preferredMessageSize;
 464     req.maximumRecordSize = &p->maximumRecordSize;
 465
 466     req.idAuthentication = p->idAuthentication;
 467     req.implementationId = p->implementationId;
 468     req.implementationName = p->implementationName;
 469     req.implementationVersion = "0.1";
 470     req.userInformationField = 0;
 471
 472     apdu.u.initRequest = &req;
 473     apdu.which = Z_APDU_initRequest;
 474
 475     if (!z_APDU (p->odr_out, &apdup, 0))
 476     {
 477         Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)],
 478                           NULL);
 479         odr_reset (p->odr_out);
 480         return TCL_ERROR;
 481     }
 482     p->sbuf = odr_getbuf (p->odr_out, &p->slen);
 483     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
 484     {
 485         interp->result = "cs_put failed in init";
 486         do_disconnect (p, NULL, 0, NULL);
 487         return TCL_ERROR;
 488     }
 489     else if (r == 1)
 490     {
 491         ir_select_add_write (cs_fileno(p->cs_link), p);
 492         printf("Sent part of initializeRequest (%d bytes).\n", p->slen);
 493     }
 494     else
 495         printf("Sent whole initializeRequest (%d bytes).\n", p->slen);
 496     return TCL_OK;
 497 }
 498
 499 /*
 500  * do_protocolVersion: Set protocol Version
 501  */
 502 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
 503                                int argc, char **argv)
 504 {
 505     if (argc == 3)
 506         ir_asc2bitmask (argv[2], &((IRObj *) obj)->protocolVersion);
 507     return TCL_OK;
 508 }
 509
 510 /*
 511  * do_options: Set options
 512  */
 513 static int do_options (void *obj, Tcl_Interp *interp,
 514                        int argc, char **argv)
 515 {
 516     if (argc == 3)
 517         ir_asc2bitmask (argv[2], &((IRObj *) obj)->options);
 518     return TCL_OK;
 519 }
 520
 521 /*
 522  * do_preferredMessageSize: Set/get preferred message size
 523  */
 524 static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
 525                                     int argc, char **argv)
 526 {
 527     IRObj *p = obj;
 528     return get_set_int (&p->preferredMessageSize, interp, argc, argv);
 529 }
 530
 531 /*
 532  * do_maximumRecordSize: Set/get maximum record size
 533  */
 534 static int do_maximumRecordSize (void *obj, Tcl_Interp *interp,
 535                                     int argc, char **argv)
 536 {
 537     IRObj *p = obj;
 538     return get_set_int (&p->maximumRecordSize, interp, argc, argv);
 539 }
 540
 541
 542 /*
 543  * do_implementationName: Set/get Implementation Name.
 544  */
 545 static int do_implementationName (void *obj, Tcl_Interp *interp,
 546                                     int argc, char **argv)
 547 {
 548     if (argc == 3)
 549     {
 550         free (((IRObj*)obj)->implementationName);
 551         if (ir_strdup (interp, &((IRObj*) obj)->implementationName, argv[2])
 552             == TCL_ERROR)
 553             return TCL_ERROR;
 554     }
 555     Tcl_AppendResult (interp, ((IRObj*)obj)->implementationName,
 556                       (char*) NULL);
 557     return TCL_OK;
 558 }
 559
 560 /*
 561  * do_implementationId: Set/get Implementation Id.
 562  */
 563 static int do_implementationId (void *obj, Tcl_Interp *interp,
 564                                 int argc, char **argv)
 565 {
 566     if (argc == 3)
 567     {
 568         free (((IRObj*)obj)->implementationId);
 569         if (ir_strdup (interp, &((IRObj*) obj)->implementationId, argv[2])
 570             == TCL_ERROR)
 571             return TCL_ERROR;
 572     }
 573     Tcl_AppendResult (interp, ((IRObj*)obj)->implementationId,
 574                       (char*) NULL);
 575     return TCL_OK;
 576 }
 577
 578 /*
 579  * do_idAuthentication: Set/get id Authentication
 580  */
 581 static int do_idAuthentication (void *obj, Tcl_Interp *interp,
 582                                 int argc, char **argv)
 583 {
 584     if (argc == 3)
 585     {
 586         free (((IRObj*)obj)->idAuthentication);
 587         if (ir_strdup (interp, &((IRObj*) obj)->idAuthentication, argv[2])
 588             == TCL_ERROR)
 589             return TCL_ERROR;
 590     }
 591     Tcl_AppendResult (interp, ((IRObj*)obj)->idAuthentication,
 592                       (char*) NULL);
 593     return TCL_OK;
 594 }
 595
 596 /*
 597  * do_connect: connect method on IR object
 598  */
 599 static int do_connect (void *obj, Tcl_Interp *interp,
 600                        int argc, char **argv)
 601 {
 602     void *addr;
 603     IRObj *p = obj;
 604     int r;
 605     int protocol_type = CS_Z3950;
 606
 607     if (argc == 3)
 608     {
 609         if (p->hostname)
 610         {
 611             interp->result = "already connected";
 612             return TCL_ERROR;
 613         }
 614         if (!strcmp (p->protocol_type, "Z3950"))
 615             protocol_type = CS_Z3950;
 616         else if (!strcmp (p->protocol_type, "SR"))
 617             protocol_type = CS_SR;
 618         else
 619         {
 620             interp->result = "bad protocol type";
 621             return TCL_ERROR;
 622         }
 623         if (!strcmp (p->cs_type, "tcpip"))
 624         {
 625             p->cs_link = cs_create (tcpip_type, CS_BLOCK, protocol_type);
 626             addr = tcpip_strtoaddr (argv[2]);
 627             if (!addr)
 628             {
 629                 interp->result = "tcpip_strtoaddr fail";
 630                 return TCL_ERROR;
 631             }
 632             printf ("tcp/ip connect %s\n", argv[2]);
 633         }
 634 #if MOSI
 635         else if (!strcmp (p->cs_type, "mosi"))
 636         {
 637             p->cs_link = cs_create (mosi_type, CS_BLOCK, protocol_type);
 638             addr = mosi_strtoaddr (argv[2]);
 639             if (!addr)
 640             {
 641                 interp->result = "mosi_strtoaddr fail";
 642                 return TCL_ERROR;
 643             }
 644             printf ("mosi connect %s\n", argv[2]);
 645         }
 646 #endif
 647         else
 648         {
 649             interp->result = "unknown comstack type";
 650             return TCL_ERROR;
 651         }
 652         if (ir_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
 653             return TCL_ERROR;
 654         if ((r=cs_connect (p->cs_link, addr)) < 0)
 655         {
 656             interp->result = "cs_connect fail";
 657             do_disconnect (p, NULL, 0, NULL);
 658             return TCL_ERROR;
 659         }
 660         ir_select_add (cs_fileno (p->cs_link), p);
 661         if (r == 1)
 662         {
 663             ir_select_add_write (cs_fileno (p->cs_link), p);
 664             p->connectFlag = 1;
 665         }
 666         else
 667         {
 668             p->connectFlag = 0;
 669             if (p->callback)
 670                 Tcl_Eval (p->interp, p->callback);
 671         }
 672     }
 673     if (p->hostname)
 674         Tcl_AppendElement (interp, p->hostname);
 675     return TCL_OK;
 676 }
 677
 678 /*
 679  * do_disconnect: disconnect method on IR object
 680  */
 681 static int do_disconnect (void *obj, Tcl_Interp *interp,
 682                           int argc, char **argv)
 683 {
 684     IRObj *p = obj;
 685
 686     if (p->hostname)
 687     {
 688         free (p->hostname);
 689         p->hostname = NULL;
 690         ir_select_remove_write (cs_fileno (p->cs_link), p);
 691         ir_select_remove (cs_fileno (p->cs_link), p);
 692
 693         assert (p->cs_link);
 694         cs_close (p->cs_link);
 695         p->cs_link = NULL;
 696     }
 697     assert (!p->cs_link);
 698     return TCL_OK;
 699 }
 700
 701 /*
 702  * do_comstack: Set/get comstack method on IR object
 703  */
 704 static int do_comstack (void *o, Tcl_Interp *interp,
 705                         int argc, char **argv)
 706 {
 707     IRObj *obj = o;
 708
 709     if (argc == 3)
 710     {
 711         free (obj->cs_type);
 712         if (ir_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR)
 713             return TCL_ERROR;
 714     }
 715     Tcl_AppendElement (interp, obj->cs_type);
 716     return TCL_OK;
 717 }
 718
 719 /*
 720  * do_protocol: Set/get protocol method on IR object
 721  */
 722 static int do_protocol (void *o, Tcl_Interp *interp,
 723                         int argc, char **argv)
 724 {
 725     IRObj *obj = o;
 726
 727     if (argc == 3)
 728     {
 729         free (obj->protocol_type);
 730         if (ir_strdup (interp, &obj->protocol_type, argv[2]) == TCL_ERROR)
 731             return TCL_ERROR;
 732     }
 733     Tcl_AppendElement (interp, obj->protocol_type);
 734     return TCL_OK;
 735 }
 736
 737 /*
 738  * do_callback: add callback
 739  */
 740 static int do_callback (void *obj, Tcl_Interp *interp,
 741                           int argc, char **argv)
 742 {
 743     IRObj *p = obj;
 744
 745     if (argc == 3)
 746     {
 747         free (p->callback);
 748         if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
 749             return TCL_ERROR;
 750         p->interp = interp;
 751     }
 752     return TCL_OK;
 753 }
 754
 755 /*
 756  * do_failback: add error handle callback
 757  */
 758 static int do_failback (void *obj, Tcl_Interp *interp,
 759                           int argc, char **argv)
 760 {
 761     IRObj *p = obj;
 762
 763     if (argc == 3)
 764     {
 765         free (p->failback);
 766         if (ir_strdup (interp, &p->failback, argv[2]) == TCL_ERROR)
 767             return TCL_ERROR;
 768         p->interp = interp;
 769     }
 770     return TCL_OK;
 771 }
 772
 773 /*
 774  * do_databaseNames: specify database names
 775  */
 776 static int do_databaseNames (void *obj, Tcl_Interp *interp,
 777                           int argc, char **argv)
 778 {
 779     int i;
 780     IRObj *p = obj;
 781
 782     if (argc < 3)
 783     {
 784         for (i=0; i<p->num_databaseNames; i++)
 785             Tcl_AppendElement (interp, p->databaseNames[i]);
 786         return TCL_OK;
 787     }
 788     if (p->databaseNames)
 789     {
 790         for (i=0; i<p->num_databaseNames; i++)
 791             free (p->databaseNames[i]);
 792         free (p->databaseNames);
 793     }
 794     p->num_databaseNames = argc - 2;
 795     if (!(p->databaseNames = ir_malloc (interp,
 796           sizeof(*p->databaseNames) * p->num_databaseNames)))
 797         return TCL_ERROR;
 798     for (i=0; i<p->num_databaseNames; i++)
 799     {
 800         if (ir_strdup (interp, &p->databaseNames[i], argv[2+i])
 801             == TCL_ERROR)
 802             return TCL_ERROR;
 803     }
 804     return TCL_OK;
 805 }
 806
 807 /*
 808  * do_query: Set/Get query mothod
 809  */
 810 static int do_query (void *obj, Tcl_Interp *interp,
 811                        int argc, char **argv)
 812 {
 813     IRObj *p = obj;
 814     if (argc == 3)
 815     {
 816         free (p->query_method);
 817         if (ir_strdup (interp, &p->query_method, argv[2]) == TCL_ERROR)
 818             return TCL_ERROR;
 819     }
 820     Tcl_AppendResult (interp, p->query_method, NULL);
 821     return TCL_OK;
 822 }
 823
 824 /*
 825  * do_replaceIndicator: Set/get replace Set indicator
 826  */
 827 static int do_replaceIndicator (void *obj, Tcl_Interp *interp,
 828                                 int argc, char **argv)
 829 {
 830     IRObj *p = obj;
 831     return get_set_int (&p->replaceIndicator, interp, argc, argv);
 832 }
 833
 834 /*
 835  * ir_obj_method: IR Object methods
 836  */
 837 static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
 838                           int argc, char **argv)
 839 {
 840     static IRMethod tab[] = {
 841     { 1, "comstack",                do_comstack },
 842     { 1, "protocol",                do_protocol },
 843     { 1, "connect",                 do_connect },
 844     { 0, "protocolVersion",         do_protocolVersion },
 845     { 0, "options",                 do_options },
 846     { 1, "preferredMessageSize",    do_preferredMessageSize },
 847     { 1, "maximumRecordSize",       do_maximumRecordSize },
 848     { 1, "implementationName",      do_implementationName },
 849     { 1, "implementationId",        do_implementationId },
 850     { 1, "idAuthentication",        do_idAuthentication },
 851     { 0, "init",                    do_init_request },
 852     { 0, "disconnect",              do_disconnect },
 853     { 0, "callback",                do_callback },
 854     { 0, "failback",                do_failback },
 855     { 1, "databaseNames",           do_databaseNames},
 856     { 1, "replaceIndicator",        do_replaceIndicator},
 857     { 1, "query",                   do_query },
 858     { 0, NULL, NULL}
 859     };
 860     if (argc < 2)
 861         return ir_method_r (clientData, interp, argc, argv, tab);
 862     return ir_method (clientData, interp, argc, argv, tab);
 863 }
 864
 865 /*
 866  * ir_obj_delete: IR Object disposal
 867  */
 868 static void ir_obj_delete (ClientData clientData)
 869 {
 870     free ( (void*) clientData);
 871 }
 872
 873 /*
 874  * ir_obj_mk: IR Object creation
 875  */
 876 static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
 877               int argc, char **argv)
 878 {
 879     IRObj *obj;
 880     FILE *inf;
 881
 882     if (argc != 2)
 883     {
 884         interp->result = "wrong # args";
 885         return TCL_ERROR;
 886     }
 887     if (!(obj = ir_malloc (interp, sizeof(*obj))))
 888         return TCL_ERROR;
 889     if (ir_strdup (interp, &obj->cs_type, "tcpip") == TCL_ERROR)
 890         return TCL_ERROR;
 891     if (ir_strdup (interp, &obj->protocol_type, "Z3950") == TCL_ERROR)
 892         return TCL_ERROR;
 893     obj->cs_link = NULL;
 894     obj->bib1.proto = PROTO_Z3950;
 895     obj->bib1.class = CLASS_ATTSET;
 896     obj->bib1.value = VAL_BIB1;
 897
 898     obj->maximumRecordSize = 32768;
 899     obj->preferredMessageSize = 4096;
 900     obj->connectFlag = 0;
 901
 902     obj->idAuthentication = NULL;
 903
 904     if (ir_strdup (interp, &obj->implementationName, "TCL/TK on YAZ")
 905         == TCL_ERROR)
 906         return TCL_ERROR;
 907
 908     if (ir_strdup (interp, &obj->implementationId, "TCL/TK/YAZ")
 909         == TCL_ERROR)
 910         return TCL_ERROR;
 911
 912     obj->smallSetUpperBound = 0;
 913     obj->largeSetLowerBound = 2;
 914     obj->mediumSetPresentNumber = 0;
 915     obj->replaceIndicator = 1;
 916 #if 0
 917     obj->databaseNames = NULL;
 918     obj->num_databaseNames = 0;
 919 #else
 920     obj->num_databaseNames = 1;
 921     if (!(obj->databaseNames = ir_malloc (interp,
 922                                           sizeof(*obj->databaseNames))))
 923         return TCL_ERROR;
 924     if (ir_strdup (interp, &obj->databaseNames[0], "Default") == TCL_ERROR)
 925         return TCL_ERROR;
 926 #endif
 927
 928     obj->hostname = NULL;
 929
 930     if (ir_strdup (interp, &obj->query_method, "rpn") == TCL_ERROR)
 931         return TCL_ERROR;
 932     obj->bibset = ccl_qual_mk ();
 933     if ((inf = fopen ("default.bib", "r")))
 934     {
 935         ccl_qual_file (obj->bibset, inf);
 936         fclose (inf);
 937     }
 938     ODR_MASK_ZERO (&obj->protocolVersion);
 939     ODR_MASK_SET (&obj->protocolVersion, 0);
 940     ODR_MASK_SET (&obj->protocolVersion, 1);
 941
 942     ODR_MASK_ZERO (&obj->options);
 943     ODR_MASK_SET (&obj->options, 0);
 944
 945     obj->odr_in = odr_createmem (ODR_DECODE);
 946     obj->odr_out = odr_createmem (ODR_ENCODE);
 947     obj->odr_pr = odr_createmem (ODR_PRINT);
 948
 949     obj->len_out = 10000;
 950     if (!(obj->buf_out = ir_malloc (interp, obj->len_out)))
 951         return TCL_ERROR;
 952     odr_setbuf (obj->odr_out, obj->buf_out, obj->len_out);
 953
 954     obj->len_in = 0;
 955     obj->buf_in = NULL;
 956
 957     obj->callback = NULL;
 958     obj->failback = NULL;
 959     Tcl_CreateCommand (interp, argv[1], ir_obj_method,
 960                        (ClientData) obj, ir_obj_delete);
 961     return TCL_OK;
 962 }
 963
 964 /* ------------------------------------------------------- */
 965 /*
 966  * do_search: Do search request
 967  */
 968 static int do_search (void *o, Tcl_Interp *interp,
 969                        int argc, char **argv)
 970 {
 971     Z_SearchRequest req;
 972     Z_Query query;
 973     Z_APDU apdu, *apdup = &apdu;
 974     Odr_oct ccl_query;
 975     IRSetObj *obj = o;
 976     IRObj *p = obj->parent;
 977     int r;
 978
 979     p->set_child = o;
 980     if (argc != 3)
 981     {
 982         interp->result = "wrong # args";
 983         return TCL_ERROR;
 984     }
 985     if (!p->num_databaseNames)
 986     {
 987         interp->result = "no databaseNames";
 988         return TCL_ERROR;
 989     }
 990     if (!p->cs_link)
 991     {
 992         interp->result = "not connected";
 993         return TCL_ERROR;
 994     }
 995     apdu.which = Z_APDU_searchRequest;
 996     apdu.u.searchRequest = &req;
 997
 998     req.referenceId = 0;
 999     req.smallSetUpperBound = &p->smallSetUpperBound;
1000     req.largeSetLowerBound = &p->largeSetLowerBound;
1001     req.mediumSetPresentNumber = &p->mediumSetPresentNumber;
1002     req.replaceIndicator = &p->replaceIndicator;
1003     req.resultSetName = obj->setName ? obj->setName : "Default";
1004     req.num_databaseNames = p->num_databaseNames;
1005     req.databaseNames = p->databaseNames;
1006     printf ("Search:");
1007     for (r=0; r<p->num_databaseNames; r++)
1008     {
1009         printf (" %s", p->databaseNames[r]);
1010     }
1011     req.smallSetElementSetNames = 0;
1012     req.mediumSetElementSetNames = 0;
1013     req.preferredRecordSyntax = 0;
1014     req.query = &query;
1015
1016     if (!strcmp (p->query_method, "rpn"))
1017     {
1018         int error;
1019         int pos;
1020         struct ccl_rpn_node *rpn;
1021         Z_RPNQuery *RPNquery;
1022
1023         rpn = ccl_find_str(p->bibset, argv[2], &error, &pos);
1024         if (error)
1025         {
1026             Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg(error),NULL);
1027             return TCL_ERROR;
1028         }
1029         ccl_pr_tree (rpn, stderr);
1030         fprintf (stderr, "\n");
1031         query.which = Z_Query_type_1;
1032         assert((RPNquery = ccl_rpn_query(rpn)));
1033         RPNquery->attributeSetId = oid_getoidbyent (&p->bib1);
1034         query.u.type_1 = RPNquery;
1035         printf ("- RPN\n");
1036     }
1037     else if (!strcmp (p->query_method, "ccl"))
1038     {
1039         query.which = Z_Query_type_2;
1040         query.u.type_2 = &ccl_query;
1041         ccl_query.buf = (unsigned char *) argv[2];
1042         ccl_query.len = strlen (argv[2]);
1043         printf ("- CCL\n");
1044     }
1045     else
1046     {
1047         interp->result = "unknown query method";
1048         return TCL_ERROR;
1049     }
1050     if (!z_APDU (p->odr_out, &apdup, 0))
1051     {
1052         interp->result = odr_errlist [odr_geterror (p->odr_out)];
1053         odr_reset (p->odr_out);
1054         return TCL_ERROR;
1055     }
1056     p->sbuf = odr_getbuf (p->odr_out, &p->slen);
1057     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
1058     {
1059         interp->result = "cs_put failed in search";
1060         return TCL_ERROR;
1061     }
1062     else if (r == 1)
1063     {
1064         ir_select_add_write (cs_fileno(p->cs_link), p);
1065         printf("Sent part of searchRequest (%d bytes).\n", p->slen);
1066     }
1067     else
1068     {
1069         printf ("Whole search request\n");
1070     }
1071     return TCL_OK;
1072 }
1073
1074 /*
1075  * do_resultCount: Get number of hits
1076  */
1077 static int do_resultCount (void *o, Tcl_Interp *interp,
1078                        int argc, char **argv)
1079 {
1080     IRSetObj *obj = o;
1081
1082     return get_set_int (&obj->resultCount, interp, argc, argv);
1083 }
1084
1085 /*
1086  * do_searchStatus: Get search status (after search response)
1087  */
1088 static int do_searchStatus (void *o, Tcl_Interp *interp,
1089                             int argc, char **argv)
1090 {
1091     IRSetObj *obj = o;
1092
1093     return get_set_int (&obj->searchStatus, interp, argc, argv);
1094 }
1095
1096 /*
1097  * do_setName: Set result Set name
1098  */
1099 static int do_setName (void *o, Tcl_Interp *interp,
1100                        int argc, char **argv)
1101 {
1102     IRSetObj *obj = o;
1103
1104     if (argc == 3)
1105     {
1106         free (obj->setName);
1107         if (ir_strdup (interp, &obj->setName, argv[2])
1108             == TCL_ERROR)
1109             return TCL_ERROR;
1110     }
1111     Tcl_AppendElement (interp, obj->setName);
1112     return TCL_OK;
1113 }
1114
1115 /*
1116  * do_numberOfRecordsReturned: Get number of records returned
1117  */
1118 static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp,
1119                        int argc, char **argv)
1120 {
1121     IRSetObj *obj = o;
1122
1123     return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv);
1124 }
1125
1126 static int get_marc_fields(Tcl_Interp *interp, Iso2709Rec rec,
1127                            int argc, char **argv)
1128 {
1129     Iso2709Anchor a;
1130     char *data;
1131
1132     if (!rec)
1133         return TCL_OK;
1134     a = iso2709_a_mk (rec);
1135     while (iso2709_a_search (a, argv[4], argv[5], argv[6]))
1136     {
1137         if (!(iso2709_a_info_field (a, NULL, NULL, NULL, &data)))
1138             break;
1139         Tcl_AppendElement (interp, data);
1140         iso2709_a_next (a);
1141     }
1142
1143     iso2709_a_rm (a);
1144     return TCL_OK;
1145 }
1146
1147 static int get_marc_lines(Tcl_Interp *interp, Iso2709Rec rec,
1148                          int argc, char **argv)
1149 {
1150     Iso2709Anchor a;
1151     char *tag;
1152     char *indicator;
1153     char *identifier;
1154     char *data;
1155     char *ptag = "";
1156
1157     if (!rec)
1158         return TCL_OK;
1159     a = iso2709_a_mk (rec);
1160     while (iso2709_a_search (a, argv[4], argv[5], argv[6]))
1161     {
1162         if (!(iso2709_a_info_field (a, &tag, &indicator, &identifier, &data)))
1163             break;
1164         if (strcmp (tag, ptag))
1165         {
1166             if (*ptag)
1167                 Tcl_AppendResult (interp, "}} ", NULL);
1168             if (!indicator)
1169                 Tcl_AppendResult (interp, "{", tag, " {} {", NULL);
1170             else
1171                 Tcl_AppendResult (interp, "{", tag, " {", indicator,
1172                                   "} {", NULL);
1173             ptag = tag;
1174         }
1175         if (!identifier)
1176             Tcl_AppendResult (interp, "{{}", NULL);
1177         else
1178             Tcl_AppendResult (interp, "{", identifier, NULL);
1179         Tcl_AppendElement (interp, data);
1180         Tcl_AppendResult (interp, "} ", NULL);
1181         iso2709_a_next (a);
1182     }
1183     if (*ptag)
1184         Tcl_AppendResult (interp, "}} ", NULL);
1185     iso2709_a_rm (a);
1186     return TCL_OK;
1187 }
1188
1189 /*
1190  * do_recordType: Return record type (if any) at position.
1191  */
1192 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
1193 {
1194     IRSetObj *obj = o;
1195     int offset;
1196     IRRecordList *rl;
1197
1198     if (argc < 3)
1199     {
1200         sprintf (interp->result, "wrong # args");
1201         return TCL_ERROR;
1202     }
1203     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1204         return TCL_ERROR;
1205     rl = find_IR_record (obj, offset);
1206     if (!rl)
1207         return TCL_OK;
1208     switch (rl->which)
1209     {
1210     case Z_NamePlusRecord_databaseRecord:
1211         interp->result = "databaseRecord";
1212         break;
1213     case Z_NamePlusRecord_surrogateDiagnostic:
1214         interp->result = "surrogateDiagnostic";
1215         break;
1216     }
1217     return TCL_OK;
1218 }
1219
1220 /*
1221  * do_recordDiag: Return diagnostic record info
1222  */
1223 static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv)
1224 {
1225     IRSetObj *obj = o;
1226     int offset;
1227     IRRecordList *rl;
1228     char buf[20];
1229
1230     if (argc < 3)
1231     {
1232         sprintf (interp->result, "wrong # args");
1233         return TCL_ERROR;
1234     }
1235     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1236         return TCL_ERROR;
1237     rl = find_IR_record (obj, offset);
1238     if (!rl)
1239     {
1240         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
1241         return TCL_ERROR;
1242     }
1243     if (rl->which != Z_NamePlusRecord_surrogateDiagnostic)
1244     {
1245         Tcl_AppendResult (interp, "No Diagnostic record at #", argv[2], NULL);
1246         return TCL_ERROR;
1247     }
1248     sprintf (buf, "%d", rl->u.diag.condition);
1249     Tcl_AppendResult (interp, buf, " {",
1250                       (rl->u.diag.addinfo ? rl->u.diag.addinfo : ""),
1251                       "}", NULL);
1252     return TCL_OK;
1253 }
1254
1255 /*
1256  * do_recordMarc: Get ISO2709 Record lines/fields
1257  */
1258 static int do_recordMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
1259 {
1260     IRSetObj *obj = o;
1261     int offset;
1262     IRRecordList *rl;
1263
1264     if (argc < 4)
1265     {
1266         sprintf (interp->result, "wrong # args");
1267         return TCL_ERROR;
1268     }
1269     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1270         return TCL_ERROR;
1271     rl = find_IR_record (obj, offset);
1272     if (!rl)
1273     {
1274         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
1275         return TCL_ERROR;
1276     }
1277     if (rl->which != Z_NamePlusRecord_databaseRecord)
1278     {
1279         Tcl_AppendResult (interp, "No MARC record at #", argv[2], NULL);
1280         return TCL_ERROR;
1281     }
1282     if (!strcmp (argv[3], "field"))
1283         return get_marc_fields (interp, rl->u.marc.rec, argc, argv);
1284     else if (!strcmp (argv[3], "line"))
1285         return get_marc_lines (interp, rl->u.marc.rec, argc, argv);
1286     else
1287     {
1288         Tcl_AppendResult (interp, "field/line expected", NULL);
1289         return TCL_ERROR;
1290     }
1291 }
1292
1293
1294 /*
1295  * do_responseStatus: Return response status (present or search)
1296  */
1297 static int do_responseStatus (void *o, Tcl_Interp *interp,
1298                              int argc, char **argv)
1299 {
1300     IRSetObj *obj = o;
1301
1302     if (!obj->recordFlag)
1303         return TCL_OK;
1304     switch (obj->which)
1305     {
1306     case Z_Records_DBOSD:
1307         Tcl_AppendElement (interp, "DBOSD");
1308         break;
1309     case Z_Records_NSD:
1310         return mk_nonSurrogateDiagnostics (interp, obj->condition,
1311                                            obj->addinfo);
1312     }
1313     return TCL_OK;
1314 }
1315
1316 /*
1317  * do_present: Perform Present Request
1318  */
1319
1320 static int do_present (void *o, Tcl_Interp *interp,
1321                        int argc, char **argv)
1322 {
1323     IRSetObj *obj = o;
1324     IRObj *p = obj->parent;
1325     Z_APDU apdu, *apdup = &apdu;
1326     Z_PresentRequest req;
1327     int start;
1328     int number;
1329     int r;
1330
1331     if (argc >= 3)
1332     {
1333         if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
1334             return TCL_ERROR;
1335     }
1336     else
1337         start = 1;
1338     if (argc >= 4)
1339     {
1340         if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
1341             return TCL_ERROR;
1342     }
1343     else
1344         number = 10;
1345     if (!p->cs_link)
1346     {
1347         interp->result = "not connected";
1348         return TCL_ERROR;
1349     }
1350     obj->start = start;
1351     obj->number = number;
1352
1353     apdu.which = Z_APDU_presentRequest;
1354     apdu.u.presentRequest = &req;
1355     req.referenceId = 0;
1356     /* sprintf(setstring, "%d", setnumber); */
1357
1358     req.resultSetId = obj->setName ? obj->setName : "Default";
1359
1360     req.resultSetStartPoint = &start;
1361     req.numberOfRecordsRequested = &number;
1362     req.elementSetNames = 0;
1363     req.preferredRecordSyntax = 0;
1364
1365     if (!z_APDU (p->odr_out, &apdup, 0))
1366     {
1367         interp->result = odr_errlist [odr_geterror (p->odr_out)];
1368         odr_reset (p->odr_out);
1369         return TCL_ERROR;
1370     }
1371     p->sbuf = odr_getbuf (p->odr_out, &p->slen);
1372     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
1373     {
1374         interp->result = "cs_put failed in present";
1375         return TCL_ERROR;
1376     }
1377     else if (r == 1)
1378     {
1379         ir_select_add_write (cs_fileno(p->cs_link), p);
1380         printf ("Part of present request, start=%d, num=%d (%d bytes)\n",
1381                 start, number, p->slen);
1382     }
1383     else
1384     {
1385         printf ("Whole present request, start=%d, num=%d (%d bytes)\n",
1386                 start, number, p->slen);
1387     }
1388     return TCL_OK;
1389 }
1390
1391 /*
1392  * do_loadFile: Load result set from file
1393  */
1394
1395 static int do_loadFile (void *o, Tcl_Interp *interp,
1396                         int argc, char **argv)
1397 {
1398     IRSetObj *setobj = o;
1399     FILE *inf;
1400     int  no = 1;
1401     const char *buf;
1402
1403     if (argc < 3)
1404     {
1405         interp->result = "wrong # args";
1406         return TCL_ERROR;
1407     }
1408     inf = fopen (argv[2], "r");
1409     if (!inf)
1410     {
1411         Tcl_AppendResult (interp, "Cannot open ", argv[2], NULL);
1412         return TCL_ERROR;
1413     }
1414     while ((buf = iso2709_read (inf)))
1415     {
1416         IRRecordList *rl;
1417         Iso2709Rec rec;
1418
1419         rec = iso2709_cvt (buf);
1420         if (!rec)
1421             break;
1422         rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord);
1423         rl->u.marc.rec = rec;
1424         no++;
1425     }
1426     setobj->numberOfRecordsReturned = no-1;
1427     fclose (inf);
1428     return TCL_OK;
1429 }
1430
1431 /*
1432  * ir_set_obj_method: IR Set Object methods
1433  */
1434 static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
1435                           int argc, char **argv)
1436 {
1437     static IRMethod tab[] = {
1438     { 0, "search",                  do_search },
1439     { 0, "searchStatus",            do_searchStatus },
1440     { 0, "setName",                 do_setName },
1441     { 0, "resultCount",             do_resultCount },
1442     { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned },
1443     { 0, "present",                 do_present },
1444     { 0, "recordType",              do_recordType },
1445     { 0, "recordMarc",              do_recordMarc },
1446     { 0, "recordDiag",              do_recordDiag },
1447     { 0, "responseStatus",          do_responseStatus },
1448     { 0, "loadFile",                do_loadFile },
1449     { 0, NULL, NULL}
1450     };
1451
1452     if (argc < 2)
1453     {
1454         interp->result = "wrong # args";
1455         return TCL_ERROR;
1456     }
1457     return ir_method (clientData, interp, argc, argv, tab);
1458 }
1459
1460 /*
1461  * ir_set_obj_delete: IR Set Object disposal
1462  */
1463 static void ir_set_obj_delete (ClientData clientData)
1464 {
1465     free ( (void*) clientData);
1466 }
1467
1468 /*
1469  * ir_set_obj_mk: IR Set Object creation
1470  */
1471 static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
1472                              int argc, char **argv)
1473 {
1474     Tcl_CmdInfo parent_info;
1475     IRSetObj *obj;
1476     const char *suffix;
1477
1478     if (argc != 2)
1479     {
1480         interp->result = "wrong # args";
1481         return TCL_ERROR;
1482     }
1483     if (get_parent_info (interp, argv[1], &parent_info, &suffix) == TCL_ERROR)
1484         return TCL_ERROR;
1485     if (!(obj = ir_malloc (interp, sizeof(*obj))))
1486         return TCL_ERROR;
1487     if (ir_strdup (interp, &obj->setName, suffix) == TCL_ERROR)
1488         return TCL_ERROR;
1489     obj->record_list = NULL;
1490     obj->addinfo = NULL;
1491     obj->parent = (IRObj *) parent_info.clientData;
1492     Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
1493                        (ClientData) obj, ir_set_obj_delete);
1494     return TCL_OK;
1495 }
1496
1497 /* ------------------------------------------------------- */
1498
1499 /*
1500  * do_scan: Perform scan
1501  */
1502 static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
1503 {
1504     Z_ScanRequest req;
1505     Z_APDU apdu, *apdup = &apdu;
1506     IRScanObj *obj = o;
1507     IRObj *p = obj->parent;
1508     int r, pos;
1509     struct ccl_rpn_node *rpn;
1510
1511     p->scan_child = o;
1512     if (argc != 3)
1513     {
1514         interp->result = "wrong # args";
1515         return TCL_ERROR;
1516     }
1517     if (!p->num_databaseNames)
1518     {
1519         interp->result = "no databaseNames";
1520         return TCL_ERROR;
1521     }
1522     if (!p->cs_link)
1523     {
1524         interp->result = "not connected";
1525         return TCL_ERROR;
1526     }
1527     apdu.which = Z_APDU_scanRequest;
1528     apdu.u.scanRequest = &req;
1529     req.referenceId = NULL;
1530     req.num_databaseNames = p->num_databaseNames;
1531     req.databaseNames = p->databaseNames;
1532     req.attributeSet = oid_getoidbyent (&p->bib1);
1533
1534 #if 0
1535     if (!(req.termListAndStartPoint =
1536           ir_malloc (interp, sizeof(*req.termListAndStartPoint))))
1537         return TCL_ERROR;
1538     req.termListAndStartPoint->num_attributes = 0;
1539     req.termListAndStartPoint->attributeList = NULL;
1540     if (!(req.termListAndStartPoint->term = ir_malloc (interp,
1541                                                        sizeof(Z_Term))))
1542         return TCL_ERROR;
1543     req.termListAndStartPoint->term->which = Z_Term_general;
1544     if (!(req.termListAndStartPoint->term->u.general =
1545         ir_malloc (interp, sizeof(*req.termListAndStartPoint->
1546                                   term->u.general))))
1547         return TCL_ERROR;
1548     if (ir_strdup (interp, &req.termListAndStartPoint->term->u.general->buf,
1549                    argv[2]) == TCL_ERROR)
1550         return TCL_ERROR;
1551     req.termListAndStartPoint->term->u.general->len =
1552         req.termListAndStartPoint->term->u.general->size = strlen(argv[2]);
1553 #else
1554     rpn = ccl_find_str(p->bibset, argv[2], &r, &pos);
1555     if (r)
1556     {
1557         Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg (r), NULL);
1558         return TCL_ERROR;
1559     }
1560     ccl_pr_tree (rpn, stderr);
1561     fprintf (stderr, "\n");
1562     if (!(req.termListAndStartPoint = ccl_scan_query (rpn)))
1563         return TCL_ERROR;
1564 #endif
1565     req.stepSize = &obj->stepSize;
1566     req.numberOfTermsRequested = &obj->numberOfTermsRequested;
1567     req.preferredPositionInResponse = &obj->preferredPositionInResponse;
1568     printf ("stepSize=%d\n", *req.stepSize);
1569     printf ("numberOfTermsRequested=%d\n", *req.numberOfTermsRequested);
1570     printf ("preferredPositionInResponse=%d\n",
1571             *req.preferredPositionInResponse);
1572
1573     if (!z_APDU (p->odr_out, &apdup, 0))
1574     {
1575         interp->result = odr_errlist [odr_geterror (p->odr_out)];
1576         odr_reset (p->odr_out);
1577         return TCL_ERROR;
1578     }
1579     p->sbuf = odr_getbuf (p->odr_out, &p->slen);
1580     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
1581     {
1582         interp->result = "cs_put failed in scan";
1583         return TCL_ERROR;
1584     }
1585     else if (r == 1)
1586     {
1587         ir_select_add_write (cs_fileno(p->cs_link), p);
1588         printf("Sent part of scanRequest (%d bytes).\n", p->slen);
1589     }
1590     else
1591     {
1592         printf ("Whole scan request\n");
1593     }
1594     return TCL_OK;
1595 }
1596
1597 /*
1598  * do_stepSize: Set/get replace Step Size
1599  */
1600 static int do_stepSize (void *obj, Tcl_Interp *interp,
1601                         int argc, char **argv)
1602 {
1603     IRScanObj *p = obj;
1604     return get_set_int (&p->stepSize, interp, argc, argv);
1605 }
1606
1607 /*
1608  * do_numberOfTermsRequested: Set/get Number of Terms requested
1609  */
1610 static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp,
1611                                       int argc, char **argv)
1612 {
1613     IRScanObj *p = obj;
1614     return get_set_int (&p->numberOfTermsRequested, interp, argc, argv);
1615 }
1616
1617
1618 /*
1619  * do_preferredPositionInResponse: Set/get preferred Position
1620  */
1621 static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp,
1622                                            int argc, char **argv)
1623 {
1624     IRScanObj *p = obj;
1625     return get_set_int (&p->preferredPositionInResponse, interp, argc, argv);
1626 }
1627
1628 /*
1629  * do_scanStatus: Get scan status
1630  */
1631 static int do_scanStatus (void *obj, Tcl_Interp *interp,
1632                           int argc, char **argv)
1633 {
1634     IRScanObj *p = obj;
1635     return get_set_int (&p->scanStatus, interp, argc, argv);
1636 }
1637
1638 /*
1639  * do_numberOfEntriesReturned: Get number of Entries returned
1640  */
1641 static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp,
1642                                        int argc, char **argv)
1643 {
1644     IRScanObj *p = obj;
1645     return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv);
1646 }
1647
1648 /*
1649  * do_positionOfTerm: Get position of Term
1650  */
1651 static int do_positionOfTerm (void *obj, Tcl_Interp *interp,
1652                               int argc, char **argv)
1653 {
1654     IRScanObj *p = obj;
1655     return get_set_int (&p->positionOfTerm, interp, argc, argv);
1656 }
1657
1658 /*
1659  * do_scanLine: get Scan Line (surrogate or normal) after response
1660  */
1661 static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv)
1662 {
1663     IRScanObj *p = obj;
1664     int i;
1665     char numstr[20];
1666
1667     if (argc != 3)
1668     {
1669         interp->result = "wrong # args";
1670         return TCL_ERROR;
1671     }
1672     if (Tcl_GetInt (interp, argv[2], &i) == TCL_ERROR)
1673         return TCL_ERROR;
1674     if (!p->entries_flag || p->which != Z_ListEntries_entries || !p->entries
1675         || i >= p->num_entries || i < 0)
1676         return TCL_OK;
1677     switch (p->entries[i].which)
1678     {
1679     case Z_Entry_termInfo:
1680         Tcl_AppendElement (interp, "T");
1681         if (p->entries[i].u.term.buf)
1682             Tcl_AppendElement (interp, p->entries[i].u.term.buf);
1683         else
1684             Tcl_AppendElement (interp, "");
1685         sprintf (numstr, "%d", p->entries[i].u.term.globalOccurrences);
1686         Tcl_AppendElement (interp, numstr);
1687         break;
1688     case Z_Entry_surrogateDiagnostic:
1689         return
1690             mk_nonSurrogateDiagnostics (interp, p->entries[i].u.diag.condition,
1691                                         p->entries[i].u.diag.addinfo);
1692         break;
1693     }
1694     return TCL_OK;
1695 }
1696
1697 /*
1698  * ir_scan_obj_method: IR Scan Object methods
1699  */
1700 static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp,
1701                                int argc, char **argv)
1702 {
1703     static IRMethod tab[] = {
1704     { 0, "scan",                    do_scan },
1705     { 0, "stepSize",                do_stepSize },
1706     { 0, "numberOfTermsRequested",  do_numberOfTermsRequested },
1707     { 0, "preferredPositionInResponse", do_preferredPositionInResponse },
1708     { 0, "scanStatus",              do_scanStatus },
1709     { 0, "numberOfEntriesReturned", do_numberOfEntriesReturned },
1710     { 0, "positionOfTerm",          do_positionOfTerm },
1711     { 0, "scanLine",                do_scanLine },
1712     { 0, NULL, NULL}
1713     };
1714
1715     if (argc < 2)
1716     {
1717         interp->result = "wrong # args";
1718         return TCL_ERROR;
1719     }
1720     return ir_method (clientData, interp, argc, argv, tab);
1721 }
1722
1723 /*
1724  * ir_scan_obj_delete: IR Scan Object disposal
1725  */
1726 static void ir_scan_obj_delete (ClientData clientData)
1727 {
1728     free ( (void*) clientData);
1729 }
1730
1731 /*
1732  * ir_scan_obj_mk: IR Scan Object creation
1733  */
1734 static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp,
1735                            int argc, char **argv)
1736 {
1737     Tcl_CmdInfo parent_info;
1738     IRScanObj *obj;
1739
1740     if (argc != 2)
1741     {
1742         interp->result = "wrong # args";
1743         return TCL_ERROR;
1744     }
1745     if (get_parent_info (interp, argv[1], &parent_info, NULL) == TCL_ERROR)
1746         return TCL_ERROR;
1747     if (!(obj = ir_malloc (interp, sizeof(*obj))))
1748         return TCL_ERROR;
1749
1750     obj->stepSize = 0;
1751     obj->numberOfTermsRequested = 20;
1752     obj->preferredPositionInResponse = 1;
1753
1754     obj->entries = NULL;
1755     obj->nonSurrogateDiagnostics = NULL;
1756
1757     obj->parent = (IRObj *) parent_info.clientData;
1758     Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method,
1759                        (ClientData) obj, ir_scan_obj_delete);
1760     return TCL_OK;
1761 }
1762
1763 /* ------------------------------------------------------- */
1764
1765 static void ir_initResponse (void *obj, Z_InitResponse *initrs)
1766 {
1767     if (!*initrs->result)
1768         printf("Connection rejected by target.\n");
1769     else
1770         printf("Connection accepted by target.\n");
1771     if (initrs->implementationId)
1772             printf("ID     : %s\n", initrs->implementationId);
1773     if (initrs->implementationName)
1774         printf("Name   : %s\n", initrs->implementationName);
1775     if (initrs->implementationVersion)
1776         printf("Version: %s\n", initrs->implementationVersion);
1777     if (initrs->maximumRecordSize)
1778         printf ("MaximumRecordSize=%d\n", *initrs->maximumRecordSize);
1779     if (initrs->preferredMessageSize)
1780         printf ("PreferredMessageSize=%d\n", *initrs->preferredMessageSize);
1781 #if 0
1782     if (initrs->userInformationField)
1783     {
1784         printf("UserInformationfield:\n");
1785         odr_external(&print, (Odr_external**)&initrs->
1786                          userInformationField, 0);
1787     }
1788 #endif
1789 }
1790
1791 static void ir_handleRecords (void *o, Z_Records *zrs)
1792 {
1793     IRObj *p = o;
1794     IRSetObj *setobj = p->set_child;
1795
1796     setobj->which = zrs->which;
1797     setobj->recordFlag = 1;
1798     if (zrs->which == Z_Records_NSD)
1799     {
1800         const char *addinfo;
1801
1802         setobj->numberOfRecordsReturned = 0;
1803         setobj->condition = *zrs->u.nonSurrogateDiagnostic->condition;
1804         free (setobj->addinfo);
1805         setobj->addinfo = NULL;
1806         addinfo = zrs->u.nonSurrogateDiagnostic->addinfo;
1807         if (addinfo && (setobj->addinfo = malloc (strlen(addinfo) + 1)))
1808             strcpy (setobj->addinfo, addinfo);
1809         printf ("Diagnostic response. %s (%d): %s\n",
1810                 diagbib1_str (setobj->condition),
1811                 setobj->condition,
1812                 setobj->addinfo ? setobj->addinfo : "");
1813     }
1814     else
1815     {
1816         int offset;
1817         IRRecordList *rl;
1818
1819         setobj->numberOfRecordsReturned =
1820             zrs->u.databaseOrSurDiagnostics->num_records;
1821         printf ("Got %d records\n", setobj->numberOfRecordsReturned);
1822         for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
1823         {
1824             rl = new_IR_record (setobj, setobj->start + offset,
1825                                 zrs->u.databaseOrSurDiagnostics->
1826                                 records[offset]->which);
1827             if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
1828             {
1829                 Z_DiagRec *diagrec;
1830
1831                 diagrec = zrs->u.databaseOrSurDiagnostics->
1832                     records[offset]->u.surrogateDiagnostic;
1833
1834                 rl->u.diag.condition = *diagrec->condition;
1835                 if (diagrec->addinfo && (rl->u.diag.addinfo =
1836                                          malloc (strlen (diagrec->addinfo)+1)))
1837                     strcpy (rl->u.diag.addinfo, diagrec->addinfo);
1838             }
1839             else
1840             {
1841                 Z_DatabaseRecord *zr;
1842                 Odr_external *oe;
1843
1844                 zr = zrs->u.databaseOrSurDiagnostics->records[offset]
1845                     ->u.databaseRecord;
1846                 oe = (Odr_external*) zr;
1847                 if (oe->which == ODR_EXTERNAL_octet
1848                     && zr->u.octet_aligned->len)
1849                 {
1850                     const char *buf = (char*) zr->u.octet_aligned->buf;
1851                     rl->u.marc.rec = iso2709_cvt (buf);
1852                 }
1853                 else
1854                     rl->u.marc.rec = NULL;
1855             }
1856         }
1857     }
1858 }
1859
1860 static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
1861 {
1862     IRObj *p = o;
1863     IRSetObj *setobj = p->set_child;
1864     Z_Records *zrs = searchrs->records;
1865
1866     if (setobj)
1867     {
1868         setobj->searchStatus = searchrs->searchStatus ? 1 : 0;
1869         setobj->resultCount = *searchrs->resultCount;
1870         printf ("Search response %d, %d hits\n",
1871                  setobj->searchStatus, setobj->resultCount);
1872         if (zrs)
1873             ir_handleRecords (o, zrs);
1874         else
1875             setobj->recordFlag = 0;
1876     }
1877     else
1878         printf ("Search response, no object!\n");
1879 }
1880
1881
1882 static void ir_presentResponse (void *o, Z_PresentResponse *presrs)
1883 {
1884     IRObj *p = o;
1885     IRSetObj *setobj = p->set_child;
1886     Z_Records *zrs = presrs->records;
1887
1888     printf ("Received presentResponse\n");
1889     if (zrs)
1890         ir_handleRecords (o, zrs);
1891     else
1892     {
1893         setobj->recordFlag = 0;
1894         printf ("No records!\n");
1895     }
1896 }
1897
1898 static void ir_scanResponse (void *o, Z_ScanResponse *scanrs)
1899 {
1900     IRObj *p = o;
1901     IRScanObj *scanobj = p->scan_child;
1902
1903     printf ("Received scanResponse\n");
1904
1905     scanobj->scanStatus = *scanrs->scanStatus;
1906     printf ("scanStatus=%d\n", scanobj->scanStatus);
1907
1908     if (scanrs->stepSize)
1909         scanobj->stepSize = *scanrs->stepSize;
1910     printf ("stepSize=%d\n", scanobj->stepSize);
1911
1912     scanobj->numberOfEntriesReturned = *scanrs->numberOfEntriesReturned;
1913     printf ("numberOfEntriesReturned=%d\n", scanobj->numberOfEntriesReturned);
1914
1915     if (scanrs->positionOfTerm)
1916         scanobj->positionOfTerm = *scanrs->positionOfTerm;
1917     else
1918         scanobj->positionOfTerm = -1;
1919     printf ("positionOfTerm=%d\n", scanobj->positionOfTerm);
1920
1921     free (scanobj->entries);
1922     scanobj->entries = NULL;
1923     free (scanobj->nonSurrogateDiagnostics);
1924     scanobj->nonSurrogateDiagnostics = NULL;
1925
1926     if (scanrs->entries)
1927     {
1928         int i;
1929         Z_Entry *ze;
1930
1931         scanobj->entries_flag = 1;
1932         scanobj->which = scanrs->entries->which;
1933         switch (scanobj->which)
1934         {
1935         case Z_ListEntries_entries:
1936             scanobj->num_entries = scanrs->entries->u.entries->num_entries;
1937             scanobj->entries = malloc (scanobj->num_entries *
1938                                        sizeof(*scanobj->entries));
1939             for (i=0; i<scanobj->num_entries; i++)
1940             {
1941                 ze = scanrs->entries->u.entries->entries[i];
1942                 scanobj->entries[i].which = ze->which;
1943                 switch (ze->which)
1944                 {
1945                 case Z_Entry_termInfo:
1946                     if (ze->u.termInfo->term->which == Z_Term_general)
1947                     {
1948                         int l = ze->u.termInfo->term->u.general->len;
1949                         scanobj->entries[i].u.term.buf = malloc (1+l);
1950                         memcpy (scanobj->entries[i].u.term.buf,
1951                                 ze->u.termInfo->term->u.general->buf,
1952                                 l);
1953                         scanobj->entries[i].u.term.buf[l] = '\0';
1954                     }
1955                     else
1956                         scanobj->entries[i].u.term.buf = NULL;
1957                     if (ze->u.termInfo->globalOccurrences)
1958                         scanobj->entries[i].u.term.globalOccurrences =
1959                             *ze->u.termInfo->globalOccurrences;
1960                     else
1961                         scanobj->entries[i].u.term.globalOccurrences = 0;
1962                     break;
1963                 case Z_Entry_surrogateDiagnostic:
1964                     scanobj->entries[i].u.diag.addinfo =
1965                             malloc (1+strlen(ze->u.surrogateDiagnostic->
1966                                              addinfo));
1967                     strcpy (scanobj->entries[i].u.diag.addinfo,
1968                             ze->u.surrogateDiagnostic->addinfo);
1969                     scanobj->entries[i].u.diag.condition =
1970                         *ze->u.surrogateDiagnostic->condition;
1971                     break;
1972                 }
1973             }
1974             break;
1975         case Z_ListEntries_nonSurrogateDiagnostics:
1976             scanobj->num_diagRecs = scanrs->entries->
1977                                   u.nonSurrogateDiagnostics->num_diagRecs;
1978             scanobj->nonSurrogateDiagnostics = malloc (scanobj->num_diagRecs *
1979                                   sizeof(*scanobj->nonSurrogateDiagnostics));
1980             break;
1981         }
1982     }
1983     else
1984         scanobj->entries_flag = 0;
1985 }
1986
1987 /*
1988  * ir_select_read: handle incoming packages
1989  */
1990 void ir_select_read (ClientData clientData)
1991 {
1992     IRObj *p = clientData;
1993     Z_APDU *apdu;
1994     int r;
1995
1996     if (p->connectFlag)
1997     {
1998         r = cs_rcvconnect (p->cs_link);
1999         if (r == 1)
2000             return;
2001         p->connectFlag = 0;
2002         ir_select_remove_write (cs_fileno (p->cs_link), p);
2003         if (r < 0)
2004         {
2005             printf ("cs_rcvconnect error\n");
2006             if (p->failback)
2007                 Tcl_Eval (p->interp, p->failback);
2008             do_disconnect (p, NULL, 0, NULL);
2009             return;
2010         }
2011         if (p->callback)
2012             Tcl_Eval (p->interp, p->callback);
2013         return;
2014     }
2015     do
2016     {
2017         if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in))  <= 0)
2018         {
2019             printf ("cs_get failed\n");
2020             ir_select_remove (cs_fileno (p->cs_link), p);
2021             if (p->failback)
2022                 Tcl_Eval (p->interp, p->failback);
2023             do_disconnect (p, NULL, 0, NULL);
2024             return;
2025         }
2026         if (r == 1)
2027             return ;
2028         odr_setbuf (p->odr_in, p->buf_in, r);
2029         printf ("cs_get ok, got %d\n", r);
2030         if (!z_APDU (p->odr_in, &apdu, 0))
2031         {
2032             printf ("%s\n", odr_errlist [odr_geterror (p->odr_in)]);
2033             if (p->failback)
2034                 Tcl_Eval (p->interp, p->failback);
2035             do_disconnect (p, NULL, 0, NULL);
2036             return;
2037         }
2038         switch(apdu->which)
2039         {
2040         case Z_APDU_initResponse:
2041             ir_initResponse (p, apdu->u.initResponse);
2042             break;
2043         case Z_APDU_searchResponse:
2044             ir_searchResponse (p, apdu->u.searchResponse);
2045             break;
2046         case Z_APDU_presentResponse:
2047             ir_presentResponse (p, apdu->u.presentResponse);
2048             break;
2049         case Z_APDU_scanResponse:
2050             ir_scanResponse (p, apdu->u.scanResponse);
2051             break;
2052         default:
2053             printf("Received unknown APDU type (%d).\n",
2054                    apdu->which);
2055             if (p->failback)
2056                 Tcl_Eval (p->interp, p->failback);
2057             do_disconnect (p, NULL, 0, NULL);
2058         }
2059         if (p->callback)
2060             Tcl_Eval (p->interp, p->callback);
2061     } while (cs_more (p->cs_link));
2062 }
2063
2064 /*
2065  * ir_select_write: handle outgoing packages - not yet written.
2066  */
2067 void ir_select_write (ClientData clientData)
2068 {
2069     IRObj *p = clientData;
2070     int r;
2071
2072     printf ("In write handler.....\n");
2073     if (p->connectFlag)
2074     {
2075         r = cs_rcvconnect (p->cs_link);
2076         if (r == 1)
2077             return;
2078         p->connectFlag = 0;
2079         if (r < 0)
2080         {
2081             printf ("cs_rcvconnect error\n");
2082             ir_select_remove_write (cs_fileno (p->cs_link), p);
2083             if (p->failback)
2084                 Tcl_Eval (p->interp, p->failback);
2085             do_disconnect (p, NULL, 0, NULL);
2086             return;
2087         }
2088         ir_select_remove_write (cs_fileno (p->cs_link), p);
2089         if (p->callback)
2090             Tcl_Eval (p->interp, p->callback);
2091         return;
2092     }
2093     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
2094     {
2095         printf ("select write fail\n");
2096         if (p->failback)
2097             Tcl_Eval (p->interp, p->failback);
2098         do_disconnect (p, NULL, 0, NULL);
2099     }
2100     else if (r == 0)            /* remove select bit */
2101     {
2102         ir_select_remove_write (cs_fileno (p->cs_link), p);
2103     }
2104 }
2105
2106 /* ------------------------------------------------------- */
2107
2108 /*
2109  * ir_tcl_init: Registration of TCL commands.
2110  */
2111 int ir_tcl_init (Tcl_Interp *interp)
2112 {
2113     Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL,
2114                        (Tcl_CmdDeleteProc *) NULL);
2115     Tcl_CreateCommand (interp, "ir-set", ir_set_obj_mk,
2116                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2117     Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk,
2118                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2119     return TCL_OK;
2120 }
2121
2122