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