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