1 /* $Id: ZOOM.xs,v 1.51 2008-05-14 13:31:39 mike Exp $ */
8 #include <yaz/diagsrw.h>
9 #include <yaz/xmalloc.h>
11 #include <yaz/yaz-version.h>
13 /* Used by the *_setl() functions */
14 typedef char opaquechar;
16 /* Used as the return value of the *_getl() functions */
22 /* Used to package Perl function-pointer and user-data together */
23 struct callback_block {
28 /* The callback function used for ZOOM_options_set_callback(). I do
29 * not claim to fully understand all the stack-hacking magic, and less
30 * still the reference-counting/mortality stuff. Accordingly, the
31 * memory management here is best characterised as What I Could Get To
34 const char *__ZOOM_option_callback (void *handle, const char *name)
36 struct callback_block *cb = (struct callback_block*) handle;
49 XPUSHs(sv_2mortal(newSVpv(name, 0)));
51 /* Perl_sv_dump(0, cb->function); */
53 count = call_sv(cb->function, G_SCALAR);
58 croak("callback function for ZOOM_options_get() returned %d values: should have returned exactly one", count);
63 /* ### `res' never gets freed! I think it is
64 * impossible to solve this problem "correctly"
65 * because the ZOOM-C option callback interface is
80 MODULE = Net::Z3950::ZOOM PACKAGE = Net::Z3950::ZOOM PREFIX=ZOOM_
86 ZOOM_connection_new(host, portnum)
91 ZOOM_connection_create(options)
95 ZOOM_connection_connect(c, host, portnum)
101 ZOOM_connection_destroy(c)
105 ZOOM_connection_option_get(c, key)
110 ZOOM_connection_option_getl(c, key, len)
115 RETVAL.data = (char*) ZOOM_connection_option_getl(c, key, &len);
122 ZOOM_connection_option_set(c, key, val)
127 # In ZOOM-C, the `val' parameter is const char*. However, our typemap
128 # treats this as T_PV, i.e. it's "known" that it points to a
129 # NUL-terminated string. Instead, then, I here use opaquechar*, which
130 # is an opaque pointer. The underlying C function can then use this
131 # along with `len' to Do The Right Thing.
134 ZOOM_connection_option_setl(c, key, val, len)
140 # The reference parameters, `cp' and `addinfo', need to already have
141 # values when this function is called, otherwise an "uninitialised
142 # value" warning is generated. As far as I can see, there is no way
143 # around this: no way to specify in a prototype that an argument is
144 # allowed to be undefined, for example. Since these function will
145 # never be called directly by well-behaved client code, but only by
146 # our own wrapper classes, I think we can live with that.
148 # The poxing about with cpp and caddinfo is due to Perl XS's lack of
149 # support for const char**, but who can blame it? If you ask me, the
150 # whole "const" thing was well-intentioned by ghastly mistake.
153 ZOOM_connection_error(c, cp, addinfo)
159 const char *ccp, *caddinfo;
160 RETVAL = ZOOM_connection_error(c, &ccp, &caddinfo);
162 addinfo = (char*) caddinfo;
169 # See comments for ZOOM_connection_error() above
171 ZOOM_connection_error_x(c, cp, addinfo, diagset)
174 const char * &addinfo
175 const char * &diagset
178 const char *ccp, *caddinfo, *cdset;
179 RETVAL = ZOOM_connection_error_x(c, &ccp, &caddinfo, &cdset);
181 addinfo = (char*) caddinfo;
182 diagset = (char*) cdset;
191 ZOOM_connection_errcode(c)
195 ZOOM_connection_errmsg(c)
199 ZOOM_connection_addinfo(c)
203 ZOOM_connection_diagset(c)
211 ZOOM_diag_srw_str(error)
214 RETVAL = yaz_diag_srw_str(error);
219 ZOOM_connection_search(arg0, q)
224 ZOOM_connection_search_pqf(c, q)
229 ZOOM_resultset_destroy(r)
233 ZOOM_resultset_option_get(r, key)
238 ZOOM_resultset_option_set(r, key, val)
244 ZOOM_resultset_size(r)
248 ZOOM_resultset_records(r, start, count, return_records)
255 ZOOM_record *recs = 0;
257 recs = (ZOOM_record*) xmalloc(count * sizeof *recs);
258 ZOOM_resultset_records(r, recs, start, count);
259 if (return_records) {
262 for (i = 0; i < count; i++) {
264 sv_setref_pv(tmp, "ZOOM_record", (void*) recs[i]);
267 RETVAL = newRV((SV*) av);
269 RETVAL = &PL_sv_undef;
276 ZOOM_resultset_record(s, pos)
281 ZOOM_resultset_record_immediate(s, pos)
286 ZOOM_resultset_cache_reset(r)
289 # TESTED (but deprecated)
291 ZOOM_resultset_sort(r, sort_type, sort_spec)
293 const char* sort_type
294 const char* sort_spec
297 ZOOM_resultset_sort1(r, sort_type, sort_spec)
299 const char* sort_type
300 const char* sort_spec
302 # See comments for ZOOM_connection_error() above
304 ZOOM_record_error(rec, cp, addinfo, diagset)
311 const char *ccp = "", *caddinfo = "", *cdset = "";
312 RETVAL = ZOOM_record_error(rec, &ccp, &caddinfo, &cdset);
314 addinfo = (char*) caddinfo;
315 diagset = (char*) cdset;
323 # See "typemap" for discussion of the "const char *" return-type.
325 ZOOM_record_get_string(rec, type)
331 RETVAL = ZOOM_record_get(rec, type, &len);
336 ZOOM_record_get_binary(rec, type)
340 RETVAL.data = (char*) ZOOM_record_get(rec, type, &RETVAL.len);
345 ZOOM_record_destroy(rec)
349 ZOOM_record_clone(srec)
356 ZOOM_query_destroy(s)
360 ZOOM_query_cql(s, str)
365 ZOOM_query_cql2rpn(s, str, conn)
371 ZOOM_query_ccl2rpn(s, query_str, config, errcode, errstr, errpos)
373 const char* query_str
385 ZOOM_query_prefix(s, str)
390 ZOOM_query_sortby(s, criteria)
392 const char * criteria
395 ZOOM_connection_scan(c, startterm)
397 const char* startterm
400 ZOOM_connection_scan1(c, startterm)
405 ZOOM_scanset_term(scan, pos, occ, len)
416 ZOOM_scanset_display_term(scan, pos, occ, len)
427 ZOOM_scanset_size(scan)
431 ZOOM_scanset_destroy(scan)
435 ZOOM_scanset_option_get(scan, key)
440 ZOOM_scanset_option_set(scan, key, val)
445 # We ignore the return value of ZOOM_options_set_callback(), since it
446 # is always just the address of the __ZOOM_option_callback() function.
447 # The information that we actually want -- the address of the Perl
448 # function in the callback_block -- is unavailable to us, as the
449 # underlying C function doesn't give the block back.
452 ZOOM_options_set_callback(opt, function, handle)
458 /* The tiny amount of memory allocated here is never
459 * released, as options_destroy() doesn't do anything
460 * to the callback information. Not a big deal.
461 * Also, I have no idea how to drive the Perl "mortal"
462 * reference-counting stuff, so I am just allocating
463 * copies which also never get released. Don't sue!
465 struct callback_block *block = (struct callback_block*)
466 xmalloc(sizeof *block);
467 block->function = function;
468 block->handle = handle;
469 SvREFCNT(block->function);
470 SvREFCNT(block->handle);
471 ZOOM_options_set_callback(opt, __ZOOM_option_callback,
476 ZOOM_options_create()
479 ZOOM_options_create_with_parent(parent)
483 ZOOM_options_create_with_parent2(parent1, parent2)
488 ZOOM_options_get(opt, name)
493 ZOOM_options_getl(opt, name, len)
498 RETVAL.data = (char*) ZOOM_options_getl(opt, name, &len);
505 ZOOM_options_set(opt, name, v)
511 ZOOM_options_setl(opt, name, value, len)
518 ZOOM_options_destroy(opt)
522 ZOOM_options_get_bool(opt, name, defa)
528 ZOOM_options_get_int(opt, name, defa)
534 ZOOM_options_set_int(opt, name, value)
540 ZOOM_connection_package(c, options)
545 ZOOM_package_destroy(p)
549 ZOOM_package_send(p, type)
554 ZOOM_package_option_get(p, key)
559 ZOOM_package_option_set(p, key, val)
564 # This has to be called with a single argument which is a _reference_
565 # to an array -- rather than directly with an array, which is of
566 # course identical to passing arbitrarily many arguments. This is
567 # because there doesn't seem to be a way to do varargs in an XS
578 /*printf("* in ZOOM_event(%p)\n", conns);*/
580 /*printf("* argument is not a reference\n");*/
583 realconns = SvRV(conns);
584 /*printf("* realconns = %p\n", realconns);*/
585 if (SvTYPE(realconns) != SVt_PVAV) {
586 /*printf("* reference is not to an array\n");*/
589 n = av_len((AV*) realconns);
590 n++; /* The av_len() return-value is zero-based */
592 /*printf("* No connections in referenced array\n");*/
596 /*printf("* n = %d\n", n);*/
597 if ((cs = (ZOOM_connection*) malloc(n * sizeof *cs)) == 0) {
598 /*printf("* Too many connections (%d)\n", (int) n);*/
602 for (i = 0; i < n; i++) {
603 SV **connp = av_fetch((AV*) realconns, i, (I32) 0);
605 /*printf("* %d of %d: connp = %p\n", (int) i, (int) n,connp);*/
608 /*printf("* conn = %p\n", conn);*/
610 * From here on, the tests and assertions seem to
611 * be ignored: if I pass in a reference to
612 * something other than a ZOOM_connection, or even
613 * if I pass a non-reference, the assertions still
614 * pass and everything seems to work until the
615 * segmentation fault bites.
617 assert(sv_derived_from(conn, "ZOOM_connection"));
618 /*printf("* passed assert(isa(ZOOM_connection))\n");*/
620 /*printf("* passed assert SvROK()\n");*/
621 sv = (SV*) SvRV(conn);
622 /*printf("* sv = %p\n", sv);*/
623 cs[i] = INT2PTR(ZOOM_connection, SvIV(sv));
624 /*printf("got cs[%d] of %d = %p\n", (int) i, (int) n, cs[i]);*/
626 RETVAL = ZOOM_event((int) n, cs);
632 ZOOM_connection_last_event(cs)
636 ZOOM_connection_is_idle(cs)
640 ZOOM_connection_peek_event(cs)
644 # ----------------------------------------------------------------------------
645 # What follows is the YAZ logging API. This is not strictly part of
646 # ZOOM, but it's so useful that it would be silly to omit.
649 yaz_log_mask_str(str)
653 yaz_log_module_level(name)
657 yaz_log_init(level, prefix, name)
663 yaz_log_init_file(fname)
667 yaz_log_init_level(level)
671 yaz_log_init_prefix(prefix)
675 yaz_log_time_format(fmt)
679 yaz_log_init_max_size(mx)
682 # <stdarg.h> interfaces are horrible to code for a Perl-C interface
683 # layer. Instead, we expect Perl applications to construct the
684 # message themselves, and pass it in as an opaque lump.
690 yaz_log(level, "%s", str);
692 # This is also not strictly part of ZOOM
694 yaz_version(version_str, sys_str)