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