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