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.17  1995-03-21 13:41:03  adam
   8  * Comstack cs_create not used too often. Non-blocking connect.
   9  *
  10  * Revision 1.16  1995/03/21  08:26:06  adam
  11  * New method, setName, to specify the result set name (other than Default).
  12  * New method, responseStatus, which returns diagnostic info, if any, after
  13  * present response / search response.
  14  *
  15  * Revision 1.15  1995/03/20  15:24:07  adam
  16  * Diagnostic records saved on searchResponse.
  17  *
  18  * Revision 1.14  1995/03/20  08:53:22  adam
  19  * Event loop in tclmain.c rewritten. New method searchStatus.
  20  *
  21  * Revision 1.13  1995/03/17  18:26:17  adam
  22  * Non-blocking i/o used now. Database names popup as cascade items.
  23  *
  24  * Revision 1.12  1995/03/17  15:45:00  adam
  25  * Improved target/database setup.
  26  *
  27  * Revision 1.11  1995/03/16  17:54:03  adam
  28  * Minor changes really.
  29  *
  30  * Revision 1.10  1995/03/15  16:14:50  adam
  31  * Blocking arg in cs_create changed.
  32  *
  33  * Revision 1.9  1995/03/15  13:59:24  adam
  34  * Minor changes.
  35  *
  36  * Revision 1.8  1995/03/15  08:25:16  adam
  37  * New method presentStatus to check for error on present. Misc. cleanup
  38  * of IRRecordList manipulations. Full MARC record presentation in
  39  * search.tcl.
  40  *
  41  * Revision 1.7  1995/03/14  17:32:29  adam
  42  * Presentation of full Marc record in popup window.
  43  *
  44  * Revision 1.6  1995/03/12  19:31:55  adam
  45  * Pattern matching implemented when retrieving MARC records. More
  46  * diagnostic functions.
  47  *
  48  * Revision 1.5  1995/03/10  18:00:15  adam
  49  * Actual presentation in line-by-line format. RPN query support.
  50  *
  51  * Revision 1.4  1995/03/09  16:15:08  adam
  52  * First presentRequest attempts. Hot-target list.
  53  *
  54  */
  55
  56 #include <stdlib.h>
  57 #include <stdio.h>
  58 #include <sys/time.h>
  59 #include <assert.h>
  60
  61 #include <yaz-ccl.h>
  62 #include <iso2709p.h>
  63 #include <comstack.h>
  64 #include <tcpip.h>
  65
  66 #if MOSI
  67 #include <xmosi.h>
  68 #endif
  69
  70 #include <odr.h>
  71 #include <proto.h>
  72 #include <diagbib1.h>
  73
  74 #include <tcl.h>
  75
  76 #include "ir-tcl.h"
  77
  78 #define CS_BLOCK 0
  79
  80 typedef struct {
  81     char       *cs_type;
  82     int         connectFlag;
  83     COMSTACK    cs_link;
  84
  85
  86     int         preferredMessageSize;
  87     int         maximumRecordSize;
  88     Odr_bitmask options;
  89     Odr_bitmask protocolVersion;
  90     char       *idAuthentication;
  91     char       *implementationName;
  92     char       *implementationId;
  93
  94     char       *hostname;
  95
  96     char       *buf_out;
  97     int         len_out;
  98
  99     char       *buf_in;
 100     int         len_in;
 101
 102     char       *sbuf;
 103     int         slen;
 104
 105     ODR         odr_in;
 106     ODR         odr_out;
 107     ODR         odr_pr;
 108
 109     Tcl_Interp *interp;
 110     char       *callback;
 111
 112     int         smallSetUpperBound;
 113     int         largeSetLowerBound;
 114     int         mediumSetPresentNumber;
 115     int         replaceIndicator;
 116     char      **databaseNames;
 117     int         num_databaseNames;
 118     char       *query_method;
 119
 120     CCL_bibset  bibset;
 121
 122     struct IRSetObj_ *child;
 123 } IRObj;
 124
 125 typedef struct IRRecordList_ {
 126     int no;
 127     int which;
 128     union {
 129         struct {
 130             Iso2709Rec rec;
 131         } marc;
 132         struct {
 133             int  condition;
 134             char *addinfo;
 135         } diag;
 136     } u;
 137     struct IRRecordList_ *next;
 138 } IRRecordList;
 139
 140 typedef struct IRSetObj_ {
 141     IRObj      *parent;
 142     int         searchStatus;
 143     int         resultCount;
 144     int         start;
 145     int         number;
 146     int         numberOfRecordsReturned;
 147     char       *setName;
 148     int         recordFlag;
 149     int         which;
 150     int         condition;
 151     char       *addinfo;
 152     IRRecordList *record_list;
 153 } IRSetObj;
 154
 155 typedef struct {
 156     int type;
 157     char *name;
 158     int (*method) (void *obj, Tcl_Interp *interp, int argc, char **argv);
 159 } IRMethod;
 160
 161 static int do_disconnect (void *obj,Tcl_Interp *interp, int argc, char **argv);
 162
 163 static IRRecordList *new_IR_record (IRSetObj *setobj, int no, int which)
 164 {
 165     IRRecordList *rl;
 166
 167     for (rl = setobj->record_list; rl; rl = rl->next)
 168     {
 169         if (no == rl->no)
 170         {
 171             switch (rl->which)
 172             {
 173             case Z_NamePlusRecord_databaseRecord:
 174                 iso2709_rm (rl->u.marc.rec);
 175                 break;
 176             case Z_NamePlusRecord_surrogateDiagnostic:
 177                 free (rl->u.diag.addinfo);
 178                 rl->u.diag.addinfo = NULL;
 179                 break;
 180             }
 181             break;
 182         }
 183     }
 184     if (!rl)
 185     {
 186         rl = malloc (sizeof(*rl));
 187         assert (rl);
 188         rl->next = setobj->record_list;
 189         rl->no = no;
 190         setobj->record_list = rl;
 191     }
 192     rl->which = which;
 193     return rl;
 194 }
 195
 196 static IRRecordList *find_IR_record (IRSetObj *setobj, int no)
 197 {
 198     IRRecordList *rl;
 199
 200     for (rl = setobj->record_list; rl; rl = rl->next)
 201         if (no == rl->no)
 202             return rl;
 203     return NULL;
 204 }
 205
 206 /*
 207  * get_parent_info: Returns information about parent object.
 208  */
 209 static int get_parent_info (Tcl_Interp *interp, const char *name,
 210                             Tcl_CmdInfo *parent_info)
 211 {
 212     char parent_name[128];
 213     const char *csep = strrchr (name, '.');
 214     int pos;
 215
 216     if (!csep)
 217     {
 218         interp->result = "missing .";
 219         return TCL_ERROR;
 220     }
 221     pos = csep-name;
 222     if (pos > 127)
 223         pos = 127;
 224     memcpy (parent_name, name, pos);
 225     parent_name[pos] = '\0';
 226     if (!Tcl_GetCommandInfo (interp, parent_name, parent_info))
 227     {
 228         interp->result = "No parent";
 229         return TCL_ERROR;
 230     }
 231     return TCL_OK;
 232 }
 233
 234 /*
 235  * ir_method: Search for method in table and invoke method handler
 236  */
 237 int ir_method (void *obj, Tcl_Interp *interp, int argc, char **argv,
 238                IRMethod *tab)
 239 {
 240     IRMethod *t;
 241     for (t = tab; t->name; t++)
 242         if (!strcmp (t->name, argv[1]))
 243             return (*t->method)(obj, interp, argc, argv);
 244     Tcl_AppendResult (interp, "Bad method. Possible values:", NULL);
 245     for (t = tab; t->name; t++)
 246         Tcl_AppendResult (interp, " ", t->name, NULL);
 247     return TCL_ERROR;
 248 }
 249
 250 /*
 251  * ir_method_r: Get status for all readable elements
 252  */
 253 int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv,
 254                  IRMethod *tab)
 255 {
 256     char *argv_n[3];
 257     int argc_n;
 258
 259     argv_n[0] = argv[0];
 260     argc_n = 2;
 261     for (; tab->name; tab++)
 262         if (tab->type)
 263         {
 264             argv_n[1] = tab->name;
 265             Tcl_AppendResult (interp, "{", NULL);
 266             (*tab->method)(obj, interp, argc_n, argv_n);
 267             Tcl_AppendResult (interp, "} ", NULL);
 268         }
 269     return TCL_OK;
 270 }
 271
 272 /*
 273  * ir_asc2bitmask: Ascii to ODR bitmask conversion
 274  */
 275 int ir_asc2bitmask (const char *asc, Odr_bitmask *ob)
 276 {
 277     const char *cp = asc + strlen(asc);
 278     int bitno = 0;
 279
 280     ODR_MASK_ZERO (ob);
 281     do
 282     {
 283         if (*--cp == '1')
 284             ODR_MASK_SET (ob, bitno);
 285         bitno++;
 286     } while (cp != asc);
 287     return bitno;
 288 }
 289
 290 /*
 291  * ir_strdup: Duplicate string
 292  */
 293 int ir_strdup (Tcl_Interp *interp, char** p, char *s)
 294 {
 295     *p = malloc (strlen(s)+1);
 296     if (!*p)
 297     {
 298         interp->result = "strdup fail";
 299         return TCL_ERROR;
 300     }
 301     strcpy (*p, s);
 302     return TCL_OK;
 303 }
 304
 305 /*
 306  * ir_malloc: Malloc function
 307  */
 308 void *ir_malloc (Tcl_Interp *interp, size_t size)
 309 {
 310     static char buf[128];
 311     void *p = malloc (size);
 312
 313     if (!p)
 314     {
 315         sprintf (buf, "Malloc fail. %ld bytes requested", (long) size);
 316         interp->result = buf;
 317         return NULL;
 318     }
 319     return p;
 320 }
 321
 322 /* ------------------------------------------------------- */
 323
 324 /*
 325  * do_init_request: init method on IR object
 326  */
 327 static int do_init_request (void *obj, Tcl_Interp *interp,
 328                        int argc, char **argv)
 329 {
 330     Z_APDU apdu, *apdup;
 331     IRObj *p = obj;
 332     Z_InitRequest req;
 333     int r;
 334
 335     req.referenceId = 0;
 336     req.options = &p->options;
 337     req.protocolVersion = &p->protocolVersion;
 338     req.preferredMessageSize = &p->preferredMessageSize;
 339     req.maximumRecordSize = &p->maximumRecordSize;
 340
 341     req.idAuthentication = p->idAuthentication;
 342     req.implementationId = p->implementationId;
 343     req.implementationName = p->implementationName;
 344     req.implementationVersion = "0.1";
 345     req.userInformationField = 0;
 346
 347     apdu.u.initRequest = &req;
 348     apdu.which = Z_APDU_initRequest;
 349     apdup = &apdu;
 350
 351     if (!z_APDU (p->odr_out, &apdup, 0))
 352     {
 353         Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)],
 354                           NULL);
 355         odr_reset (p->odr_out);
 356         return TCL_ERROR;
 357     }
 358     p->sbuf = odr_getbuf (p->odr_out, &p->slen);
 359     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
 360     {
 361         interp->result = "cs_put failed in init";
 362         return TCL_ERROR;
 363     }
 364     else if (r == 1)
 365     {
 366         ir_select_add_write (cs_fileno(p->cs_link), p);
 367         printf("Sent part of initializeRequest (%d bytes).\n", p->slen);
 368     }
 369     else
 370         printf("Sent whole initializeRequest (%d bytes).\n", p->slen);
 371     return TCL_OK;
 372 }
 373
 374 /*
 375  * do_protocolVersion: Set protocol Version
 376  */
 377 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
 378                                int argc, char **argv)
 379 {
 380     if (argc == 3)
 381         ir_asc2bitmask (argv[2], &((IRObj *) obj)->protocolVersion);
 382     return TCL_OK;
 383 }
 384
 385 /*
 386  * do_options: Set options
 387  */
 388 static int do_options (void *obj, Tcl_Interp *interp,
 389                        int argc, char **argv)
 390 {
 391     if (argc == 3)
 392         ir_asc2bitmask (argv[2], &((IRObj *) obj)->options);
 393     return TCL_OK;
 394 }
 395
 396 /*
 397  * do_preferredMessageSize: Set/get preferred message size
 398  */
 399 static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
 400                                     int argc, char **argv)
 401 {
 402     char buf[20];
 403     if (argc == 3)
 404     {
 405         if (Tcl_GetInt (interp, argv[2],
 406                         &((IRObj *)obj)->preferredMessageSize)==TCL_ERROR)
 407             return TCL_ERROR;
 408     }
 409     sprintf (buf, "%d", ((IRObj *)obj)->preferredMessageSize);
 410     Tcl_AppendResult (interp, buf, NULL);
 411     return TCL_OK;
 412 }
 413
 414 /*
 415  * do_maximumRecordSize: Set/get maximum record size
 416  */
 417 static int do_maximumRecordSize (void *obj, Tcl_Interp *interp,
 418                                     int argc, char **argv)
 419 {
 420     char buf[20];
 421     if (argc == 3)
 422     {
 423         if (Tcl_GetInt (interp, argv[2],
 424                         &((IRObj *)obj)->maximumRecordSize)==TCL_ERROR)
 425             return TCL_ERROR;
 426     }
 427     sprintf (buf, "%d", ((IRObj *)obj)->maximumRecordSize);
 428     Tcl_AppendResult (interp, buf, NULL);
 429     return TCL_OK;
 430 }
 431
 432
 433 /*
 434  * do_implementationName: Set/get Implementation Name.
 435  */
 436 static int do_implementationName (void *obj, Tcl_Interp *interp,
 437                                     int argc, char **argv)
 438 {
 439     if (argc == 3)
 440     {
 441         free (((IRObj*)obj)->implementationName);
 442         if (ir_strdup (interp, &((IRObj*) obj)->implementationName, argv[2])
 443             == TCL_ERROR)
 444             return TCL_ERROR;
 445     }
 446     Tcl_AppendResult (interp, ((IRObj*)obj)->implementationName,
 447                       (char*) NULL);
 448     return TCL_OK;
 449 }
 450
 451 /*
 452  * do_implementationId: Set/get Implementation Id.
 453  */
 454 static int do_implementationId (void *obj, Tcl_Interp *interp,
 455                                 int argc, char **argv)
 456 {
 457     if (argc == 3)
 458     {
 459         free (((IRObj*)obj)->implementationId);
 460         if (ir_strdup (interp, &((IRObj*) obj)->implementationId, argv[2])
 461             == TCL_ERROR)
 462             return TCL_ERROR;
 463     }
 464     Tcl_AppendResult (interp, ((IRObj*)obj)->implementationId,
 465                       (char*) NULL);
 466     return TCL_OK;
 467 }
 468
 469 /*
 470  * do_idAuthentication: Set/get id Authentication
 471  */
 472 static int do_idAuthentication (void *obj, Tcl_Interp *interp,
 473                                 int argc, char **argv)
 474 {
 475     if (argc == 3)
 476     {
 477         free (((IRObj*)obj)->idAuthentication);
 478         if (ir_strdup (interp, &((IRObj*) obj)->idAuthentication, argv[2])
 479             == TCL_ERROR)
 480             return TCL_ERROR;
 481     }
 482     Tcl_AppendResult (interp, ((IRObj*)obj)->idAuthentication,
 483                       (char*) NULL);
 484     return TCL_OK;
 485 }
 486
 487 /*
 488  * do_connect: connect method on IR object
 489  */
 490 static int do_connect (void *obj, Tcl_Interp *interp,
 491                        int argc, char **argv)
 492 {
 493     void *addr;
 494     IRObj *p = obj;
 495     int r;
 496
 497     if (argc == 3)
 498     {
 499         if (p->hostname)
 500         {
 501             interp->result = "already connected";
 502             return TCL_ERROR;
 503         }
 504         if (!strcmp (p->cs_type, "tcpip"))
 505         {
 506             p->cs_link = cs_create (tcpip_type, CS_BLOCK);
 507             addr = tcpip_strtoaddr (argv[2]);
 508             if (!addr)
 509             {
 510                 interp->result = "tcpip_strtoaddr fail";
 511                 return TCL_ERROR;
 512             }
 513             printf ("tcp/ip connect %s\n", argv[2]);
 514         }
 515 #if MOSI
 516         else if (!strcmp (p->cs_type, "mosi"))
 517         {
 518             p->cs_link = cs_create (mosi_type, CS_BLOCK);
 519             addr = mosi_strtoaddr (argv[2]);
 520             if (!addr)
 521             {
 522                 interp->result = "mosi_strtoaddr fail";
 523                 return TCL_ERROR;
 524             }
 525             printf ("mosi connect %s\n", argv[2]);
 526         }
 527 #endif
 528         else
 529         {
 530             interp->result = "unknown cs type";
 531             return TCL_ERROR;
 532         }
 533         if (ir_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
 534             return TCL_ERROR;
 535         if ((r=cs_connect (p->cs_link, addr)) < 0)
 536         {
 537             interp->result = "cs_connect fail";
 538             return TCL_ERROR;
 539         }
 540         ir_select_add (cs_fileno (p->cs_link), p);
 541         if (r == 1)
 542         {
 543             ir_select_add_write (cs_fileno (p->cs_link), p);
 544             p->connectFlag = 1;
 545         }
 546         else
 547         {
 548             p->connectFlag = 0;
 549             if (p->callback)
 550                 Tcl_Eval (p->interp, p->callback);
 551         }
 552     }
 553     Tcl_AppendElement (interp, p->hostname);
 554     return TCL_OK;
 555 }
 556
 557 /*
 558  * do_disconnect: disconnect method on IR object
 559  */
 560 static int do_disconnect (void *obj, Tcl_Interp *interp,
 561                           int argc, char **argv)
 562 {
 563     IRObj *p = obj;
 564
 565     if (p->hostname)
 566     {
 567         free (p->hostname);
 568         p->hostname = NULL;
 569         ir_select_remove (cs_fileno (p->cs_link), p);
 570
 571         assert (p->cs_link);
 572         cs_close (p->cs_link);
 573         p->cs_link = NULL;
 574     }
 575     return TCL_OK;
 576 }
 577
 578 /*
 579  * do_comstack: Set/get comstack method on IR object
 580  */
 581 static int do_comstack (void *o, Tcl_Interp *interp,
 582                         int argc, char **argv)
 583 {
 584     IRObj *obj = o;
 585
 586     if (argc == 3)
 587     {
 588         free (obj->cs_type);
 589         if (ir_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR)
 590             return TCL_ERROR;
 591     }
 592     Tcl_AppendElement (interp, obj->cs_type);
 593     return TCL_OK;
 594 }
 595
 596 /*
 597  * do_callback: add callback
 598  */
 599 static int do_callback (void *obj, Tcl_Interp *interp,
 600                           int argc, char **argv)
 601 {
 602     IRObj *p = obj;
 603
 604     if (argc == 3)
 605     {
 606         free (p->callback);
 607         if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
 608             return TCL_ERROR;
 609         p->interp = interp;
 610     }
 611     return TCL_OK;
 612 }
 613
 614 /*
 615  * do_databaseNames: specify database names
 616  */
 617 static int do_databaseNames (void *obj, Tcl_Interp *interp,
 618                           int argc, char **argv)
 619 {
 620     int i;
 621     IRObj *p = obj;
 622
 623     if (argc < 3)
 624     {
 625         for (i=0; i<p->num_databaseNames; i++)
 626             Tcl_AppendElement (interp, p->databaseNames[i]);
 627         return TCL_OK;
 628     }
 629     if (p->databaseNames)
 630     {
 631         for (i=0; i<p->num_databaseNames; i++)
 632             free (p->databaseNames[i]);
 633         free (p->databaseNames);
 634     }
 635     p->num_databaseNames = argc - 2;
 636     if (!(p->databaseNames = ir_malloc (interp,
 637           sizeof(*p->databaseNames) * p->num_databaseNames)))
 638         return TCL_ERROR;
 639     for (i=0; i<p->num_databaseNames; i++)
 640     {
 641         if (ir_strdup (interp, &p->databaseNames[i], argv[2+i])
 642             == TCL_ERROR)
 643             return TCL_ERROR;
 644     }
 645     return TCL_OK;
 646 }
 647
 648 /*
 649  * do_query: Set/Get query mothod
 650  */
 651 static int do_query (void *obj, Tcl_Interp *interp,
 652                        int argc, char **argv)
 653 {
 654     IRObj *p = obj;
 655     if (argc == 3)
 656     {
 657         free (p->query_method);
 658         if (ir_strdup (interp, &p->query_method, argv[2]) == TCL_ERROR)
 659             return TCL_ERROR;
 660     }
 661     Tcl_AppendResult (interp, p->query_method, NULL);
 662     return TCL_OK;
 663 }
 664
 665 /*
 666  * do_replaceIndicator: Set/get replace Set indicator
 667  */
 668 static int do_replaceIndicator (void *obj, Tcl_Interp *interp,
 669                                 int argc, char **argv)
 670 {
 671     IRObj *p = obj;
 672     char buf[20];
 673
 674     if (argc == 3)
 675     {
 676         if (Tcl_GetInt (interp, argv[2],
 677                         &p->replaceIndicator)==TCL_ERROR)
 678             return TCL_ERROR;
 679     }
 680     sprintf (buf, "%d", p->replaceIndicator);
 681     Tcl_AppendResult (interp, buf, NULL);
 682     return TCL_OK;
 683 }
 684
 685 /*
 686  * ir_obj_method: IR Object methods
 687  */
 688 static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
 689                           int argc, char **argv)
 690 {
 691     static IRMethod tab[] = {
 692     { 1, "comstack",                do_comstack },
 693     { 1, "connect",                 do_connect },
 694     { 0, "protocolVersion",         do_protocolVersion },
 695     { 0, "options",                 do_options },
 696     { 1, "preferredMessageSize",    do_preferredMessageSize },
 697     { 1, "maximumRecordSize",       do_maximumRecordSize },
 698     { 1, "implementationName",      do_implementationName },
 699     { 1, "implementationId",        do_implementationId },
 700     { 1, "idAuthentication",        do_idAuthentication },
 701     { 0, "init",                    do_init_request },
 702     { 0, "disconnect",              do_disconnect },
 703     { 0, "callback",                do_callback },
 704     { 1, "databaseNames",           do_databaseNames},
 705     { 1, "replaceIndicator",        do_replaceIndicator},
 706     { 1, "query",                   do_query },
 707     { 0, NULL, NULL}
 708     };
 709     if (argc < 2)
 710         return ir_method_r (clientData, interp, argc, argv, tab);
 711     return ir_method (clientData, interp, argc, argv, tab);
 712 }
 713
 714 /*
 715  * ir_obj_delete: IR Object disposal
 716  */
 717 static void ir_obj_delete (ClientData clientData)
 718 {
 719     free ( (void*) clientData);
 720 }
 721
 722 /*
 723  * ir_obj_mk: IR Object creation
 724  */
 725 static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
 726               int argc, char **argv)
 727 {
 728     IRObj *obj;
 729     FILE *inf;
 730
 731     if (argc != 2)
 732     {
 733         interp->result = "wrong # args";
 734         return TCL_ERROR;
 735     }
 736     if (!(obj = ir_malloc (interp, sizeof(*obj))))
 737         return TCL_ERROR;
 738     if (ir_strdup (interp, &obj->cs_type, "tcpip") == TCL_ERROR)
 739         return TCL_ERROR;
 740     obj->cs_link = NULL;
 741
 742     obj->maximumRecordSize = 32768;
 743     obj->preferredMessageSize = 4096;
 744     obj->connectFlag = 0;
 745
 746     obj->idAuthentication = NULL;
 747
 748     if (ir_strdup (interp, &obj->implementationName, "TCL/TK on YAZ")
 749         == TCL_ERROR)
 750         return TCL_ERROR;
 751
 752     if (ir_strdup (interp, &obj->implementationId, "TCL/TK/YAZ")
 753         == TCL_ERROR)
 754         return TCL_ERROR;
 755
 756     obj->smallSetUpperBound = 0;
 757     obj->largeSetLowerBound = 2;
 758     obj->mediumSetPresentNumber = 0;
 759     obj->replaceIndicator = 1;
 760     obj->databaseNames = NULL;
 761     obj->num_databaseNames = 0;
 762
 763     obj->hostname = NULL;
 764
 765     if (ir_strdup (interp, &obj->query_method, "rpn") == TCL_ERROR)
 766         return TCL_ERROR;
 767     obj->bibset = ccl_qual_mk ();
 768     if ((inf = fopen ("default.bib", "r")))
 769     {
 770         ccl_qual_file (obj->bibset, inf);
 771         fclose (inf);
 772     }
 773     ODR_MASK_ZERO (&obj->protocolVersion);
 774     ODR_MASK_SET (&obj->protocolVersion, 0);
 775     ODR_MASK_SET (&obj->protocolVersion, 1);
 776
 777     ODR_MASK_ZERO (&obj->options);
 778     ODR_MASK_SET (&obj->options, 0);
 779
 780     obj->odr_in = odr_createmem (ODR_DECODE);
 781     obj->odr_out = odr_createmem (ODR_ENCODE);
 782     obj->odr_pr = odr_createmem (ODR_PRINT);
 783
 784     obj->len_out = 10000;
 785     if (!(obj->buf_out = ir_malloc (interp, obj->len_out)))
 786         return TCL_ERROR;
 787     odr_setbuf (obj->odr_out, obj->buf_out, obj->len_out);
 788
 789     obj->len_in = 0;
 790     obj->buf_in = NULL;
 791
 792     obj->callback = NULL;
 793     Tcl_CreateCommand (interp, argv[1], ir_obj_method,
 794                        (ClientData) obj, ir_obj_delete);
 795     return TCL_OK;
 796 }
 797
 798 /* ------------------------------------------------------- */
 799 /*
 800  * do_search: Do search request
 801  */
 802 static int do_search (void *o, Tcl_Interp *interp,
 803                        int argc, char **argv)
 804 {
 805     Z_SearchRequest req;
 806     Z_Query query;
 807     Z_APDU apdu, *apdup;
 808     static Odr_oid bib1[] = {1, 2, 840, 10003, 3, 1, -1};
 809     Odr_oct ccl_query;
 810     IRSetObj *obj = o;
 811     IRObj *p = obj->parent;
 812     int r;
 813
 814     p->child = o;
 815     if (argc != 3)
 816     {
 817         interp->result = "wrong # args";
 818         return TCL_ERROR;
 819     }
 820     if (!p->num_databaseNames)
 821     {
 822         interp->result = "no databaseNames";
 823         return TCL_ERROR;
 824     }
 825     apdu.which = Z_APDU_searchRequest;
 826     apdu.u.searchRequest = &req;
 827     apdup = &apdu;
 828
 829     req.referenceId = 0;
 830     req.smallSetUpperBound = &p->smallSetUpperBound;
 831     req.largeSetLowerBound = &p->largeSetLowerBound;
 832     req.mediumSetPresentNumber = &p->mediumSetPresentNumber;
 833     req.replaceIndicator = &p->replaceIndicator;
 834     req.resultSetName = obj->setName ? obj->setName : "Default";
 835     req.num_databaseNames = p->num_databaseNames;
 836     req.databaseNames = p->databaseNames;
 837     printf ("Search:");
 838     for (r=0; r<p->num_databaseNames; r++)
 839     {
 840         printf (" %s", p->databaseNames[r]);
 841     }
 842     req.smallSetElementSetNames = 0;
 843     req.mediumSetElementSetNames = 0;
 844     req.preferredRecordSyntax = 0;
 845     req.query = &query;
 846
 847     if (!strcmp (p->query_method, "rpn"))
 848     {
 849         int error;
 850         int pos;
 851         struct ccl_rpn_node *rpn;
 852         Z_RPNQuery *RPNquery;
 853
 854         rpn = ccl_find_str(p->bibset, argv[2], &error, &pos);
 855         if (error)
 856         {
 857             Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg(error),NULL);
 858             return TCL_ERROR;
 859         }
 860         query.which = Z_Query_type_1;
 861         assert((RPNquery = ccl_rpn_query(rpn)));
 862         RPNquery->attributeSetId = bib1;
 863         query.u.type_1 = RPNquery;
 864         printf ("- RPN\n");
 865     }
 866     else if (!strcmp (p->query_method, "ccl"))
 867     {
 868         query.which = Z_Query_type_2;
 869         query.u.type_2 = &ccl_query;
 870         ccl_query.buf = argv[2];
 871         ccl_query.len = strlen (argv[2]);
 872         printf ("- CCL\n");
 873     }
 874     else
 875     {
 876         interp->result = "unknown query method";
 877         return TCL_ERROR;
 878     }
 879     if (!z_APDU (p->odr_out, &apdup, 0))
 880     {
 881         interp->result = odr_errlist [odr_geterror (p->odr_out)];
 882         odr_reset (p->odr_out);
 883         return TCL_ERROR;
 884     }
 885     p->sbuf = odr_getbuf (p->odr_out, &p->slen);
 886     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
 887     {
 888         interp->result = "cs_put failed in init";
 889         return TCL_ERROR;
 890     }
 891     else if (r == 1)
 892     {
 893         ir_select_add_write (cs_fileno(p->cs_link), p);
 894         printf("Sent part of searchRequest (%d bytes).\n", p->slen);
 895     }
 896     else
 897     {
 898         printf ("Whole search request\n");
 899     }
 900     return TCL_OK;
 901 }
 902
 903 /*
 904  * do_resultCount: Get number of hits
 905  */
 906 static int do_resultCount (void *o, Tcl_Interp *interp,
 907                        int argc, char **argv)
 908 {
 909     IRSetObj *obj = o;
 910
 911     sprintf (interp->result, "%d", obj->resultCount);
 912     return TCL_OK;
 913 }
 914
 915 /*
 916  * do_searchStatus: Get search status (after search response)
 917  */
 918 static int do_searchStatus (void *o, Tcl_Interp *interp,
 919                             int argc, char **argv)
 920 {
 921     IRSetObj *obj = o;
 922
 923     sprintf (interp->result, "%d", obj->searchStatus);
 924     return TCL_OK;
 925 }
 926
 927 /*
 928  * do_setName: Set result Set name
 929  */
 930 static int do_setName (void *o, Tcl_Interp *interp,
 931                        int argc, char **argv)
 932 {
 933     IRSetObj *obj = o;
 934
 935     if (argc == 3)
 936     {
 937         free (obj->setName);
 938         if (ir_strdup (interp, &obj->setName, argv[2])
 939             == TCL_ERROR)
 940             return TCL_ERROR;
 941     }
 942     Tcl_AppendElement (interp, obj->setName);
 943     return TCL_OK;
 944 }
 945
 946 /*
 947  * do_numberOfRecordsReturned: Get number of records returned
 948  */
 949 static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp,
 950                        int argc, char **argv)
 951 {
 952     IRSetObj *obj = o;
 953
 954     sprintf (interp->result, "%d", obj->numberOfRecordsReturned);
 955     return TCL_OK;
 956 }
 957
 958 static int marc_cmp (const char *field, const char *pattern)
 959 {
 960     if (*pattern == '*')
 961         return 0;
 962     for (; *field && *pattern; field++, pattern++)
 963     {
 964         if (*pattern == '?')
 965             continue;
 966         if (*pattern != *field)
 967             break;
 968     }
 969     return *field - *pattern;
 970 }
 971
 972 static int get_marc_fields(Tcl_Interp *interp, Iso2709Rec rec,
 973                            int argc, char **argv)
 974 {
 975     struct iso2709_dir *dir;
 976     struct iso2709_field *field;
 977
 978     for (dir = rec->directory; dir; dir = dir->next)
 979     {
 980         if (argc > 4 && marc_cmp (dir->tag, argv[4]))
 981             continue;
 982         if (argc > 5 && marc_cmp (dir->indicator, argv[5]))
 983             continue;
 984         for (field = dir->fields; field; field = field->next)
 985         {
 986             if (argc > 6 && marc_cmp (field->identifier, argv[6]))
 987                 continue;
 988             Tcl_AppendElement (interp, field->data);
 989         }
 990     }
 991     return TCL_OK;
 992 }
 993
 994 static int get_marc_lines (Tcl_Interp *interp, Iso2709Rec rec,
 995                            int argc, char **argv)
 996 {
 997     struct iso2709_dir *dir;
 998     struct iso2709_field *field;
 999
1000     for (dir = rec->directory; dir; dir = dir->next)
1001     {
1002         if (argc > 4 && marc_cmp (dir->tag, argv[4]))
1003             continue;
1004         if (!dir->indicator)
1005             Tcl_AppendResult (interp, "{", dir->tag, " {} {", NULL);
1006         else
1007         {
1008             if (argc > 5 && marc_cmp (dir->indicator, argv[5]))
1009                 continue;
1010             Tcl_AppendResult (interp, "{", dir->tag, " {", dir->indicator,
1011                               "} {", NULL);
1012         }
1013         for (field = dir->fields; field; field = field->next)
1014         {
1015             if (!field->identifier)
1016                 Tcl_AppendResult (interp, "{{}", NULL);
1017             else
1018             {
1019                 if (argc > 6 && marc_cmp (field->identifier, argv[6]))
1020                     continue;
1021                 Tcl_AppendResult (interp, "{", field->identifier, NULL);
1022             }
1023             Tcl_AppendElement (interp, field->data);
1024             Tcl_AppendResult (interp, "} ", NULL);
1025         }
1026         Tcl_AppendResult (interp, "}} ", NULL);
1027     }
1028     return TCL_OK;
1029 }
1030
1031 /*
1032  * do_recordType: Return record type (if any) at position.
1033  */
1034 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
1035 {
1036     IRSetObj *obj = o;
1037     int offset;
1038     IRRecordList *rl;
1039
1040     if (argc < 3)
1041     {
1042         sprintf (interp->result, "wrong # args");
1043         return TCL_ERROR;
1044     }
1045     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1046         return TCL_ERROR;
1047     rl = find_IR_record (obj, offset);
1048     if (!rl)
1049         return TCL_OK;
1050     switch (rl->which)
1051     {
1052     case Z_NamePlusRecord_databaseRecord:
1053         interp->result = "databaseRecord";
1054         break;
1055     case Z_NamePlusRecord_surrogateDiagnostic:
1056         interp->result = "surrogateDiagnostic";
1057         break;
1058     }
1059     return TCL_OK;
1060 }
1061
1062 /*
1063  * do_recordDiag: Return diagnostic record info
1064  */
1065 static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv)
1066 {
1067     IRSetObj *obj = o;
1068     int offset;
1069     IRRecordList *rl;
1070     char buf[20];
1071
1072     if (argc < 3)
1073     {
1074         sprintf (interp->result, "wrong # args");
1075         return TCL_ERROR;
1076     }
1077     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1078         return TCL_ERROR;
1079     rl = find_IR_record (obj, offset);
1080     if (!rl)
1081     {
1082         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
1083         return TCL_ERROR;
1084     }
1085     if (rl->which != Z_NamePlusRecord_surrogateDiagnostic)
1086     {
1087         Tcl_AppendResult (interp, "No Diagnostic record at #", argv[2], NULL);
1088         return TCL_ERROR;
1089     }
1090     sprintf (buf, "%d", rl->u.diag.condition);
1091     Tcl_AppendResult (interp, buf, " {",
1092                       (rl->u.diag.addinfo ? rl->u.diag.addinfo : ""),
1093                       "}", NULL);
1094     return TCL_OK;
1095 }
1096
1097 /*
1098  * do_recordMarc: Get ISO2709 Record lines/fields
1099  */
1100 static int do_recordMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
1101 {
1102     IRSetObj *obj = o;
1103     int offset;
1104     IRRecordList *rl;
1105
1106     if (argc < 4)
1107     {
1108         sprintf (interp->result, "wrong # args");
1109         return TCL_ERROR;
1110     }
1111     if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1112         return TCL_ERROR;
1113     rl = find_IR_record (obj, offset);
1114     if (!rl)
1115     {
1116         Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
1117         return TCL_ERROR;
1118     }
1119     if (rl->which != Z_NamePlusRecord_databaseRecord)
1120     {
1121         Tcl_AppendResult (interp, "No MARC record at #", argv[2], NULL);
1122         return TCL_ERROR;
1123     }
1124     if (!strcmp (argv[3], "field"))
1125         return get_marc_fields (interp, rl->u.marc.rec, argc, argv);
1126     else if (!strcmp (argv[3], "line"))
1127         return get_marc_lines (interp, rl->u.marc.rec, argc, argv);
1128     else
1129     {
1130         Tcl_AppendResult (interp, "field/line expected", NULL);
1131         return TCL_ERROR;
1132     }
1133 }
1134
1135 /*
1136  * do_responseStatus: Return response status (present or search)
1137  */
1138 static int do_responseStatus (void *o, Tcl_Interp *interp,
1139                              int argc, char **argv)
1140 {
1141     IRSetObj *obj = o;
1142     const char *cp;
1143     char buf[28];
1144
1145     if (!obj->recordFlag)
1146         return TCL_OK;
1147     switch (obj->which)
1148     {
1149     case Z_Records_DBOSD:
1150         Tcl_AppendElement (interp, "DBOSD");
1151         break;
1152     case Z_Records_NSD:
1153         Tcl_AppendElement (interp, "NSD");
1154         sprintf (buf, "%d", obj->condition);
1155         Tcl_AppendElement (interp, buf);
1156         cp = diagbib1_str (obj->condition);
1157         if (cp)
1158             Tcl_AppendElement (interp, (char*) cp);
1159         else
1160             Tcl_AppendElement (interp, "");
1161         if (obj->addinfo)
1162             Tcl_AppendElement (interp, obj->addinfo);
1163         else
1164             Tcl_AppendElement (interp, "");
1165         break;
1166     }
1167     return TCL_OK;
1168 }
1169
1170 /*
1171  * do_present: Perform Present Request
1172  */
1173
1174 static int do_present (void *o, Tcl_Interp *interp,
1175                        int argc, char **argv)
1176 {
1177     IRSetObj *obj = o;
1178     IRObj *p = obj->parent;
1179     Z_APDU apdu, *apdup;
1180     Z_PresentRequest req;
1181     int start;
1182     int number;
1183     int r;
1184
1185     if (argc >= 3)
1186     {
1187         if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
1188             return TCL_ERROR;
1189     }
1190     else
1191         start = 1;
1192     if (argc >= 4)
1193     {
1194         if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
1195             return TCL_ERROR;
1196     }
1197     else
1198         number = 10;
1199     obj->start = start;
1200     obj->number = number;
1201
1202     apdup = &apdu;
1203     apdu.which = Z_APDU_presentRequest;
1204     apdu.u.presentRequest = &req;
1205     req.referenceId = 0;
1206     /* sprintf(setstring, "%d", setnumber); */
1207     req.resultSetId = "Default";
1208     req.resultSetStartPoint = &start;
1209     req.numberOfRecordsRequested = &number;
1210     req.elementSetNames = 0;
1211     req.preferredRecordSyntax = 0;
1212
1213     if (!z_APDU (p->odr_out, &apdup, 0))
1214     {
1215         interp->result = odr_errlist [odr_geterror (p->odr_out)];
1216         odr_reset (p->odr_out);
1217         return TCL_ERROR;
1218     }
1219     p->sbuf = odr_getbuf (p->odr_out, &p->slen);
1220     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
1221     {
1222         interp->result = "cs_put failed in init";
1223         return TCL_ERROR;
1224     }
1225     else if (r == 1)
1226     {
1227         ir_select_add_write (cs_fileno(p->cs_link), p);
1228         printf ("Part of present request, start=%d, num=%d (%d bytes)\n",
1229                 start, number, p->slen);
1230     }
1231     else
1232     {
1233         printf ("Whole present request, start=%d, num=%d (%d bytes)\n",
1234                 start, number, p->slen);
1235     }
1236     return TCL_OK;
1237 }
1238
1239 /*
1240  * do_loadFile: Load result set from file
1241  */
1242
1243 static int do_loadFile (void *o, Tcl_Interp *interp,
1244                         int argc, char **argv)
1245 {
1246     IRSetObj *setobj = o;
1247     FILE *inf;
1248     int  no = 1;
1249     const char *buf;
1250
1251     if (argc < 3)
1252     {
1253         interp->result = "wrong # args";
1254         return TCL_ERROR;
1255     }
1256     inf = fopen (argv[2], "r");
1257     if (!inf)
1258     {
1259         Tcl_AppendResult (interp, "Cannot open ", argv[2], NULL);
1260         return TCL_ERROR;
1261     }
1262     while ((buf = iso2709_read (inf)))
1263     {
1264         IRRecordList *rl;
1265         Iso2709Rec rec;
1266
1267         rec = iso2709_cvt (buf);
1268         if (!rec)
1269             break;
1270         rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord);
1271         rl->u.marc.rec = rec;
1272         no++;
1273     }
1274     setobj->numberOfRecordsReturned = no-1;
1275     fclose (inf);
1276     return TCL_OK;
1277 }
1278
1279
1280 /*
1281  * ir_set_obj_method: IR Set Object methods
1282  */
1283 static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
1284                           int argc, char **argv)
1285 {
1286     static IRMethod tab[] = {
1287     { 0, "search",                  do_search },
1288     { 0, "searchStatus",            do_searchStatus },
1289     { 0, "setName",                 do_setName },
1290     { 0, "resultCount",             do_resultCount },
1291     { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned },
1292     { 0, "present",                 do_present },
1293     { 0, "recordType",              do_recordType },
1294     { 0, "recordMarc",              do_recordMarc },
1295     { 0, "recordDiag",              do_recordDiag },
1296     { 0, "responseStatus",          do_responseStatus },
1297     { 0, "loadFile",                do_loadFile },
1298     { 0, NULL, NULL}
1299     };
1300
1301     if (argc < 2)
1302     {
1303         interp->result = "wrong # args";
1304         return TCL_ERROR;
1305     }
1306     return ir_method (clientData, interp, argc, argv, tab);
1307 }
1308
1309 /*
1310  * ir_set_obj_delete: IR Set Object disposal
1311  */
1312 static void ir_set_obj_delete (ClientData clientData)
1313 {
1314     free ( (void*) clientData);
1315 }
1316
1317 /*
1318  * ir_set_obj_mk: IR Set Object creation
1319  */
1320 static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
1321                              int argc, char **argv)
1322 {
1323     Tcl_CmdInfo parent_info;
1324     IRSetObj *obj;
1325
1326     if (argc != 2)
1327     {
1328         interp->result = "wrong # args";
1329         return TCL_ERROR;
1330     }
1331     if (get_parent_info (interp, argv[1], &parent_info) == TCL_ERROR)
1332         return TCL_ERROR;
1333     if (!(obj = ir_malloc (interp, sizeof(*obj))))
1334         return TCL_ERROR;
1335     obj->setName = NULL;
1336     obj->record_list = NULL;
1337     obj->addinfo = NULL;
1338     obj->parent = (IRObj *) parent_info.clientData;
1339     Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
1340                        (ClientData) obj, ir_set_obj_delete);
1341     return TCL_OK;
1342 }
1343
1344 /* ------------------------------------------------------- */
1345
1346 static void ir_initResponse (void *obj, Z_InitResponse *initrs)
1347 {
1348     if (!*initrs->result)
1349         printf("Connection rejected by target.\n");
1350     else
1351         printf("Connection accepted by target.\n");
1352     if (initrs->implementationId)
1353             printf("ID     : %s\n", initrs->implementationId);
1354     if (initrs->implementationName)
1355         printf("Name   : %s\n", initrs->implementationName);
1356     if (initrs->implementationVersion)
1357         printf("Version: %s\n", initrs->implementationVersion);
1358     if (initrs->maximumRecordSize)
1359         printf ("MaximumRecordSize=%d\n", *initrs->maximumRecordSize);
1360     if (initrs->preferredMessageSize)
1361         printf ("PreferredMessageSize=%d\n", *initrs->preferredMessageSize);
1362 #if 0
1363     if (initrs->userInformationField)
1364     {
1365         printf("UserInformationfield:\n");
1366         odr_external(&print, (Odr_external**)&initrs->
1367                          userInformationField, 0);
1368     }
1369 #endif
1370 }
1371
1372 static void ir_handleRecords (void *o, Z_Records *zrs)
1373 {
1374     IRObj *p = o;
1375     IRSetObj *setobj = p->child;
1376
1377     setobj->which = zrs->which;
1378     setobj->recordFlag = 1;
1379     if (zrs->which == Z_Records_NSD)
1380     {
1381         const char *addinfo;
1382
1383         setobj->numberOfRecordsReturned = 0;
1384         setobj->condition = *zrs->u.nonSurrogateDiagnostic->condition;
1385         free (setobj->addinfo);
1386         setobj->addinfo = NULL;
1387         addinfo = zrs->u.nonSurrogateDiagnostic->addinfo;
1388         if (addinfo && (setobj->addinfo = malloc (strlen(addinfo) + 1)))
1389             strcpy (setobj->addinfo, addinfo);
1390         printf ("Diagnostic response. %s (%d): %s\n",
1391                 diagbib1_str (setobj->condition),
1392                 setobj->condition,
1393                 setobj->addinfo ? setobj->addinfo : "");
1394     }
1395     else
1396     {
1397         int offset;
1398         IRRecordList *rl;
1399
1400         setobj->numberOfRecordsReturned =
1401             zrs->u.databaseOrSurDiagnostics->num_records;
1402         printf ("Got %d records\n", setobj->numberOfRecordsReturned);
1403         for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
1404         {
1405             rl = new_IR_record (setobj, setobj->start + offset,
1406                                 zrs->u.databaseOrSurDiagnostics->
1407                                 records[offset]->which);
1408             if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
1409             {
1410                 Z_DiagRec *diagrec;
1411
1412                 diagrec = zrs->u.databaseOrSurDiagnostics->
1413                     records[offset]->u.surrogateDiagnostic;
1414
1415                 rl->u.diag.condition = *diagrec->condition;
1416                 if (diagrec->addinfo && (rl->u.diag.addinfo =
1417                                          malloc (strlen (diagrec->addinfo)+1)))
1418                     strcpy (rl->u.diag.addinfo, diagrec->addinfo);
1419             }
1420             else
1421             {
1422                 Z_DatabaseRecord *zr;
1423                 Odr_external *oe;
1424
1425                 zr = zrs->u.databaseOrSurDiagnostics->records[offset]
1426                     ->u.databaseRecord;
1427                 oe = (Odr_external*) zr;
1428                 if (oe->which == ODR_EXTERNAL_octet
1429                     && zr->u.octet_aligned->len)
1430                 {
1431                     const char *buf = (char*) zr->u.octet_aligned->buf;
1432                     rl->u.marc.rec = iso2709_cvt (buf);
1433                 }
1434                 else
1435                     rl->u.marc.rec = NULL;
1436             }
1437         }
1438     }
1439 }
1440
1441 static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
1442 {
1443     IRObj *p = o;
1444     IRSetObj *setobj = p->child;
1445     Z_Records *zrs = searchrs->records;
1446
1447     if (setobj)
1448     {
1449         setobj->searchStatus = searchrs->searchStatus ? 1 : 0;
1450         setobj->resultCount = *searchrs->resultCount;
1451         printf ("Search response %d, %d hits\n",
1452                  setobj->searchStatus, setobj->resultCount);
1453         if (zrs)
1454             ir_handleRecords (o, zrs);
1455         else
1456             setobj->recordFlag = 0;
1457     }
1458     else
1459         printf ("Search response, no object!\n");
1460 }
1461
1462
1463 static void ir_presentResponse (void *o, Z_PresentResponse *presrs)
1464 {
1465     IRObj *p = o;
1466     IRSetObj *setobj = p->child;
1467     Z_Records *zrs = presrs->records;
1468
1469     printf ("Received presentResponse\n");
1470     if (zrs)
1471         ir_handleRecords (o, zrs);
1472     else
1473     {
1474         setobj->recordFlag = 0;
1475         printf ("No records!\n");
1476     }
1477 }
1478
1479 /*
1480  * ir_select_read: handle incoming packages
1481  */
1482 void ir_select_read (ClientData clientData)
1483 {
1484     IRObj *p = clientData;
1485     Z_APDU *apdu;
1486     int r;
1487
1488     if (p->connectFlag)
1489     {
1490         r = cs_rcvconnect (p->cs_link);
1491         if (r == 1)
1492             return;
1493         p->connectFlag = 0;
1494         if (r < 0)
1495         {
1496             printf ("cs_rcvconnect error\n");
1497             ir_select_remove_write (cs_fileno (p->cs_link), p);
1498             return;
1499         }
1500         ir_select_remove_write (cs_fileno (p->cs_link), p);
1501         if (p->callback)
1502             Tcl_Eval (p->interp, p->callback);
1503         return;
1504     }
1505     do
1506     {
1507         if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in))  <= 0)
1508         {
1509             printf ("cs_get failed\n");
1510             ir_select_remove (cs_fileno (p->cs_link), p);
1511             return;
1512         }
1513         if (r == 1)
1514             return ;
1515         odr_setbuf (p->odr_in, p->buf_in, r);
1516         printf ("cs_get ok, got %d\n", r);
1517         if (!z_APDU (p->odr_in, &apdu, 0))
1518         {
1519             printf ("%s\n", odr_errlist [odr_geterror (p->odr_in)]);
1520             return;
1521         }
1522         switch(apdu->which)
1523         {
1524         case Z_APDU_initResponse:
1525             ir_initResponse (p, apdu->u.initResponse);
1526             break;
1527         case Z_APDU_searchResponse:
1528             ir_searchResponse (p, apdu->u.searchResponse);
1529             break;
1530         case Z_APDU_presentResponse:
1531             ir_presentResponse (p, apdu->u.presentResponse);
1532             break;
1533         default:
1534             printf("Received unknown APDU type (%d).\n",
1535                    apdu->which);
1536         }
1537         if (p->callback)
1538             Tcl_Eval (p->interp, p->callback);
1539     } while (cs_more (p->cs_link));
1540 }
1541
1542 /*
1543  * ir_select_write: handle outgoing packages - not yet written.
1544  */
1545 void ir_select_write (ClientData clientData)
1546 {
1547     IRObj *p = clientData;
1548     int r;
1549
1550     printf ("In write handler.....\n");
1551     if (p->connectFlag)
1552     {
1553         r = cs_rcvconnect (p->cs_link);
1554         if (r == 1)
1555             return;
1556         p->connectFlag = 0;
1557         if (r < 0)
1558         {
1559             printf ("cs_rcvconnect error\n");
1560             ir_select_remove_write (cs_fileno (p->cs_link), p);
1561             return;
1562         }
1563         ir_select_remove_write (cs_fileno (p->cs_link), p);
1564         if (p->callback)
1565             Tcl_Eval (p->interp, p->callback);
1566         return;
1567     }
1568     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
1569     {
1570         printf ("select write fail\n");
1571         cs_close (p->cs_link);
1572     }
1573     else if (r == 0)            /* remove select bit */
1574     {
1575         ir_select_remove_write (cs_fileno (p->cs_link), p);
1576     }
1577 }
1578
1579 /* ------------------------------------------------------- */
1580
1581 /*
1582  * ir_tcl_init: Registration of TCL commands.
1583  */
1584 int ir_tcl_init (Tcl_Interp *interp)
1585 {
1586     Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL,
1587                        (Tcl_CmdDeleteProc *) NULL);
1588     Tcl_CreateCommand (interp, "ir-set", ir_set_obj_mk,
1589                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
1590     return TCL_OK;
1591 }
1592
1593