ZOOM.xs

   1 /* $Id: ZOOM.xs,v 1.49 2007-10-29 12:06:57 mike Exp $ */
   2
   3 #include "EXTERN.h"
   4 #include "perl.h"
   5 #include "XSUB.h"
   6
   7 #include <yaz/zoom.h>
   8 #include <yaz/diagsrw.h>
   9 #include <yaz/xmalloc.h>
  10 #include <yaz/log.h>
  11
  12 /* Used by the *_setl() functions */
  13 typedef char opaquechar;
  14
  15 /* Used as the return value of the *_getl() functions */
  16 struct datachunk {
  17         char *data;
  18         int len;
  19 };
  20
  21 /* Used to package Perl function-pointer and user-data together */
  22 struct callback_block {
  23         SV *function;
  24         SV *handle;
  25 };
  26
  27 /* The callback function used for ZOOM_options_set_callback().  I do
  28  * not claim to fully understand all the stack-hacking magic, and less
  29  * still the reference-counting/mortality stuff.  Accordingly, the
  30  * memory management here is best characterised as What I Could Get To
  31  * Work, More Or Less.
  32  */
  33 const char *__ZOOM_option_callback (void *handle, const char *name)
  34 {
  35         struct callback_block *cb = (struct callback_block*) handle;
  36         int count;
  37         SV *ret;
  38         char *s;
  39         char *res;
  40
  41         dSP;
  42
  43         ENTER;
  44         SAVETMPS;
  45
  46         PUSHMARK(SP);
  47         XPUSHs(cb->handle);
  48         XPUSHs(sv_2mortal(newSVpv(name, 0)));
  49         PUTBACK;
  50         /* Perl_sv_dump(0, cb->function); */
  51
  52         count = call_sv(cb->function, G_SCALAR);
  53
  54         SPAGAIN;
  55
  56         if (count != 1)
  57                 croak("callback function for ZOOM_options_get() returned %d values: should have returned exactly one", count);
  58
  59         ret = POPs;
  60         if (SvPOK(ret)) {
  61                 s = SvPV_nolen(ret);
  62                 /* ### `res' never gets freed!  I think it is
  63                  * impossible to solve this problem "correctly"
  64                  * because the ZOOM-C option callback interface is
  65                  * inadequate. */
  66                 res = xstrdup(s);
  67         } else {
  68                 res = 0;
  69         }
  70
  71         PUTBACK;
  72         FREETMPS;
  73         LEAVE;
  74
  75         return res;
  76 }
  77
  78
  79 MODULE = Net::Z3950::ZOOM               PACKAGE = Net::Z3950::ZOOM              PREFIX=ZOOM_
  80
  81 PROTOTYPES: ENABLE
  82
  83
  84 ZOOM_connection
  85 ZOOM_connection_new(host, portnum)
  86         const char* host
  87         int portnum
  88
  89 ZOOM_connection
  90 ZOOM_connection_create(options)
  91         ZOOM_options options
  92
  93 void
  94 ZOOM_connection_connect(c, host, portnum)
  95         ZOOM_connection c
  96         const char* host
  97         int portnum
  98
  99 void
 100 ZOOM_connection_destroy(c)
 101         ZOOM_connection c
 102
 103 const char *
 104 ZOOM_connection_option_get(c, key)
 105         ZOOM_connection c
 106         const char *key
 107
 108 struct datachunk
 109 ZOOM_connection_option_getl(c, key, len)
 110         ZOOM_connection c
 111         const char* key
 112         int &len
 113         CODE:
 114                 RETVAL.data = (char*) ZOOM_connection_option_getl(c, key, &len);
 115                 RETVAL.len = len;
 116         OUTPUT:
 117                 RETVAL
 118                 len
 119
 120 void
 121 ZOOM_connection_option_set(c, key, val)
 122         ZOOM_connection c
 123         const char *key
 124         const char *val
 125
 126 # In ZOOM-C, the `val' parameter is const char*.  However, our typemap
 127 # treats this as T_PV, i.e. it's "known" that it points to a
 128 # NUL-terminated string.  Instead, then, I here use opaquechar*, which
 129 # is an opaque pointer.  The underlying C function can then use this
 130 # along with `len' to Do The Right Thing.
 131 #
 132 void
 133 ZOOM_connection_option_setl(c, key, val, len)
 134         ZOOM_connection c
 135         const char* key
 136         opaquechar* val
 137         int len
 138
 139 # The reference parameters, `cp' and `addinfo', need to already have
 140 # values when this function is called, otherwise an "uninitialised
 141 # value" warning is generated.  As far as I can see, there is no way
 142 # around this: no way to specify in a prototype that an argument is
 143 # allowed to be undefined, for example.  Since these function will
 144 # never be called directly by well-behaved client code, but only by
 145 # our own wrapper classes, I think we can live with that.
 146 #
 147 # The poxing about with cpp and caddinfo is due to Perl XS's lack of
 148 # support for const char**, but who can blame it?  If you ask me, the
 149 # whole "const" thing was well-intentioned by ghastly mistake.
 150 #
 151 int
 152 ZOOM_connection_error(c, cp, addinfo)
 153         ZOOM_connection c
 154         char* &cp
 155         char* &addinfo
 156         CODE:
 157                 {
 158                 const char *ccp, *caddinfo;
 159                 RETVAL = ZOOM_connection_error(c, &ccp, &caddinfo);
 160                 cp = (char*) ccp;
 161                 addinfo = (char*) caddinfo;
 162                 }
 163         OUTPUT:
 164                 RETVAL
 165                 cp
 166                 addinfo
 167
 168 # See comments for ZOOM_connection_error() above
 169 int
 170 ZOOM_connection_error_x(c, cp, addinfo, diagset)
 171         ZOOM_connection c
 172         const char * &cp
 173         const char * &addinfo
 174         const char * &diagset
 175         CODE:
 176                 {
 177                 const char *ccp, *caddinfo, *cdset;
 178                 RETVAL = ZOOM_connection_error_x(c, &ccp, &caddinfo, &cdset);
 179                 cp = (char*) ccp;
 180                 addinfo = (char*) caddinfo;
 181                 diagset = (char*) cdset;
 182                 }
 183         OUTPUT:
 184                 RETVAL
 185                 cp
 186                 addinfo
 187                 diagset
 188
 189 int
 190 ZOOM_connection_errcode(c)
 191         ZOOM_connection c
 192
 193 const char *
 194 ZOOM_connection_errmsg(c)
 195         ZOOM_connection c
 196
 197 const char *
 198 ZOOM_connection_addinfo(c)
 199         ZOOM_connection c
 200
 201 const char *
 202 ZOOM_connection_diagset(c)
 203         ZOOM_connection c
 204
 205 const char *
 206 ZOOM_diag_str(error)
 207         int error
 208
 209 const char *
 210 ZOOM_diag_srw_str(error)
 211         int error
 212         CODE:
 213                 RETVAL = yaz_diag_srw_str(error);
 214         OUTPUT:
 215                 RETVAL
 216
 217 ZOOM_resultset
 218 ZOOM_connection_search(arg0, q)
 219         ZOOM_connection arg0
 220         ZOOM_query q
 221
 222 ZOOM_resultset
 223 ZOOM_connection_search_pqf(c, q)
 224         ZOOM_connection c
 225         const char *q
 226
 227 void
 228 ZOOM_resultset_destroy(r)
 229         ZOOM_resultset r
 230
 231 const char *
 232 ZOOM_resultset_option_get(r, key)
 233         ZOOM_resultset r
 234         const char* key
 235
 236 void
 237 ZOOM_resultset_option_set(r, key, val)
 238         ZOOM_resultset r
 239         const char* key
 240         const char* val
 241
 242 size_t
 243 ZOOM_resultset_size(r)
 244         ZOOM_resultset r
 245
 246 SV *
 247 ZOOM_resultset_records(r, start, count, return_records)
 248         ZOOM_resultset r
 249         size_t start
 250         size_t count
 251         int return_records
 252         CODE:
 253                 {
 254                 ZOOM_record *recs = 0;
 255                 if (return_records)
 256                         recs = (ZOOM_record*) xmalloc(count * sizeof *recs);
 257                 ZOOM_resultset_records(r, recs, start, count);
 258                 if (return_records) {
 259                         AV *av = newAV();
 260                         int i;
 261                         for (i = 0; i < count; i++) {
 262                                 SV *tmp = newSV(0);
 263                                 sv_setref_pv(tmp, "ZOOM_record", (void*) recs[i]);
 264                                 av_push(av, tmp);
 265                         }
 266                         RETVAL = newRV((SV*) av);
 267                 } else {
 268                         RETVAL = &PL_sv_undef;
 269                 }
 270                 }
 271         OUTPUT:
 272                 RETVAL
 273
 274 ZOOM_record
 275 ZOOM_resultset_record(s, pos)
 276         ZOOM_resultset s
 277         size_t pos
 278
 279 ZOOM_record
 280 ZOOM_resultset_record_immediate(s, pos)
 281         ZOOM_resultset s
 282         size_t pos
 283
 284 void
 285 ZOOM_resultset_cache_reset(r)
 286         ZOOM_resultset r
 287
 288 # TESTED (but deprecated)
 289 void
 290 ZOOM_resultset_sort(r, sort_type, sort_spec)
 291         ZOOM_resultset r
 292         const char* sort_type
 293         const char* sort_spec
 294
 295 int
 296 ZOOM_resultset_sort1(r, sort_type, sort_spec)
 297         ZOOM_resultset r
 298         const char* sort_type
 299         const char* sort_spec
 300
 301 # See comments for ZOOM_connection_error() above
 302 int
 303 ZOOM_record_error(rec, cp, addinfo, diagset)
 304         ZOOM_record rec
 305         const char* &cp
 306         const char* &addinfo
 307         const char* &diagset
 308         CODE:
 309                 {
 310                 const char *ccp = "", *caddinfo = "", *cdset = "";
 311                 RETVAL = ZOOM_record_error(rec, &ccp, &caddinfo, &cdset);
 312                 cp = (char*) ccp;
 313                 addinfo = (char*) caddinfo;
 314                 diagset = (char*) cdset;
 315                 }
 316         OUTPUT:
 317                 RETVAL
 318                 cp
 319                 addinfo
 320                 diagset
 321
 322 # See "typemap" for discussion of the "const char *" return-type.
 323 #
 324 ### but should use datachunk for in some (not all!) cases.
 325 const char *
 326 ZOOM_record_get(rec, type, len)
 327         ZOOM_record rec
 328         const char* type
 329         int &len
 330         OUTPUT:
 331                 RETVAL
 332                 len
 333
 334 void
 335 ZOOM_record_destroy(rec)
 336         ZOOM_record rec
 337
 338 ZOOM_record
 339 ZOOM_record_clone(srec)
 340         ZOOM_record srec
 341
 342 ZOOM_query
 343 ZOOM_query_create()
 344
 345 void
 346 ZOOM_query_destroy(s)
 347         ZOOM_query s
 348
 349 int
 350 ZOOM_query_cql(s, str)
 351         ZOOM_query s
 352         const char* str
 353
 354 int
 355 ZOOM_query_cql2rpn(s, str, conn)
 356         ZOOM_query s
 357         const char* str
 358         ZOOM_connection conn
 359
 360 int
 361 ZOOM_query_ccl2rpn(s, query_str, config, errcode, errstr, errpos)
 362         ZOOM_query s
 363         const char* query_str
 364         const char* config
 365         int &errcode
 366         const char* &errstr
 367         int &errpos
 368         OUTPUT:
 369                 RETVAL
 370                 errcode
 371                 errstr
 372                 errpos
 373
 374 int
 375 ZOOM_query_prefix(s, str)
 376         ZOOM_query s
 377         const char* str
 378
 379 int
 380 ZOOM_query_sortby(s, criteria)
 381         ZOOM_query      s
 382         const char *    criteria
 383
 384 ZOOM_scanset
 385 ZOOM_connection_scan(c, startterm)
 386         ZOOM_connection c
 387         const char* startterm
 388
 389 ZOOM_scanset
 390 ZOOM_connection_scan1(c, startterm)
 391         ZOOM_connection c
 392         ZOOM_query startterm
 393
 394 const char *
 395 ZOOM_scanset_term(scan, pos, occ, len)
 396         ZOOM_scanset scan
 397         size_t pos
 398         int& occ
 399         int& len
 400         OUTPUT:
 401                 RETVAL
 402                 occ
 403                 len
 404
 405 const char *
 406 ZOOM_scanset_display_term(scan, pos, occ, len)
 407         ZOOM_scanset scan
 408         size_t pos
 409         int& occ
 410         int& len
 411         OUTPUT:
 412                 RETVAL
 413                 occ
 414                 len
 415
 416 size_t
 417 ZOOM_scanset_size(scan)
 418         ZOOM_scanset scan
 419
 420 void
 421 ZOOM_scanset_destroy(scan)
 422         ZOOM_scanset scan
 423
 424 const char *
 425 ZOOM_scanset_option_get(scan, key)
 426         ZOOM_scanset    scan
 427         const char *    key
 428
 429 void
 430 ZOOM_scanset_option_set(scan, key, val)
 431         ZOOM_scanset    scan
 432         const char *    key
 433         const char *    val
 434
 435 # We ignore the return value of ZOOM_options_set_callback(), since it
 436 # is always just the address of the __ZOOM_option_callback() function.
 437 # The information that we actually want -- the address of the Perl
 438 # function in the callback_block -- is unavailable to us, as the
 439 # underlying C function doesn't give the block back.
 440 #
 441 void
 442 ZOOM_options_set_callback(opt, function, handle)
 443         ZOOM_options opt
 444         SV* function;
 445         SV* handle;
 446         CODE:
 447                 {
 448                 /* The tiny amount of memory allocated here is never
 449                  * released, as options_destroy() doesn't do anything
 450                  * to the callback information.  Not a big deal.
 451                  * Also, I have no idea how to drive the Perl "mortal"
 452                  * reference-counting stuff, so I am just allocating
 453                  * copies which also never get released.  Don't sue!
 454                  */
 455                 struct callback_block *block = (struct callback_block*)
 456                         xmalloc(sizeof *block);
 457                 block->function = function;
 458                 block->handle = handle;
 459                 SvREFCNT(block->function);
 460                 SvREFCNT(block->handle);
 461                 ZOOM_options_set_callback(opt, __ZOOM_option_callback,
 462                                           (void*) block);
 463                 }
 464
 465 ZOOM_options
 466 ZOOM_options_create()
 467
 468 ZOOM_options
 469 ZOOM_options_create_with_parent(parent)
 470         ZOOM_options parent
 471
 472 ZOOM_options
 473 ZOOM_options_create_with_parent2(parent1, parent2)
 474         ZOOM_options parent1
 475         ZOOM_options parent2
 476
 477 const char *
 478 ZOOM_options_get(opt, name)
 479         ZOOM_options opt
 480         const char* name
 481
 482 struct datachunk
 483 ZOOM_options_getl(opt, name, len)
 484         ZOOM_options opt
 485         const char* name
 486         int &len
 487         CODE:
 488                 RETVAL.data = (char*) ZOOM_options_getl(opt, name, &len);
 489                 RETVAL.len = len;
 490         OUTPUT:
 491                 RETVAL
 492                 len
 493
 494 void
 495 ZOOM_options_set(opt, name, v)
 496         ZOOM_options opt
 497         const char* name
 498         const char* v
 499
 500 void
 501 ZOOM_options_setl(opt, name, value, len)
 502         ZOOM_options opt
 503         const char* name
 504         opaquechar* value
 505         int len
 506
 507 void
 508 ZOOM_options_destroy(opt)
 509         ZOOM_options opt
 510
 511 int
 512 ZOOM_options_get_bool(opt, name, defa)
 513         ZOOM_options opt
 514         const char* name
 515         int defa
 516
 517 int
 518 ZOOM_options_get_int(opt, name, defa)
 519         ZOOM_options opt
 520         const char* name
 521         int defa
 522
 523 void
 524 ZOOM_options_set_int(opt, name, value)
 525         ZOOM_options opt
 526         const char* name
 527         int value
 528
 529 ZOOM_package
 530 ZOOM_connection_package(c, options)
 531         ZOOM_connection c
 532         ZOOM_options    options
 533
 534 void
 535 ZOOM_package_destroy(p)
 536         ZOOM_package    p
 537
 538 void
 539 ZOOM_package_send(p, type)
 540         ZOOM_package    p
 541         const char *    type
 542
 543 const char *
 544 ZOOM_package_option_get(p, key)
 545         ZOOM_package    p
 546         const char *    key
 547
 548 void
 549 ZOOM_package_option_set(p, key, val)
 550         ZOOM_package    p
 551         const char *    key
 552         const char *    val
 553
 554 # This has to be called with a single argument which is a _reference_
 555 # to an array -- rather than directly with an array, which is of
 556 # course identical to passing arbitrarily many arguments.  This is
 557 # because there doesn't seem to be a way to do varargs in an XS
 558 # function.
 559 #
 560 int
 561 ZOOM_event(conns)
 562         SV* conns
 563         INIT:
 564                 SV *realconns;
 565                 I32 n, i;
 566                 int res;
 567                 ZOOM_connection *cs;
 568         CODE:
 569                 /*printf("* in ZOOM_event(%p)\n", conns);*/
 570                 if (!SvROK(conns)) {
 571                         /*printf("* argument is not a reference\n");*/
 572                         XSRETURN_IV(-1);
 573                 }
 574                 realconns = SvRV(conns);
 575                 /*printf("* realconns = %p\n", realconns);*/
 576                 if (SvTYPE(realconns) != SVt_PVAV) {
 577                         /*printf("* reference is not to an array\n");*/
 578                         XSRETURN_IV(-2);
 579                 }
 580                 n = av_len((AV*) realconns);
 581                 n++; /* The av_len() return-value is zero-based */
 582                 if (n == 0) {
 583                         /*printf("* No connections in referenced array\n");*/
 584                         XSRETURN_IV(-3);
 585                 }
 586
 587                 /*printf("* n = %d\n", n);*/
 588                 if ((cs = (ZOOM_connection*) malloc(n * sizeof *cs)) == 0) {
 589                         /*printf("* Too many connections (%d)\n", (int) n);*/
 590                         XSRETURN_IV(-4);
 591                 }
 592
 593                 for (i = 0; i < n; i++) {
 594                     SV **connp = av_fetch((AV*) realconns, i, (I32) 0);
 595                     SV *conn, *sv;
 596                     /*printf("* %d of %d: connp = %p\n", (int) i, (int) n,connp);*/
 597                     assert(connp != 0);
 598                     conn = *connp;
 599                     /*printf("* conn = %p\n", conn);*/
 600                     /*
 601                      * From here on, the tests and assertions seem to
 602                      * be ignored: if I pass in a reference to
 603                      * something other than a ZOOM_connection, or even
 604                      * if I pass a non-reference, the assertions still
 605                      * pass and everything seems to work until the
 606                      * segmentation fault bites.
 607                      */
 608                     assert(sv_derived_from(conn, "ZOOM_connection"));
 609                     /*printf("* passed assert(isa(ZOOM_connection))\n");*/
 610                     assert(SvROK(conn));
 611                     /*printf("* passed assert SvROK()\n");*/
 612                     sv = (SV*) SvRV(conn);
 613                     /*printf("* sv = %p\n", sv);*/
 614                     cs[i] = INT2PTR(ZOOM_connection, SvIV(sv));
 615                     /*printf("got cs[%d] of %d = %p\n", (int) i, (int) n, cs[i]);*/
 616                 }
 617                 RETVAL = ZOOM_event((int) n, cs);
 618                 free(cs);
 619         OUTPUT:
 620                 RETVAL
 621
 622 int
 623 ZOOM_connection_last_event(cs)
 624         ZOOM_connection cs
 625
 626 int
 627 ZOOM_connection_is_idle(cs)
 628         ZOOM_connection cs
 629
 630 int
 631 ZOOM_connection_peek_event(cs)
 632         ZOOM_connection cs
 633
 634
 635 # ----------------------------------------------------------------------------
 636 # What follows is the YAZ logging API.  This is not strictly part of
 637 # ZOOM, but it's so useful that it would be silly to omit.
 638
 639 int
 640 yaz_log_mask_str(str)
 641         const char *str
 642
 643 int
 644 yaz_log_module_level(name)
 645         const char *name
 646
 647 void
 648 yaz_log_init(level, prefix, name)
 649         int level
 650         const char *prefix
 651         const char *name
 652
 653 void
 654 yaz_log_init_file(fname)
 655         const char *fname
 656
 657 void
 658 yaz_log_init_level(level)
 659         int level
 660
 661 void
 662 yaz_log_init_prefix(prefix)
 663         const char *prefix
 664
 665 void
 666 yaz_log_time_format(fmt)
 667         const char *fmt
 668
 669 void
 670 yaz_log_init_max_size(mx)
 671         int mx
 672
 673 # <stdarg.h> interfaces are horrible to code for a Perl-C interface
 674 # layer.  Instead, we expect Perl applications to construct the
 675 # message themselves, and pass it in as an opaque lump.
 676 void
 677 yaz_log(level, str)
 678         int level
 679         const char *str
 680         CODE:
 681                 yaz_log(level, "%s", str);
 682
 683 # This is also not strictly part of ZOOM
 684 unsigned long
 685 yaz_version(version_str, sys_str)
 686         char *version_str
 687         char *sys_str
 688         OUTPUT:
 689                 RETVAL
 690                 version_str
 691                 sys_str
 692