ir-tcl.c

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