Net-Z3950-ZOOM-1.26/0000755000175000017500000000000011403463020012127 5ustar mikemikeNet-Z3950-ZOOM-1.26/Makefile.PL0000644000175000017500000000463211403454406014116 0ustar mikemike# Use: perl Makefile.PL OPTIMIZE="-O0 -g -Wdeclaration-after-statement" # or: perl Makefile.PL PREFIX=/home/mike/universe use 5.008; use ExtUtils::MakeMaker; use strict; my $yazver = `yaz-config --version`; my $yazinc = `yaz-config --cflags threads`; my $yazlibs = `yaz-config --libs threads`; if (!$yazver || !$yazinc || !$yazlibs) { die qq[ ERROR: Unable to call script: yaz-config If you are using a YAZ installation from the Debian package "yaz", you will also need to install "libyaz-dev" in order to build this module. ]; } chomp($yazver); check_version($yazver, "2.1.50"); # For Windows use # $yazinc = '-Ic:\yaz\include'; # $yazlibs = 'c:\yaz\lib\yaz.lib'; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Net::Z3950::ZOOM', VERSION_FROM => 'lib/Net/Z3950/ZOOM.pm', # finds $VERSION PREREQ_PM => { "MARC::Record" => 1.38 }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Net/Z3950/ZOOM.pm', # retrieve abstract from module AUTHOR => 'Mike Taylor ') : ()), LIBS => [ $yazlibs ], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' # Insert -I. if you add *.h files later: INC => $yazinc, # e.g., '-I/usr/include/other' # Un-comment this if you add C files to link with later: # OBJECT => '$(O_FILES)', # link all the C files too # Use this to test for illegal code that GCC stupidly permits by default: # OPTIMIZE => "-Wdeclaration-after-statement -g -O0", EXE_FILES => [ 'samples/zoom/zselect', 'samples/zoom/zoomdump' ], ); sub check_version { my($got, $want) = @_; my($gmajor, $gminor, $gtrivial) = ($got =~ /(\d+)\.(\d+)\.(\d+)/); my($wmajor, $wminor, $wtrivial) = ($want =~ /(\d+)\.(\d+)\.(\d+)/); if (($gmajor < $wmajor) || ($gmajor == $wmajor && $gminor < $wminor) || ($gmajor == $wmajor && $gminor == $wminor && $gtrivial < $wtrivial)) { print <<__EOT__; *** ERROR! ZOOM-Perl requires at least version $want of YAZ, but you only have version $got. __EOT__ exit 1; } } sub MY::postamble { "debian: debian/output debian/output: dpkg-buildpackage -rfakeroot -d rm -rf debian/output mkdir debian/output mv ../libnet-z3950-zoom-perl* debian/output debclean: rm -rf debian/libnet-z3950-zoom-perl debian/output "; } Net-Z3950-ZOOM-1.26/README0000644000175000017500000000436711403454406013031 0ustar mikemikeThe Net::Z3950::ZOOM, ZOOM and Net::Z3950 modules ================================================= This distribution contains three Perl modules for the price of one. They all provide facilities for building information retrieval clients using the standard Z39.50 and SRW/U protocols, but do so using different APIs. - If you are new to this distribution, then you should use the ZOOM API, and ignore the others. It is the cleanest, most elegant and intuitive, and most closely follows the letter as well as the spirit of the Abstract ZOOM API as specified at http://zoom.z3950.org/api/ - If you have used the old Net::Z3950 module and have to maintain an application that calls that API, then you will want to use the Net::Z3950 classes provided in this distribution, which provide an API compatible with the old module's implemented on top of the new ZOOM code. - You should definitely not use the Net::Z3950::ZOOM API, which is not object-oriented, and instead provides the thinnest possible layer on top of the ZOOM-C functions in the YAZ toolkit. This API exists only in order to have ZOOM API built on top of it. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEBIAN PACKAGES To build Debian packages issue: dh-make-perl --build DEPENDENCIES This module requires these other modules and libraries: - The YAZ toolkit for Z39.50 and SRW/U communication. This is available as a package on several platform -- for example, Debian GNU/Linux supports "apt-get install yaz". For others, you will need to download and build the source-code, which is much more straightforward that you probably expect. You can get it from http://indexdata.com/yaz/ NOTE THAT THE ZOOM-Perl MODULE ABSOLUTELY REQUIRES RELEASE 2.0.11 OR BETTER OF THE YAZ TOOLKIT. You need version 2.1.17 or better if you want to run clever asynchronous programs that use the END event, which did not exist prior to that release. COPYRIGHT AND LICENCE Copyright (C) 2005-2007 by Index Data. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.4 or, at your option, any later version of Perl 5 you may have available. Net-Z3950-ZOOM-1.26/Changes0000644000175000017500000003446611403462442013446 0ustar mikemikeRevision history for Perl extension Net::Z3950::ZOOM. 1.26 Tue Jun 8 16:43:29 BST 2010 - Tweak the test-suite so that it works correctly on Fedora Core 12 (2.6.31.5-127.fc12.x86_64). For some reason, attempts to connect to a non-existent host can fail with ERROR_TIMEOUT and no addinfo, rather than ERROR_CONNECT and the hostname as addinfo; and the number of terms to request in a scan needs to be explicitly specified in an option. - Add "debclean" target to generated Makefile. - Remove extraneous and misleading old CVS IDs. 1.25 Fri Feb 19 15:04:26 GMT 2010 - Fix test-suite not to run the "packages" tests against test.indexdata.com, which has gone away, but against z3950.indexdata.com, like the other tests. A new server runs on a different port for these tests. - Rename zdump.pl to zoomdump, and add it to the set of programs installed. - Switch to git for version control. Not that it should make any difference to the Perl distribution. - Add semicolons to the commented-out sample configuration lines for Windows in Makefile.PL 1.24 Tue Jun 17 11:31:08 BST 2008 - When Net::Z3950::ZOOM::record_get() fetches an XML record because the requested OPAC record is empty, it now wraps it in an OPAC wrapper, making the difference invisible to application code. 1.23 Mon Jun 9 14:53:15 BST 2008 - Net::Z3950::ZOOM::record_get() now patches around the problem of naughty servers that refuse to return anything for an OPAC record when there is no non-bibliographic part, by falling back on requesting an XML record in such cases. 1.22 Tue May 27 14:00:12 BST 2008 - Fix Net::Z3950::ZOOM::record_get() to use a struct datachunk _when_ appropriate, e.g. for "render" not for "database" and "syntax". - Remove the unused $len reference parameter from record_get() and $record->get(): this is now used in the underlying C layer to make Perl strings of the right length, and is of no value higher up the stack. - Fix a bug in ZOOM::ResultSet::records(): requests including the last record in the set were incorrectly declined. - Better Debian packaging: use "make debian" to create new "debian/output" directory containing .deb package file, changes file, etc. - Clear up a few warnings in ZOOM.xs - Minor documentation improvements. 1.21 Mon Oct 29 12:07:25 GMT 2007 - In the "typemap" file's handling of opaquechar*, use STRLEN type for _unused_len in instead of unsigned: this prevents a (possibly serious) warning on some 64-bit architectures, although applications that do not use the option_binary() methods will be safe with the previous release. - Add explicit "#include " to ZOOM.xs in the hope of preventing undeclared-function warnings that some users have reported but which I have been unable to reproduce. 1.20 Fri Sep 21 17:51:55 BST 2007 - Add new sample program, samples/zoom/zoomscan.pl - samples/zoom/zoomtst1.pl now accepts arbitrary options at the end of the command-line, so that (for example) you can specify a non-USMARC record syntax. - Add new functions Net::Z3950::ZOOM::diag_srw_str() and ZOOM::diag_srw_str() to map SRW diagnostic codes into human-readable messages. - ZOOM::Exception() constructor uses diag_srw_str() to fill in the error message, if it is undefined, for SRW errors. - The render() method of ZOOM::Exception(), and therefore the overloaded stringifying operator, deals with exceptions that have no message(). - Corrected the scan parts of the test-suite that use CQL so that they explicitly perform client-side CQL compilation and send the resulting Type-1 query. Previously, these tests were (accidentally) requesting that CQL be sent as-is to the server, but this mistake was being masked by an error in older versions of ZOOM-C that compiled client-side anyway! 1.19 Mon Jul 9 14:09:31 BST 2007 - Add $conn->exception() method. - Set version number for Net::Z3950 to 0.99 -- less than the 1.0 version number that will be used when it successfully emulates the old Net::Z3950 module, but superseding the last release, 0.51, of that module. - Include samples/zoom/zdump.pl in distribution. - Add "irspy" namespace to samples/zoom/zselect 1.18 Mon Feb 26 14:57:48 GMT 2007 - When a connection is in asynchronous mode, failing operations (search, scan, etc.) no longer throw exceptions. This is because the event-loop in asychronous applications needs to check for errors anyway, in case the server has returned high-level diagnostics such as "unsupported use attribute". So this check within the event-loop is now the only place where error-checking need be done. - Add new public ZOOM::Connection() function, check(), which throws an exception if an error is pending (even if the connection is asynchronous). - New YAZ logging level, "zoom_check", notes when errors are detected and either left unreported (asynchronous connections) or thrown as exception (synchronous). 1.17 Thu Feb 22 20:38:45 GMT 2007 - Change Net::Z3950::ZOOM::event() to allocate its array of connection pointers dynamically, so there is no longer an arbitrary limit of 100. - New connection-level option "_check_debug" emits messages on standard error when checking a connection find an error that is about to result in throwing an exception. There is no reason for you ever to use this, though -- pretend you don't know about it. 1.16 Tue Jan 16 11:18:34 GMT 2007 - Require version 2.1.41 or better of YAZ, so that Init Response options are available using $conn->option("init_opt_sort") etc. - Include samples/zoom/zhello.pl to exercise these options. - Add ZOOM_connection_peek_event() and $conn->peek_event(). - Require YAZ version 2.1.45, which is the first to provide ZOOM_connection_peek_event(). 1.15 Fri Dec 1 14:17:49 GMT 2006 - ZOOM::Error::INIT is renamed to ZOOM::Error::ZINIT, since INIT is a reserved word in Perl. In version 1.14 and earlier, "require ZOOM" would fail, saying "Too late to run INIT block", and "use ZOOM" would result in ZOOM::Error::INIT having a value equal to its name (why?!) rather than, as intended, Net::Z3950::ZOOM::ERROR_INIT. - Belatedly added documentation for $rec->error() and $rec->exception(). 1.14 Tue Nov 28 17:33:07 GMT 2006 - Add $record->error() to return non-surrogate diagnostics, and $record->exception() to return the same information wrapped in a ZOOM::Exception object. - Requires YAZ 2.1.40, which provides ZOOM_record_error(). - $conn->error_x() now returns the error-code when called in scalar context, rather than the diagnostic set name. 1.13 Sat Nov 4 16:47:00 GMT 2006 - ZOOM::Connection::create() may now take either a single argument, which is a ZOOM::Options object, or any even number of argument (including zero), which are key => value pairs of options to set. - ZOOM::Connection::new(), having been refactored to use create(), can now also take a ZOOM::Options argument. - Documentation now includes information on specifying SRW, SRU-over-GET and SRU-over-POST connections. - ZOOM::ResultSet::record() throws a diagnostic if asked to retrieve records out of range for the result-set. - All tests against indexdata.com are now explicitly against z3950.indexdata.com, as the identity of the former name has recently changed. 1.12 (NEVER PUBLICLY RELEASED; these changes are included in 1.13) - Include the useful example program samples/zoom/zselect, which is installed as part of "make install". - Add ZOOM_connection_is_idle() and $conn->is_idle(). - Require YAZ version 2.1.35, which is the first to provide ZOOM_connection_is_idle(). - Fix bug in ZOOM::Connection class code that made the difficult to subclass -- when called as $class->SUPER::new(@_), the constructor blessed the new object into ZOOM::Connection rather than info the subclass. 1.11 Thu Aug 31 16:47:53 BST 2006 - Require YAZ version 2.1.17, which has important ZOOM-C bug-fixes. - Do not use "-Wdeclaration-after-statement" compiler option, since this supported only by GCC (and only recent versions). 1.10 Thu Jun 15 16:42:47 BST 2006 - No functional changes, but use Adam's modified API to ZOOM_query_ccl2rpn(). This incompatible change means that RELEASE 1.09 WILL NOT BUILD against any recent YAZ. 1.09 Tue Jun 13 17:44:43 2006 - Add new function Net::Z3950::ZOOM::query_ccl2rpn(), for client-side CCL compilation. - Add new ZOOM::Query::CCL2RPN class, encapsulating CCL compiler functionality as a Query subclass. This allows client-side CCL to be used for both search and scan. - Add two new error-codes, CCL_CONFIG and CCL_PARSE, returned by the client-side CCL facilities. - Supply a sample CCL profile file: samples/ccl/default.bib, copied from the same-named file distributed with YAZ. - The test-scripts t/12-query.t and t/22-query.t are extended to also test client-side CCL searching. - The test-scripts t/15-scan.t and t/25-scan.t are extended to also test client-side CCL scanning. - Documentation updated to describe use of CCL. - Add a nice, simple update client: samples/zoom/update.pl 1.08 Thu May 11 22:40:41 BST 2006 - Requires version 2.1.11 of YAZ, not 2.0.11. This is a bugfix: the old reliance on 2.0.11 was merely a typo. 1.07 Thu May 11 17:45:37 BST 2006 - Makefile.PL checks for at least version 2.1.11 of YAZ, and refuses to build if it's not present. Thanks to "gregor" (an otherwise anonymous CPAN tester) for notifying me of the previously poor reporting of failure when running against an earlier YAZ. - No changes to functionality or documentation. 1.06 Wed Apr 19 21:11:52 BST 2006 - Avoid mixed statement/declaration in ZOOM.xs. *sigh* Why the heck GCC allows this by default I will never understand. - Add (commented out) OPTIMIZE option to Makefile.PL, to turn on -Wdeclaration-after-statement, which makes mixed statement/declaration illegal. 1.05 Wed Apr 12 13:31:27 BST 2006 - Implementation of asynchronous events! The Net::Z3950::ZOOM interface provides this through the event, last_event() and event_str() functions. The ZOOM interface provides it through the ZOOM::event() and ZOOM:event_str() functions, and the ZOOM::Connection class's last_event() function. - New sample programs added illustrating both asynchronous interfaces: samples/net-z3950-zoom/zoomtst3.pl and samples/zoom/zoomtst3.pl respectively. Additional sample programs "async.pl" and "trivial-async.pl" for the ZOOM interface only, the latter being a "shortest possible broadcast search application". - Added documentation on writing asynchronous applications. - Added test-scripts "t/19-events.t" and "t/29-event.t" for events on an asynchronous connection. - Fix ZOOM::Connection::new so that options are handled in accordance with the documentation: applied _before_ the connection is forged, so that "async" and similar options can take effect. 1.04 Mon Apr 3 14:56:11 BST 2006 - The ZOOM-Perl layer now provides access to the underlying ZOOM-C's character-translation functionality, through new optional arguments to ZOOM::Record's render() and raw() methods, and a new underlying get() method. 1.03 Thu Mar 9 12:55:23 GMT 2006 - Allow additional key => value pairs as arguments to the ZOOM::Connectoion constructor; these are added as Connection options before the protocol connection is forged. 1.02 Thu Mar 9 11:36:55 GMT 2006 - Add interface to yaz_version(). - Emit big warning at startup time if YAZ version is less than 2.0.11 (which is what ZOOM-Perl 1.02 requires) unless the file /tmp/ignore-ZOOM-YAZ-version-mismatch exists. - Fix incorrect ZOOM-package URL in documentation. - Fix typo ("createdb" package) in documentation. - The ZOOM::Connection constructor may now be called with only a single argument (host-string) and does not require a dummy port-number argument. 1.01 Thu Dec 22 14:13:34 GMT 2005 - Place some CODE: chunks in "ZOOM.xs" inside curly brackets so that the declarations they begin with are at the start of the block. This avoid mixed code/declarations. (The "correct" solution is to use INIT: clauses in the XS file, but they don't seem to work: the code in them is slapped down right next to the CODE:, so declarations are not acceptable there either.) - Add new function Net::Z3950::ZOOM::connection_scan1(), which uses a query object to indicate the start-term. This opens the way for using CQL queries for scanning once the underlying ZOOM-C code supports this. - NOTE BACKWARDS-INCOMPATIBLE CHANGE: The ZOOM::Connection method scan() is renamed scan_pqf(), and a new scan() method is introduced which calls the underlying scan1() function. Thus the scan()/scan_pqf() dichotomy is consistent with that between search()/search_pqf(). - The tests t/15-scan.t and t/25-scan.t now also test for scanning by CQL query. To support these tests, a new files is added to the distribution, "samples/cql/pqf.properties" - Remove nonsensical clause about CQL sort-specifications from the documentation. - Add new function Net::Z3950::ZOOM::query_cql2rpn(), for client-side CQL compilation. - Add new ZOOM::Query::CQL2RPN class, encapsulating CQL compiler functionality as a Query subclass. - Add two new error-codes, CQL_PARSE and CQL_TRANSFORM, returned by the client-side CQL facilities. - The test-scripts t/12-query.t and t/22-query.t are extended to also test client-side CQL compilation. - Add all the yaz_log*() functions within the Net::Z3950::ZOOM namespace. - Add new ZOOM::Log class for logging, providing aliases for the functions in the Net::Z3950::ZOOM layer. - Add diagnostic set to rendering of Exception objects. - Documentation added for CQL compilation and logging. 1.00 Wed Dec 14 11:18:33 GMT 2005 - First distributed version. 0.01 Fri Oct 7 16:14:20 2005 - original version; created by h2xs 1.23 with options --name=Net::Z3950::ZOOM --compat-version=5.8.0 \ --omit-constant --skip-exporter --skip-ppport \ --autogen-xsubs yaz/zoom.h -lyaz -lxml2 -- To be done in future releases: - Complete, test and document "update.pl" - Create old-style Net::Z3950 compatibility layer. - Fix memory leaks in callback functions for option sets. - Fix limitation that option-set callback functions must be specified as strings containing package-qualified function names. Net-Z3950-ZOOM-1.26/typemap0000644000175000017500000000463111403454406013545 0ustar mikemikeZOOM_connection T_PTROBJ ZOOM_connection * T_PTROBJ ZOOM_options T_PTROBJ ZOOM_options_callback T_PTROBJ ZOOM_package T_PTROBJ ZOOM_query T_PTROBJ ZOOM_record T_PTROBJ ZOOM_record * T_PTROBJ ZOOM_resultset T_PTROBJ ZOOM_scanset T_PTROBJ __compar_fn_t T_PTROBJ __const char * T_PTROBJ __const void * T_PTROBJ __const wchar_t * T_PTROBJ __extension__ extern lldiv_t T_PTROBJ __extension__ extern long long int T_PTROBJ __extension__ extern unsigned long long int T_PTROBJ __locale_t T_PTROBJ char * __const * T_PTROBJ const __sigset_t * T_PTROBJ # The next line was originally autogenerated by h2xs, which gave the # type of "const char *" as T_PTROBJ -- a pointer to an opaque object. # This prevented the return value of ZOOM_record_get() from being # translated into a Perl string. Instead, I am using T_PV, which # works properly. This also has the pleasant side-effect that I no # longer have to discard the "const" qualfiers from the arguments to # the functions in the .xs file. const char * T_PV opaquechar * T_OPAQUECHAR const char ** T_PTROBJ const struct timespec * T_PTROBJ div_t T_OPAQUE_STRUCT double * T_PTROBJ fd_set * T_PTROBJ int * T_PTROBJ int32_t * T_PTROBJ ldiv_t T_OPAQUE_STRUCT long double T_NV long int T_PTROBJ long int * T_PTROBJ long long int T_PTROBJ struct drand48_data * T_PTROBJ struct random_data * T_PTROBJ struct timeval * T_PTROBJ unsigned int * T_PTROBJ unsigned long int T_PTROBJ unsigned short int T_PTROBJ unsigned short int * T_PTROBJ void ( * __func ) ( int __status, void * __arg ) T_PTROBJ void ( * __func ) ( void ) T_PTROBJ void ** T_PTROBJ struct datachunk T_DATACHUNK # --------------------------------------------------------------------------- INPUT T_OPAQUE_STRUCT if (sv_derived_from($arg, \"${ntype}\")) { STRLEN len; char *s = SvPV((SV*)SvRV($arg), len); if (len != sizeof($var)) croak(\"Size %d of packed data != expected %d\", len, sizeof($var)); $var = *($type *)s; } else croak(\"$var is not of type ${ntype}\") T_OPAQUECHAR { STRLEN _unused_len; $var = ($type) SvPV($arg, _unused_len); } # --------------------------------------------------------------------------- OUTPUT T_OPAQUE_STRUCT sv_setref_pvn($arg, \"${ntype}\", (char *)&$var, sizeof($var)); T_DATACHUNK sv_setpvn($arg, $var.data, $var.len); Net-Z3950-ZOOM-1.26/META.yml0000644000175000017500000000067611403463020013411 0ustar mikemike--- #YAML:1.0 name: Net-Z3950-ZOOM version: 1.26 abstract: Perl extension for invoking the ZOOM-C API. license: ~ author: - Mike Taylor generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: MARC::Record: 1.38 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 Net-Z3950-ZOOM-1.26/t/0000755000175000017500000000000011403463020012372 5ustar mikemikeNet-Z3950-ZOOM-1.26/t/15-scan.t0000644000175000017500000001147111403454406013742 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 15-scan.t' use strict; use warnings; use Test::More tests => 87; BEGIN { use_ok('Net::Z3950::ZOOM') }; my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $host = "z3950.indexdata.com/gils"; my $conn = Net::Z3950::ZOOM::connection_new($host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "connection to '$host'"); Net::Z3950::ZOOM::connection_option_set($conn, number => 10); my($ss, $n) = scan($conn, 0, "w", 10); my @terms = (); my($occ, $len) = (0, 0); my $previous = ""; # Sorts before all legitimate terms foreach my $i (1 .. $n) { my $term = Net::Z3950::ZOOM::scanset_term($ss, $i-1, $occ, $len); ok(defined $term && $len eq length($term), "got term $i of $n: '$term' ($occ occurences)"); ok($term ge $previous, "term '$term' ge previous '$previous'"); $previous = $term; push @terms, $term; my $disp = Net::Z3950::ZOOM::scanset_display_term($ss, $i-1, $occ, $len); ok(defined $disp && $len eq length($disp), "display term $i of $n: '$disp' ($occ occurences)"); ok($disp eq $term, "display term $i identical to term"); } Net::Z3950::ZOOM::scanset_destroy($ss); ok(1, "destroyed scanset"); ok(1, "(can't re-destroy scanset)"); # Only meaningful in OO API. # Now re-scan, but only for words that occur in the title # This time, use a Query object for the start-term my $q = Net::Z3950::ZOOM::query_create(); Net::Z3950::ZOOM::query_prefix($q, '@attr 1=4 w'); ($ss, $n) = scan($conn, 1, $q, 6); $previous = ""; # Sorts before all legitimate terms foreach my $i (1 .. $n) { my $term = Net::Z3950::ZOOM::scanset_term($ss, $i-1, $occ, $len); ok(defined $term && $len eq length($term), "got title term $i of $n: '$term' ($occ occurences)"); ok($term ge $previous, "title term '$term' ge previous '$previous'"); $previous = $term; ok((grep { $term eq $_ } @terms), "title term was in term list"); } Net::Z3950::ZOOM::scanset_destroy($ss); ok(1, "destroyed second scanset"); # Now re-do the same scan, but limiting the results to four terms at a # time. This time, use a CQL query Net::Z3950::ZOOM::connection_option_set($conn, number => 4); Net::Z3950::ZOOM::connection_option_set($conn, cqlfile => "samples/cql/pqf.properties"); $q = Net::Z3950::ZOOM::query_create(); Net::Z3950::ZOOM::query_cql2rpn($q, 'title=w', $conn); ($ss, $n) = scan($conn, 1, $q, 4); # Get last term and use it as seed for next scan my $term = Net::Z3950::ZOOM::scanset_term($ss, $n-1, $occ, $len); ok(Net::Z3950::ZOOM::scanset_option_get($ss, "position") == 1, "seed-term is start of returned list"); ok(defined $term && $len eq length($term), "got last title term '$term' to use as seed"); Net::Z3950::ZOOM::scanset_destroy($ss); ok(1, "destroyed third scanset"); # Now using CCL $q = Net::Z3950::ZOOM::query_create(); my($ccl_errcode, $ccl_errstr, $ccl_errpos) = (0, "", 0); Net::Z3950::ZOOM::query_ccl2rpn($q, 'ti=w', "ti u=4 s=pw", $ccl_errcode, $ccl_errstr, $ccl_errpos); ($ss, $n) = scan($conn, 1, $q, 4); # Get last term and use it as seed for next scan $term = Net::Z3950::ZOOM::scanset_term($ss, $n-1, $occ, $len); ok(Net::Z3950::ZOOM::scanset_option_get($ss, "position") == 1, "seed-term is start of returned list"); ok(defined $term && $len eq length($term), "got last title term '$term' to use as seed"); Net::Z3950::ZOOM::scanset_destroy($ss); ok(1, "destroyed fourth scanset"); # We want the seed-term to be in "position zero", i.e. just before the start Net::Z3950::ZOOM::connection_option_set($conn, position => 0); ($ss, $n) = scan($conn, 0, "\@attr 1=4 $term", 2); ok(Net::Z3950::ZOOM::scanset_option_get($ss, "position") == 0, "seed-term before start of returned list"); # Silly test of option setting and getting Net::Z3950::ZOOM::scanset_option_set($ss, position => "fruit"); ok(Net::Z3950::ZOOM::scanset_option_get($ss, "position") eq "fruit", "option setting/getting works"); Net::Z3950::ZOOM::scanset_destroy($ss); ok(1, "destroyed fifth scanset"); # There is no obvious use for scanset_option_set(), and little to be # done with scanset_option_get(); and I can't find a server that # returns display terms different from its terms. sub scan { my($conn, $startterm_is_query, $startterm, $nexpected) = @_; my $ss; if ($startterm_is_query) { $ss = Net::Z3950::ZOOM::connection_scan1($conn, $startterm); } else { $ss = Net::Z3950::ZOOM::connection_scan($conn, $startterm); } $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "scan for '$startterm'"); my $n = Net::Z3950::ZOOM::scanset_size($ss); ok(defined $n, "got size"); ok($n == $nexpected, "got $n terms '$startterm' (expected $nexpected)"); return ($ss, $n); } Net-Z3950-ZOOM-1.26/t/1-Net-Z3950-ZOOM.t0000644000175000017500000001016211403454406014765 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1-Net-Z3950-ZOOM.t' use strict; use warnings; use Test::More tests => 23; BEGIN { use_ok('Net::Z3950::ZOOM') }; my $msg = Net::Z3950::ZOOM::diag_str(Net::Z3950::ZOOM::ERROR_INVALID_QUERY); ok($msg eq "Invalid query", "diagnostic string lookup works"); $msg = Net::Z3950::ZOOM::diag_srw_str(27); ok($msg eq "Empty term unsupported", "SRW diagnostic string lookup works"); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $host = "no.such.host"; my $conn = Net::Z3950::ZOOM::connection_new($host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); # For some reason, Red Hat signals this as a TIMEOUT rather than a CONNECT ok(($errcode == Net::Z3950::ZOOM::ERROR_CONNECT && $addinfo eq $host) || ($errcode == Net::Z3950::ZOOM::ERROR_TIMEOUT && $addinfo eq ""), "connection to non-existent host '$host' fails: errcode=$errcode, addinfo=$addinfo"); $host = "z3950.indexdata.com/gils"; $conn = Net::Z3950::ZOOM::connection_new($host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "connection to '$host'"); Net::Z3950::ZOOM::connection_destroy($conn); ok(1, "destroyed connection"); my $options = Net::Z3950::ZOOM::options_create(); $conn = Net::Z3950::ZOOM::connection_create($options); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "unconnected connection object created"); Net::Z3950::ZOOM::connection_connect($conn, $host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "delayed connection to '$host'"); my $val1 = "foo"; my $val2 = "$val1\0bar"; Net::Z3950::ZOOM::connection_option_set($conn, xyz => $val2); my $val = Net::Z3950::ZOOM::connection_option_get($conn, "xyz"); ok($val eq $val1, "option_set() treats value as NUL-terminated"); Net::Z3950::ZOOM::connection_option_setl($conn, xyz => $val2, length($val2)); my $vallen = 0; $val = Net::Z3950::ZOOM::connection_option_getl($conn, "xyz", $vallen); ok($val eq $val2, "option_setl() treats value as opaque chunk, val='$val' len=$vallen"); my $syntax = "usmarc"; Net::Z3950::ZOOM::connection_option_set($conn, preferredRecordSyntax => $syntax); $val = Net::Z3950::ZOOM::connection_option_get($conn, "preferredRecordSyntax"); ok($val eq $syntax, "preferred record syntax set to '$val'"); my $query = '@attr @and 1=4 minerals'; my $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, $query); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == Net::Z3950::ZOOM::ERROR_INVALID_QUERY, "search for invalid query '$query' fails"); my($xcode, $xmsg, $xinfo, $xset) = (undef, "dummy", "dummy", "dummy"); $xcode = Net::Z3950::ZOOM::connection_error_x($conn, $xmsg, $xinfo, $xset); ok($xcode == $errcode && $xmsg eq $errmsg && $xinfo eq $addinfo && $xset eq "ZOOM", "error_x() consistent with error()"); ok(Net::Z3950::ZOOM::connection_errcode($conn) == $errcode, "errcode() consistent with error()"); ok(Net::Z3950::ZOOM::connection_errmsg($conn) eq $errmsg, "errmsg() consistent with error()"); ok(Net::Z3950::ZOOM::connection_addinfo($conn) eq $addinfo, "addinfo() consistent with error()"); ok(Net::Z3950::ZOOM::connection_diagset($conn) eq $xset, "diagset() consistent with error()"); $query = '@attr 1=4 minerals'; $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, $query); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "search for '$query'"); my $n = Net::Z3950::ZOOM::resultset_size($rs); ok($n == 1, "found 1 record as expected"); my $rec = Net::Z3950::ZOOM::resultset_record($rs, 0); my $data = Net::Z3950::ZOOM::record_get($rec, "render"); ok($data =~ /^245 +\$a ISOTOPIC DATES OF ROCKS AND MINERALS$/m, "rendered record has expected title"); my $raw = Net::Z3950::ZOOM::record_get($rec, "raw"); ok($raw =~ /^00966n/, "raw record contains expected header"); Net::Z3950::ZOOM::resultset_destroy($rs); ok(1, "destroyed result-set"); Net::Z3950::ZOOM::connection_destroy($conn); ok(1, "destroyed connection"); Net-Z3950-ZOOM-1.26/t/14-sorting.t0000644000175000017500000000465611403454406014511 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 14-sorting.t' use strict; use warnings; use Test::More tests => 29; use MARC::Record; BEGIN { use_ok('Net::Z3950::ZOOM') }; my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $host = "z3950.indexdata.com/gils"; my $conn = Net::Z3950::ZOOM::connection_new($host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "connection to '$host'"); my $qstr = '@attr 1=4 map'; my $query = Net::Z3950::ZOOM::query_create(); Net::Z3950::ZOOM::query_prefix($query, $qstr); my $res = Net::Z3950::ZOOM::query_sortby($query, "1=4 "usmarc"); my $previous = ""; # Sorts before all legitimate titles foreach my $i (1 .. $n) { my $rec = Net::Z3950::ZOOM::resultset_record($rs, $i-1); ok(defined $rec, "got record $i of $n"); my $raw = Net::Z3950::ZOOM::record_get($rec, "raw"); my $marc = new_from_usmarc MARC::Record($raw); my $title = $marc->title(); ok($title ge $previous, "title '$title' ge previous '$previous'"); $previous = $title; } # Now reverse the order of sorting. We never use resultset_sort(), # which is identical to sort1() except that it returns nothing. my $status = Net::Z3950::ZOOM::resultset_sort1($rs, "yaz", "1=4>i"); ok($status < 0, "malformed sort criterion rejected"); $status = Net::Z3950::ZOOM::resultset_sort1($rs, "yaz", "1=4 >i"); ok($status == 0, "sort criterion accepted"); $previous = "z"; # Sorts after all legitimate titles foreach my $i (1 .. $n) { my $rec = Net::Z3950::ZOOM::resultset_record($rs, $i-1); ok(defined $rec, "got record $i of $n"); my $raw = Net::Z3950::ZOOM::record_get($rec, "raw"); my $marc = new_from_usmarc MARC::Record($raw); my $title = $marc->title(); ok($title le $previous, "title '$title' le previous '$previous'"); $previous = $title; } Net::Z3950::ZOOM::resultset_destroy($rs); ok(1, "destroyed result-set"); Net::Z3950::ZOOM::connection_destroy($conn); ok(1, "destroyed connection"); Net-Z3950-ZOOM-1.26/t/10-options.t0000644000175000017500000001124011403454406014476 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 10-options.t' use strict; use warnings; use Test::More tests => 51; BEGIN { use_ok('Net::Z3950::ZOOM') }; my $val1 = "foo"; my $val2 = "$val1\0bar"; my $o1 = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set($o1, surname => "Taylor"); Net::Z3950::ZOOM::options_set($o1, firstname => "Mike"); ok(Net::Z3950::ZOOM::options_get($o1, "surname") eq "Taylor", "get 1"); ok(Net::Z3950::ZOOM::options_get($o1, "firstname") eq "Mike", "get 2"); my ($len, $val) = (29168); Net::Z3950::ZOOM::options_set($o1, xyz => $val2); $val = Net::Z3950::ZOOM::options_getl($o1, "xyz", $len); ok($val eq $val1, "set/getl treats values as NUL-terminated, val='$val' len=$len"); Net::Z3950::ZOOM::options_setl($o1, xyz => $val2, length($val2)); $val = Net::Z3950::ZOOM::options_get($o1, "xyz"); ok($val eq $val1, "setl/get treats values as NUL-terminated, val='$val'"); Net::Z3950::ZOOM::options_setl($o1, xyz => $val2, length($val2)); $val = Net::Z3950::ZOOM::options_getl($o1, "xyz", $len); ok($val eq $val2, "setl/getl treats values as opaque, val='$val' len=$len"); my $o2 = Net::Z3950::ZOOM::options_create_with_parent($o1); ok(Net::Z3950::ZOOM::options_get($o2, "surname") eq "Taylor", "get via parent 1"); ok(Net::Z3950::ZOOM::options_get($o2, "firstname") eq "Mike", "get via parent 2"); Net::Z3950::ZOOM::options_set($o1, surname => "Parrish"); ok(Net::Z3950::ZOOM::options_get($o2, "surname") eq "Parrish", "get via parent after replacement"); Net::Z3950::ZOOM::options_set($o2, surname => "Taylor"); ok(Net::Z3950::ZOOM::options_get($o2, "surname") eq "Taylor", "get via parent after overwrite"); ok(Net::Z3950::ZOOM::options_get($o1, "surname") eq "Parrish", "get from parent after child overwrite"); my $o3 = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set($o3, firstname => "Fiona"); my $o4 = Net::Z3950::ZOOM::options_create_with_parent2($o3, $o2); $val = Net::Z3950::ZOOM::options_get($o4, "firstname"); ok($val eq "Fiona", "get via first parent overrides second '$val'"); ok(Net::Z3950::ZOOM::options_get($o4, "surname") eq "Taylor", "get via first parent"); Net::Z3950::ZOOM::options_set($o1, initial => "P"); ok(Net::Z3950::ZOOM::options_get($o4, "initial") eq "P", "get via grandparent"); Net::Z3950::ZOOM::options_destroy($o1); ok(1, "grandparent destroyed"); $val = Net::Z3950::ZOOM::options_get($o4, "initial"); ok($val eq "P", "referenced object survived destruction"); Net::Z3950::ZOOM::options_destroy($o4); ok(1, "grandchild destroyed"); Net::Z3950::ZOOM::options_destroy($o3); ok(1, "first parent destroyed"); Net::Z3950::ZOOM::options_destroy($o2); ok(1, "second parent destroyed"); $o1 = Net::Z3950::ZOOM::options_create(); # Strange but true: only "T" and "1" are considered true. check_bool($o1, y => 0); check_bool($o1, Y => 0); check_bool($o1, t => 0); check_bool($o1, T => 1); check_bool($o1, n => 0); check_bool($o1, N => 0); check_bool($o1, 0 => 0); check_bool($o1, 1 => 1); check_bool($o1, 2 => 0); check_bool($o1, 3 => 0); check_bool($o1, yes => 0); check_bool($o1, YES => 0); check_bool($o1, true => 0); check_bool($o1, TRUE => 0); ok(Net::Z3950::ZOOM::options_get_bool($o1, "undefined", 1), "get_bool() defaulted to true"); ok(!Net::Z3950::ZOOM::options_get_bool($o1, "undefined", 0), "get_bool() defaulted to false"); sub check_bool { my($o, $val, $truep) = @_; Net::Z3950::ZOOM::options_set($o, x => $val); ok(Net::Z3950::ZOOM::options_get_bool($o, "x", 1) eq $truep, "get_bool() considers $val to be " . ($truep ? "true" : "false")); } check_int($o1, 0 => 0); check_int($o1, 1 => 1); check_int($o1, 2 => 2); check_int($o1, 3 => 3); check_int($o1, -17 => -17); check_int($o1, "012" => 12); check_int($o1, "0000003" => 3); check_int($o1, " 3" => 3); check_int($o1, " 34" => 34); check_int($o1, " 3 4" => 3); check_int($o1, " 3,456" => 3); ok(Net::Z3950::ZOOM::options_get_int($o1, "undefined", 42) == 42, "get_int() defaulted to 42"); sub check_int { my($o, $val, $expected) = @_; Net::Z3950::ZOOM::options_set($o, x => $val); my $nval = Net::Z3950::ZOOM::options_get_int($o, "x", 1); ok($nval == $expected, "get_int() considers $val to be $nval, expected $expected"); } check_set_int($o1, 0 => 0); check_set_int($o1, 3 => 3); check_set_int($o1, -17 => -17); check_set_int($o1, " 34" => 34); sub check_set_int { my($o, $val, $expected) = @_; Net::Z3950::ZOOM::options_set_int($o, x => $val); my $nval = Net::Z3950::ZOOM::options_get_int($o, "x", 1); ok($nval == $expected, "get_int() considers $val to be $nval, expected $expected"); } Net-Z3950-ZOOM-1.26/t/21-option-callback.t0000644000175000017500000000357511403454406016063 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 21-option-calback.t' use strict; use warnings; use Test::More tests => 19; BEGIN { use_ok('ZOOM') }; # This callback function provides values only options whose names # begin with consonants, in which case the value is the option name # concatenated with a hyphen and the value of the user-data that was # lodged along with the callback. # sub f_option { my($udata, $name) = @_; return undef if $name =~ /^[aeiou]/; return "$name-$udata"; } my $o1 = new ZOOM::Options(); $o1->set_callback("main::f_option", "xyz"); $o1->option(isisaurus => "was titanosaurus"); check($o1, "apatosaurus", undef); check($o1, "brachiosaurus", "brachiosaurus-xyz"); check($o1, "camarasaurus", "camarasaurus-xyz"); check($o1, "diplodocus", "diplodocus-xyz"); check($o1, "euhelopus", undef); check($o1, "futalognkosaurus", "futalognkosaurus-xyz"); check($o1, "gigantosaurus", "gigantosaurus-xyz"); check($o1, "haplocanthosaurus", "haplocanthosaurus-xyz"); check($o1, "isisaurus", "was titanosaurus"); check($o1, "janenschia", "janenschia-xyz"); my $o2 = new ZOOM::Options(); $o2->set_callback("main::f_option", "abc"); check($o2, "apatosaurus", undef); check($o2, "brachiosaurus", "brachiosaurus-abc"); check($o2, "kxxxxxxxxxxxxx", "kxxxxxxxxxxxxx-abc"); check($o2, "limaysaurus", "limaysaurus-abc"); check($o2, "mamenchisaurus", "mamenchisaurus-abc"); check($o2, "nurosaurus", "nurosaurus-abc"); check($o2, "omeisaurus", undef); check($o2, "patagosaurus", "patagosaurus-abc"); sub check { my($opts, $key, $expected) = @_; my $val = $opts->option($key); #print "$opts($key) ", (defined $val ? "= '$val'" : "undefined"), "\n"; if (defined $expected) { ok ($val eq $expected, "value for '$key' is '$val'"); } else { ok (!defined $val, "no value for '$key'"); } } Net-Z3950-ZOOM-1.26/t/29-events.t0000644000175000017500000000410011403454406014316 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 19-events.t' use strict; use warnings; use Test::More tests => 23; BEGIN { use_ok('ZOOM') }; ok(ZOOM::event_str(ZOOM::Event::CONNECT) eq "connect", "connect event properly translated"); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $host = "z3950.indexdata.com/gils"; my $conn = create ZOOM::Connection(async => 1); eval { $conn->connect($host) }; ok(!$@, "connection to '$host'"); ok(1, "non-reference argument rejected"); ok(1, "non-array reference argument rejected"); my $val = ZOOM::event([]); ok($val == -3, "empty array reference argument rejected"); ok(1, "huge array reference argument rejected"); # See comments in 19-event.t assert_event_stream($conn, ZOOM::Event::CONNECT, ZOOM::Event::SEND_APDU, ZOOM::Event::SEND_DATA, ZOOM::Event::RECV_DATA, ZOOM::Event::RECV_APDU, ZOOM::Event::ZEND, 0); $conn->option(count => 1); my $rs; eval { $rs = $conn->search_pqf("mineral") }; ok(!$@, "search for 'mineral'"); assert_event_stream($conn, ZOOM::Event::SEND_APDU, ZOOM::Event::SEND_DATA, -(ZOOM::Event::RECV_DATA), ZOOM::Event::RECV_APDU, ZOOM::Event::RECV_SEARCH, ZOOM::Event::RECV_RECORD, ZOOM::Event::ZEND, 0); # See comments in 19-event.t sub assert_event_stream { my($conn, @expected) = @_; my $previousExpected = -1; my $expected = shift @expected; while (defined $expected) { my $val = ZOOM::event([$conn]); if ($expected == 0) { ok($val == 0, "no events left"); $expected = shift @expected; next; } die "impossible" if $val != 1; my $ev = $conn->last_event(); next if $previousExpected > 0 && $ev == $previousExpected; if ($expected < 0) { $expected = -$expected; $previousExpected = $expected; } ok($ev == $expected, ("event is $ev (" . ZOOM::event_str($ev) . "), expected $expected (" . ZOOM::event_str($expected) . ")")); $expected = shift @expected; } } Net-Z3950-ZOOM-1.26/t/17-logging.t0000644000175000017500000000270311403454406014444 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 17-logging.t' use strict; use warnings; use Test::More tests => 11; BEGIN { use_ok('Net::Z3950::ZOOM') }; check_level("none", 0); check_level("none,debug", 2); check_level("none,warn", 4); check_level("none,warn,debug", 6); check_level("none,zoom", 8192); check_level("none,-warn", 0); check_level("", 2077); check_level("-warn", 2073); check_level("zoom", 10269); check_level("none,zoom,fruit", 24576); sub check_level { my($str, $expect) = @_; my $level = Net::Z3950::ZOOM::yaz_log_mask_str($str); ok($level == $expect, "log-level for '$str' ($level, expected $expect)"); } # All the YAZ-logging functions other than yaz_log_mask_str() have # side-effects, which makes them painful to write tests for. At the # moment, I think we have better ways to spend the time, so these # functions remain untested: # int yaz_log_module_level(const char *name); # void yaz_log_init(int level, const char *prefix, const char *name); # void yaz_log_init_file(const char *fname); # void yaz_log_init_level(int level); # void yaz_log_init_prefix(const char *prefix); # void yaz_log_time_format(const char *fmt); # void yaz_log_init_max_size(int mx); # void yaz_log(int level, const char *str); # But if anyone feels strongly enough about this to want to fund the # creation of a rigorous YAZ-logging test suite, please get in touch # :-) Net-Z3950-ZOOM-1.26/t/18-charset.t0000644000175000017500000000260211403454406014446 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 18-charset.t' use strict; use warnings; use Test::More tests => 9; BEGIN { use_ok('Net::Z3950::ZOOM') }; my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $host = "z3950.loc.gov:7090/voyager"; my $conn = Net::Z3950::ZOOM::connection_new($host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "connection to '$host'"); Net::Z3950::ZOOM::connection_option_set($conn, preferredRecordSyntax => "usmarc"); my $qstr = '@attr 1=7 3879093520'; my $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, $qstr); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "search for '$qstr'"); my $n = Net::Z3950::ZOOM::resultset_size($rs); ok($n == 1, "found $n records (expected 1)"); my $rec = Net::Z3950::ZOOM::resultset_record($rs, 0); ok(defined $rec, "got first record"); my $xml = Net::Z3950::ZOOM::record_get($rec, "xml"); ok(defined $xml, "got XML"); ok($xml =~ m(aus der .* f\350ur), "got MARC pre-accented composed characters"); $xml = Net::Z3950::ZOOM::record_get($rec, "xml;charset=marc-8,utf-8"); ok(defined $xml, "got XML in Unicode"); ok($xml =~ m(aus der .* für), "got Unicode post-accented composed characters"); Net-Z3950-ZOOM-1.26/t/28-charset.t0000644000175000017500000000177111403454406014455 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 28-charset.t' use strict; use warnings; use Test::More tests => 9; BEGIN { use_ok('ZOOM') }; my $host = "z3950.loc.gov:7090/voyager"; my $conn; eval { $conn = new ZOOM::Connection($host) }; ok(!$@, "connection to '$host'"); $conn->option(preferredRecordSyntax => 'usmarc'); my $qstr = '@attr 1=7 3879093520'; my $rs; eval { $rs = $conn->search_pqf($qstr) }; ok(!$@, "search for '$qstr'"); my $n = $rs->size(); ok($n == 1, "found $n records (expected 1)"); my $rec = $rs->record(0); ok(defined $rec, "got first record"); my $xml = $rec->get('xml'); ok(defined $xml, "got XML"); ok($xml =~ m(aus der .* f\350ur), "got MARC pre-accented composed characters"); $xml = $rec->get('xml', 'charset=marc-8,utf-8'); ok(defined $xml, "got XML in Unicode"); ok($xml =~ m(aus der .* für), "got Unicode post-accented composed characters"); Net-Z3950-ZOOM-1.26/t/13-resultset.t0000644000175000017500000001006611403454406015045 0ustar mikemike# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 13-resultset.t' use strict; use warnings; use Test::More tests => 24; BEGIN { use_ok('Net::Z3950::ZOOM') }; my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $host = "z3950.indexdata.com/gils"; my $conn = Net::Z3950::ZOOM::connection_new($host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "connection to '$host'"); my $query = '@attr 1=4 mineral'; my $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, $query); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "search for '$query'"); ok(Net::Z3950::ZOOM::resultset_size($rs) == 2, "found 2 records"); my $syntax = "canmarc"; Net::Z3950::ZOOM::resultset_option_set($rs, preferredRecordSyntax => $syntax); my $val = Net::Z3950::ZOOM::resultset_option_get($rs, "preferredRecordSyntax"); ok($val eq $syntax, "preferred record syntax set to '$val'"); my $rec = Net::Z3950::ZOOM::resultset_record($rs, 0); my $diagset = ""; $errcode = Net::Z3950::ZOOM::record_error($rec, $errmsg, $addinfo, $diagset); ok($errcode == 238, "can't fetch CANMARC ($errmsg)"); Net::Z3950::ZOOM::resultset_option_set($rs, preferredRecordSyntax => "usmarc"); $rec = Net::Z3950::ZOOM::resultset_record($rs, 0); my $data1 = Net::Z3950::ZOOM::record_get($rec, "render"); Net::Z3950::ZOOM::resultset_option_set($rs, elementSetName => "b"); my $data2 = Net::Z3950::ZOOM::record_get($rec, "render"); ok($data2 eq $data1, "record doesn't know about RS options"); # Now re-fetch record from result-set with new option $rec = Net::Z3950::ZOOM::resultset_record($rs, 0); $data2 = Net::Z3950::ZOOM::record_get($rec, "render"); ok(length($data2) < length($data1), "re-fetched record is brief, old was full"); Net::Z3950::ZOOM::resultset_option_set($rs, preferredRecordSyntax => "xml"); $rec = Net::Z3950::ZOOM::resultset_record($rs, 0); my $cloned = Net::Z3950::ZOOM::record_clone($rec); ok(defined $cloned, "cloned record"); $data2 = Net::Z3950::ZOOM::record_get($rec, "render"); ok($data2 =~ //i, "option for XML syntax is honoured"); # Now we test ZOOM_resultset_record_immediate(), which should only # work for records that have already been placed in the cache, and # ZOOM_resultset_records() which populates the cache, and # ZOOM_resultset_cache_reset(), which presumably empties it. # $rec = Net::Z3950::ZOOM::resultset_record_immediate($rs, 0); ok(defined $rec, "prefetched record obtained with _immediate()"); my $data3 = Net::Z3950::ZOOM::record_get($rec, "render"); ok($data3 eq $data2, "_immediate record renders as expected"); $rec = Net::Z3950::ZOOM::resultset_record_immediate($rs, 1); ok(!defined $rec, "non-prefetched record obtained with _immediate()"); Net::Z3950::ZOOM::resultset_cache_reset($rs); $rec = Net::Z3950::ZOOM::resultset_record_immediate($rs, 0); ok(!defined $rec, "_immediate(0) fails after cache reset"); # Fill both cache slots, but with no record array my $tmp = Net::Z3950::ZOOM::resultset_records($rs, 0, 2, 0); ok(!defined $tmp, "resultset_records() returns undef as expected"); $rec = Net::Z3950::ZOOM::resultset_record_immediate($rs, 0); ok(defined $rec, "_immediate(0) ok after resultset_records()"); # Fetch all records at once using records() $tmp = Net::Z3950::ZOOM::resultset_records($rs, 0, 2, 1); ok(@$tmp == 2, "resultset_records() returned two records"); $data3 = Net::Z3950::ZOOM::record_get($tmp->[0], "render"); ok($data3 eq $data2, "record returned from resultset_records() renders as expected"); $rec = Net::Z3950::ZOOM::resultset_record_immediate($rs, 1); ok(defined $rec, "_immediate(1) ok after resultset_records()"); Net::Z3950::ZOOM::resultset_destroy($rs); ok(1, "destroyed result-set"); Net::Z3950::ZOOM::connection_destroy($conn); ok(1, "destroyed connection"); $data3 = Net::Z3950::ZOOM::record_get($cloned, "render"); ok(1, "rendered cloned record after its result-set was destroyed"); ok($data3 eq $data2, "render of clone as expected"); Net::Z3950::ZOOM::record_destroy($cloned); ok(1, "destroyed cloned record"); ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/27-logging.t������������������������������������������������������������������0000644�0001750�0001750�00000001376�11403454406�014452� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 27-logging.t' use strict; use warnings; use Test::More tests => 11; BEGIN { use_ok('ZOOM') }; check_level("none", 0); check_level("none,debug", 2); check_level("none,warn", 4); check_level("none,warn,debug", 6); check_level("none,zoom", 16384); check_level("none,-warn", 0); check_level("", 2077); check_level("-warn", 2073); check_level("zoom", 18461); check_level("none,zoom,fruit", 49152); sub check_level { my($str, $expect) = @_; my $level = ZOOM::Log::mask_str($str); ok($level == $expect, "log-level for '$str' ($level, expected $expect)"); } # See comment in "17-logging.t" on incompleteness of test-suite. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/25-scan.t���������������������������������������������������������������������0000644�0001750�0001750�00000007000�11403454406�013734� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 25-scan.t' use strict; use warnings; use Test::More tests => 87; BEGIN { use_ok('ZOOM') }; my $host = "z3950.indexdata.com/gils"; my $conn; eval { $conn = new ZOOM::Connection($host, 0) }; ok(!$@, "connection to '$host'"); $conn->option(number => 10); my($ss, $n) = scan($conn, 0, "w", 10); my @terms = (); my $previous = ""; # Sorts before all legitimate terms foreach my $i (1 .. $n) { my($term, $occ) = $ss->term($i-1); ok(defined $term, "got term $i of $n: '$term' ($occ occurences)"); ok($term ge $previous, "term '$term' ge previous '$previous'"); $previous = $term; push @terms, $term; (my $disp, $occ) = $ss->display_term($i-1); ok(defined $disp, "display term $i of $n: '$disp' ($occ occurences)"); ok($disp eq $term, "display term $i identical to term"); } $ss->destroy(); ok(1, "destroyed scanset"); eval { $ss->destroy() }; ok(defined $@ && $@ =~ /been destroy\(\)ed/, "can't re-destroy scanset"); # Now re-scan, but only for words that occur in the title # This time, use a Query object for the start-term ($ss, $n) = scan($conn, 1, new ZOOM::Query::PQF('@attr 1=4 w'), 6); $previous = ""; # Sorts before all legitimate terms foreach my $i (1 .. $n) { my($term, $occ) = $ss->term($i-1); ok(defined $term, "got title term $i of $n: '$term' ($occ occurences)"); ok($term ge $previous, "title term '$term' ge previous '$previous'"); $previous = $term; ok((grep { $term eq $_ } @terms), "title term was in term list"); } $ss->destroy(); ok(1, "destroyed second scanset"); # Now re-do the same scan, but limiting the results to four terms at a # time. This time, use a CQL query $conn->option(number => 4); $conn->option(cqlfile => "samples/cql/pqf.properties"); ($ss, $n) = scan($conn, 1, new ZOOM::Query::CQL2RPN('title=w', $conn), 4); # Get last term and use it as seed for next scan my($term, $occ) = $ss->term($n-1); ok($ss->option("position") == 1, "seed-term is start of returned list"); ok(defined $term, "got last title term '$term' to use as seed"); $ss->destroy(); ok(1, "destroyed third scanset"); $conn->option(cclfile => "samples/ccl/default.bib"); ($ss, $n) = scan($conn, 1, new ZOOM::Query::CCL2RPN('ti=w', $conn), 4); # Get last term and use it as seed for next scan ($term, $occ) = $ss->term($n-1); ok($ss->option("position") == 1, "seed-term is start of returned list"); ok(defined $term, "got last title term '$term' to use as seed"); $ss->destroy(); ok(1, "destroyed fourth scanset"); # We want the seed-term to be in "position zero", i.e. just before the start $conn->option(position => 0); ($ss, $n) = scan($conn, 0, "\@attr 1=4 $term", 2); ok($ss->option("position") == 0, "seed-term before start of returned list"); # Silly test of option setting and getting $ss->option(position => "fruit"); ok($ss->option("position") eq "fruit", "option setting/getting works"); $ss->destroy(); ok(1, "destroyed fifth scanset"); # Some more testing still to do: see comment in "15-scan.t" sub scan { my($conn, $startterm_is_query, $startterm, $nexpected) = @_; my $ss; eval { if ($startterm_is_query) { $ss = $conn->scan($startterm); } else { $ss = $conn->scan_pqf($startterm); } }; ok(!$@, "scan for '$startterm'"); my $n = $ss->size(); ok(defined $n, "got size"); ok($n == $nexpected, "got $n terms for '$startterm' (expected $nexpected)"); return ($ss, $n); } Net-Z3950-ZOOM-1.26/t/20-options.t������������������������������������������������������������������0000644�0001750�0001750�00000007165�11403454406�014512� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 20-options.t' use strict; use warnings; use Test::More tests => 51; BEGIN { use_ok('ZOOM') }; my $val1 = "foo"; my $val2 = "$val1\0bar"; my $o1 = new ZOOM::Options(); $o1->option(surname => "Taylor"); $o1->option(firstname => "Mike"); ok($o1->option("surname") eq "Taylor", "get 1"); ok($o1->option("firstname") eq "Mike", "get 2"); my $val; $o1->option(xyz => $val2); $val = $o1->option_binary("xyz"); ok($val eq $val1, "set/getl treats values as NUL-terminated, val='$val'"); $o1->option_binary(xyz => $val2); $val = $o1->option("xyz"); ok($val eq $val1, "setl/get treats values as NUL-terminated, val='$val'"); $o1->option_binary(xyz => $val2); $val = $o1->option_binary("xyz"); ok($val eq $val2, "setl/getl treats values as opaque, val='$val'"); my $o2 = new ZOOM::Options($o1); ok($o2->option("surname") eq "Taylor", "get via parent 1"); ok($o2->option("firstname") eq "Mike", "get via parent 2"); $o1->option(surname => "Parrish"); ok($o2->option("surname") eq "Parrish", "get via parent after replacement"); $o2->option(surname => "Taylor"); ok($o2->option("surname") eq "Taylor", "get via parent after overwrite"); ok($o1->option("surname") eq "Parrish", "get from parent after child overwrite"); my $o3 = new ZOOM::Options(); $o3->option(firstname => "Fiona"); my $o4 = new ZOOM::Options($o3, $o2); $val = $o4->option("firstname"); ok($val eq "Fiona", "get via first parent overrides second '$val'"); ok($o4->option("surname") eq "Taylor", "get via first parent"); $o1->option(initial => "P"); ok($o4->option("initial") eq "P", "get via grandparent"); $o1->destroy(); ok(1, "grandparent destroyed"); $val = $o4->option("initial"); ok($val eq "P", "referenced object survived destruction"); $o4->destroy(); ok(1, "grandchild destroyed"); $o3->destroy(); ok(1, "first parent destroyed"); $o2->destroy(); ok(1, "second parent destroyed"); $o1 = new ZOOM::Options(); # Strange but true: only "T" and "1" are considered true. check_bool($o1, y => 0); check_bool($o1, Y => 0); check_bool($o1, t => 0); check_bool($o1, T => 1); check_bool($o1, n => 0); check_bool($o1, N => 0); check_bool($o1, 0 => 0); check_bool($o1, 1 => 1); check_bool($o1, 2 => 0); check_bool($o1, 3 => 0); check_bool($o1, yes => 0); check_bool($o1, YES => 0); check_bool($o1, true => 0); check_bool($o1, TRUE => 0); ok($o1->bool("undefined", 1), "bool() defaulted to true"); ok(!$o1->bool("undefined", 0), "bool() defaulted to false"); sub check_bool { my($o, $val, $truep) = @_; $o->option(x => $val); ok($o->bool("x", 1) eq $truep, "bool() considers $val to be " . ($truep ? "true" : "false")); } check_int($o1, 0 => 0); check_int($o1, 1 => 1); check_int($o1, 2 => 2); check_int($o1, 3 => 3); check_int($o1, -17 => -17); check_int($o1, "012" => 12); check_int($o1, "0000003" => 3); check_int($o1, " 3" => 3); check_int($o1, " 34" => 34); check_int($o1, " 3 4" => 3); check_int($o1, " 3,456" => 3); ok($o1->int("undefined", 42) == 42, "int() defaulted to 42"); sub check_int { my($o, $val, $expected) = @_; $o->option(x => $val); my $nval = $o->int("x", 1); ok($nval == $expected, "int() considers $val to be $nval, expected $expected"); } check_set_int($o1, 0 => 0); check_set_int($o1, 3 => 3); check_set_int($o1, -17 => -17); check_set_int($o1, " 34" => 34); sub check_set_int { my($o, $val, $expected) = @_; $o->set_int(x => $val); my $nval = $o->int("x", 1); ok($nval == $expected, "int() considers $val to be $nval, expected $expected"); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/16-packages.t�����������������������������������������������������������������0000644�0001750�0001750�00000015716�11403454406�014603� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 16-packages.t' # Tests: # connect anonymously => refused # connect as "user" with incorrect password => refused # connect as "user" with correct password # try to create tmpdb => EPERM # connect as admin with correct password # try to create tmpdb => OK # try to create tmpdb => EFAIL use strict; use warnings; use Test::More tests => 39; BEGIN { use_ok('Net::Z3950::ZOOM') }; # We will create, and destroy, a new database with a random name my $host = "z3950.indexdata.com:2100"; my $dbname = join("", map { chr(ord("a") + int(rand(26))) } 1..10); # Connect anonymously, and expect this to fail my $conn = makeconn($host, undef, undef, 1011); # Connect as a user, but with incorrect password -- expect failure Net::Z3950::ZOOM::connection_destroy($conn); $conn = makeconn($host, "user", "badpw", 1011); # Connect as a non-privileged user with correct password Net::Z3950::ZOOM::connection_destroy($conn); $conn = makeconn($host, "user", "frog", 0); # Non-privileged user can't create database makedb($conn, $dbname, 223); # Connect as a privileged user with correct password, check DB is absent Net::Z3950::ZOOM::connection_destroy($conn); $conn = makeconn($host, "admin", "fish", 0); Net::Z3950::ZOOM::connection_option_set($conn, databaseName => $dbname); count_hits($conn, $dbname, "the", 109); # Now create the database and check that it is present but empty makedb($conn, $dbname, 0); count_hits($conn, $dbname, "the", 114); # Trying to create the same database again will fail EEXIST makedb($conn, $dbname, 224); # Add a single record, and check that it can be found updaterec($conn, 1, content_of("samples/records/esdd0006.grs"), 0); count_hits($conn, $dbname, "the", 0, 1); # Add the same record with the same ID: overwrite => no change updaterec($conn, 1, content_of("samples/records/esdd0006.grs"), 0); count_hits($conn, $dbname, "the", 0, 1); # Add it again record with different ID => new copy added updaterec($conn, 2, content_of("samples/records/esdd0006.grs"), 0); count_hits($conn, $dbname, "the", 0, 2); # Now drop the newly-created database dropdb($conn, $dbname, 0); # A second dropping should fail, as the database is no longer there. dropdb($conn, $dbname, 235); sub makeconn { my($host, $user, $password, $expected_error) = @_; my $options = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set($options, user => $user) if defined $user; Net::Z3950::ZOOM::options_set($options, password => $password) if defined $password; my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $conn = Net::Z3950::ZOOM::connection_create($options); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "unconnected connection object created"); Net::Z3950::ZOOM::connection_connect($conn, $host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == $expected_error, "connection to '$host'" . ($errcode ? " refused ($errcode)" : "")); return $conn; } sub makedb { my($conn, $dbname, $expected_error) = @_; my $o = Net::Z3950::ZOOM::options_create(); my $p = Net::Z3950::ZOOM::connection_package($conn, $o); # Inspection of the ZOOM-C code shows that this can never fail, in fact. ok(defined $p, "created package"); Net::Z3950::ZOOM::package_option_set($p, databaseName => $dbname); my $val = Net::Z3950::ZOOM::package_option_get($p, "databaseName"); ok($val eq $dbname, "package option retrieved as expected"); Net::Z3950::ZOOM::package_send($p, "create"); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == $expected_error, "database creation '$dbname'" . ($errcode ? " refused ($errcode)" : "")); # Now we can inspect the package options to find out more about # how the server dealt with the request. However, it seems that # the "package database" described in the standard is not used, # and that the only options we can inspect are the following: $val = Net::Z3950::ZOOM::package_option_get($p, "targetReference"); $val = Net::Z3950::ZOOM::package_option_get($p, "xmlUpdateDoc"); # ... and we know nothing about expected or actual values. Net::Z3950::ZOOM::package_destroy($p); ok(1, "destroyed createdb package"); } sub dropdb { my($conn, $dbname, $expected_error) = @_; my $o = Net::Z3950::ZOOM::options_create(); my $p = Net::Z3950::ZOOM::connection_package($conn, $o); # No need to keep ok()ing this, or checking the option-setting Net::Z3950::ZOOM::package_option_set($p, databaseName => $dbname); Net::Z3950::ZOOM::package_send($p, "drop"); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == $expected_error, ("database drop '$dbname'" . ($errcode ? " refused $errcode" : "") . ($expected_error ? " expected $expected_error but succeeded" : ""))); Net::Z3950::ZOOM::package_destroy($p); ok(1, "destroyed dropdb package"); } # We always use "specialUpdate", which adds a record or replaces it if # it's already there. By contrast, "insert" fails if the record # already exists, and "replace" fails if it does not. # sub updaterec { my($conn, $id, $file, $expected_error) = @_; my $o = Net::Z3950::ZOOM::options_create(); my $p = Net::Z3950::ZOOM::connection_package($conn, $o); Net::Z3950::ZOOM::package_option_set($p, action => "specialUpdate"); Net::Z3950::ZOOM::package_option_set($p, recordIdOpaque => $id); Net::Z3950::ZOOM::package_option_set($p, record => $file); Net::Z3950::ZOOM::package_send($p, "update"); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == $expected_error, "record update $id" . ($errcode ? " failed $errcode '$errmsg' ($addinfo)" : "")); Net::Z3950::ZOOM::package_destroy($p); ok(1, "destroyed update package"); } sub count_hits { my($conn, $dbname, $query, $expected_error, $expected_count) = @_; my $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, $query); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == $expected_error, "database '$dbname' " . ($errcode == 0 ? "can be searched" : "not searchable ($errcode)")); return if $errcode != 0; my $n = Net::Z3950::ZOOM::resultset_size($rs); ok($n == $expected_count, "database '$dbname' has $n records (expected $expected_count)"); } sub content_of { my($filename) = @_; use IO::File; my $f = new IO::File("<$filename") or die "can't open file '$filename': $!"; my $text = join("", <$f>); $f->close(); return $text; } ��������������������������������������������������Net-Z3950-ZOOM-1.26/t/12-query.t��������������������������������������������������������������������0000644�0001750�0001750�00000012674�11403454406�014166� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 12-query.t' use strict; use warnings; use Test::More tests => 41; BEGIN { use_ok('Net::Z3950::ZOOM') }; # Net::Z3950::ZOOM::yaz_log_init_level(Net::Z3950::ZOOM::yaz_log_mask_str("zoom")); my $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "create empty query"); Net::Z3950::ZOOM::query_destroy($q); ok(1, "destroyed empty query"); $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "recreated empty query"); # Invalid CQL is not recognised as such, because ZOOM-C does not # attempt to parse it: it just gets passed to the server when the # query is used. my $res = Net::Z3950::ZOOM::query_cql($q, "creator=pike and"); ok($res == 0, "invalid CQL accepted (pass-through)"); $res = Net::Z3950::ZOOM::query_cql($q, "creator=pike and subject=unix"); ok($res == 0, "valid CQL accepted"); $res = Net::Z3950::ZOOM::query_prefix($q, '@and @attr 1=1003 pike'); ok($res < 0, "invalid PQF rejected"); $res = Net::Z3950::ZOOM::query_prefix($q, '@and @attr 1=1003 pike @attr 1=21 unix'); ok($res == 0, "set PQF into query"); $res = Net::Z3950::ZOOM::query_sortby($q, ""); ok($res < 0, "zero-length sort criteria rejected"); $res = Net::Z3950::ZOOM::query_sortby($q, "foo bar baz"); ok($res == 0, "sort criteria accepted"); Net::Z3950::ZOOM::query_destroy($q); ok(1, "destroyed complex query"); # Up till now, we have been doing query management. Now to actually # use the query. This is done using connection_search() -- there are # no other uses of query objects -- but we need to establish a # connection for it to work on first. my $host = "z3950.indexdata.com/gils"; my $conn = Net::Z3950::ZOOM::connection_new($host, 0); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "connection to '$host'"); Net::Z3950::ZOOM::connection_option_set($conn, preferredRecordSyntax => "usmarc"); $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "create empty query"); $res = Net::Z3950::ZOOM::query_prefix($q, '@and @attr 1=4 utah @attr 1=62 epicenter'); ok($res == 0, "set PQF into query"); check_record($conn, $q); Net::Z3950::ZOOM::query_destroy($q); # Now try a CQL query: this will fail due to lack of server support $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "create empty query"); $res = Net::Z3950::ZOOM::query_cql($q, 'title=utah and description=epicenter'); ok($res == 0, "valid CQL accepted"); my $rs = Net::Z3950::ZOOM::connection_search($conn, $q); my $diagset = "dummy"; $errcode = Net::Z3950::ZOOM::connection_error_x($conn, $errmsg, $addinfo, $diagset); ok($errcode == 107 && $diagset eq "Bib-1", "query rejected: error " . $errcode); Net::Z3950::ZOOM::query_destroy($q); # Client-side compiled CQL: this will fail due to lack of config-file $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "create empty query"); $res = Net::Z3950::ZOOM::query_cql2rpn($q, 'title=utah and description=epicenter', $conn); $errcode = Net::Z3950::ZOOM::connection_error_x($conn, $errmsg, $addinfo, $diagset); ok($res < 0 && $errcode == Net::Z3950::ZOOM::ERROR_CQL_TRANSFORM && $diagset eq "ZOOM", "can't make CQL2RPN query: error " . $errcode); Net::Z3950::ZOOM::query_destroy($q); # Do a successful client-compiled CQL search $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "create empty query"); Net::Z3950::ZOOM::connection_option_set($conn, cqlfile => "samples/cql/pqf.properties"); $res = Net::Z3950::ZOOM::query_cql2rpn($q, 'title=utah and description=epicenter', $conn); ok($res == 0, "created CQL2RPN query"); check_record($conn, $q); Net::Z3950::ZOOM::query_destroy($q); # Client-side compiled CCL: this will fail due to incorrect syntax $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "create empty query"); my($ccl_errcode, $ccl_errstr, $ccl_errpos) = (0, "", 0); $res = Net::Z3950::ZOOM::query_ccl2rpn($q, 'ti=utah and', "ti u=4 s=pw\nab u=62 s=pw", $ccl_errcode, $ccl_errstr, $ccl_errpos); ok($res < 0 && $ccl_errcode == Net::Z3950::ZOOM::CCL_ERR_TERM_EXPECTED, "can't make CCL2RPN query: error $ccl_errcode ($ccl_errstr)"); Net::Z3950::ZOOM::query_destroy($q); # Do a successful client-compiled CCL search $q = Net::Z3950::ZOOM::query_create(); ok(defined $q, "create empty query"); $res = Net::Z3950::ZOOM::query_ccl2rpn($q, 'ti=utah and ab=epicenter', "ti u=4 s=pw\nab u=62 s=pw", $ccl_errcode, $ccl_errstr, $ccl_errpos); ok($res == 0, "created CCL2RPN query"); check_record($conn, $q); Net::Z3950::ZOOM::query_destroy($q); Net::Z3950::ZOOM::connection_destroy($conn); ok(1, "destroyed all objects"); sub check_record { my($conn, $q) = @_; my $rs = Net::Z3950::ZOOM::connection_search($conn, $q); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "search"); my $n = Net::Z3950::ZOOM::resultset_size($rs); ok($n == 1, "found 1 record as expected"); my $rec = Net::Z3950::ZOOM::resultset_record($rs, 0); ok(1, "got record idenfified by query"); my $data = Net::Z3950::ZOOM::record_get($rec, "render"); ok(1, "rendered record"); ok($data =~ /^035 \$a ESDD0006$/m, "record is the expected one"); Net::Z3950::ZOOM::resultset_destroy($rs); } ��������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/11-option-callback.t����������������������������������������������������������0000644�0001750�0001750�00000003776�11403454406�016065� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 11-option-callback.t' use strict; use warnings; use Test::More tests => 19; BEGIN { use_ok('Net::Z3950::ZOOM') }; # This callback function provides values only options whose names # begin with consonants, in which case the value is the option name # concatenated with a hyphen and the value of the user-data that was # lodged along with the callback. # sub f_option { my($udata, $name) = @_; return undef if $name =~ /^[aeiou]/; return "$name-$udata"; } my $o1 = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set_callback($o1, "f_option", "xyz"); Net::Z3950::ZOOM::options_set($o1, isisaurus => "was titanosaurus"); check($o1, "apatosaurus", undef); check($o1, "brachiosaurus", "brachiosaurus-xyz"); check($o1, "camarasaurus", "camarasaurus-xyz"); check($o1, "diplodocus", "diplodocus-xyz"); check($o1, "euhelopus", undef); check($o1, "futalognkosaurus", "futalognkosaurus-xyz"); check($o1, "gigantosaurus", "gigantosaurus-xyz"); check($o1, "haplocanthosaurus", "haplocanthosaurus-xyz"); check($o1, "isisaurus", "was titanosaurus"); check($o1, "janenschia", "janenschia-xyz"); my $o2 = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set_callback($o2, "f_option", "abc"); check($o2, "apatosaurus", undef); check($o2, "brachiosaurus", "brachiosaurus-abc"); check($o2, "kxxxxxxxxxxxxx", "kxxxxxxxxxxxxx-abc"); check($o2, "limaysaurus", "limaysaurus-abc"); check($o2, "mamenchisaurus", "mamenchisaurus-abc"); check($o2, "nurosaurus", "nurosaurus-abc"); check($o2, "omeisaurus", undef); check($o2, "patagosaurus", "patagosaurus-abc"); sub check { my($opts, $key, $expected) = @_; my $val = Net::Z3950::ZOOM::options_get($opts, $key); #print "$opts($key) ", (defined $val ? "= '$val'" : "undefined"), "\n"; if (defined $expected) { ok ($val eq $expected, "value for '$key' is '$val'"); } else { ok (!defined $val, "no value for '$key'"); } } ��Net-Z3950-ZOOM-1.26/t/19-events.t�������������������������������������������������������������������0000644�0001750�0001750�00000007274�11403454406�014334� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 19-events.t' use strict; use warnings; use Test::More tests => 23; BEGIN { use_ok('Net::Z3950::ZOOM') }; ok(Net::Z3950::ZOOM::event_str(Net::Z3950::ZOOM::EVENT_CONNECT) eq "connect", "connect event properly translated"); my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $options = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set($options, async => 1); my $host = "z3950.indexdata.com/gils"; my $conn = Net::Z3950::ZOOM::connection_create($options); Net::Z3950::ZOOM::connection_connect($conn, $host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "connection to '$host'"); my $val = Net::Z3950::ZOOM::event(1); ok($val == -1, "non-reference argument rejected"); $val = Net::Z3950::ZOOM::event($conn); ok($val == -2, "non-array reference argument rejected"); $val = Net::Z3950::ZOOM::event([]); ok($val == -3, "empty array reference argument rejected"); # The old test for giant array reference can't be done now that the # corresponding array internal to the glue-code is allocated # dynamically. ok(1, "huge array reference argument rejected"); # Test the sequence of events that come from just creating the # connection: there's the physical connect; the sending the Init # request (sending the APDU results in sending the data); the # receiving of the Init response (receiving the data results in # receiving the APDU); then the END "event" indicating that there are # no further events on the specific connection we're using; finally, # event() will return 0 to indicate that there are no events pending # on any of the connections we pass in. assert_event_stream($conn, Net::Z3950::ZOOM::EVENT_CONNECT, Net::Z3950::ZOOM::EVENT_SEND_APDU, Net::Z3950::ZOOM::EVENT_SEND_DATA, Net::Z3950::ZOOM::EVENT_RECV_DATA, Net::Z3950::ZOOM::EVENT_RECV_APDU, Net::Z3950::ZOOM::EVENT_END, 0); # Now we need to actually _do_ something, and watch the stream of # resulting events: issue a piggy-back search. Net::Z3950::ZOOM::connection_option_set($conn, count => 1); my $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, "mineral"); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); ok($errcode == 0, "search for 'mineral'"); assert_event_stream($conn, Net::Z3950::ZOOM::EVENT_SEND_APDU, Net::Z3950::ZOOM::EVENT_SEND_DATA, -(Net::Z3950::ZOOM::EVENT_RECV_DATA), Net::Z3950::ZOOM::EVENT_RECV_APDU, Net::Z3950::ZOOM::EVENT_RECV_SEARCH, Net::Z3950::ZOOM::EVENT_RECV_RECORD, Net::Z3950::ZOOM::EVENT_END, 0); # Some events, especially RECV_DATA, may randomly occur multiple # times, depending on network chunking; so if an expected event's # value is negated, we allow that event to occur one or more times, # and treat the sequence of repeated events as a single test. # sub assert_event_stream { my($conn, @expected) = @_; my $previousExpected = -1; my $expected = shift @expected; while (defined $expected) { my $val = Net::Z3950::ZOOM::event([$conn]); if ($expected == 0) { ok($val == 0, "no events left"); $expected = shift @expected; next; } die "impossible" if $val != 1; my $ev = Net::Z3950::ZOOM::connection_last_event($conn); next if $previousExpected > 0 && $ev == $previousExpected; if ($expected < 0) { $expected = -$expected; $previousExpected = $expected; } ok($ev == $expected, ("event is $ev (" . Net::Z3950::ZOOM::event_str($ev) . "), expected $expected (" . Net::Z3950::ZOOM::event_str($expected) . ")")); $expected = shift @expected; } } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/22-query.t��������������������������������������������������������������������0000644�0001750�0001750�00000010220�11403454406�014150� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 22-query.t' use strict; use warnings; use Test::More tests => 41; BEGIN { use_ok('ZOOM') }; #ZOOM::Log::init_level(ZOOM::Log::mask_str("zoom")); my $q; eval { $q = new ZOOM::Query() }; ok(defined $@ && $@ =~ /can.t create ZOOM::Query/, "instantiation of ZOOM::Query base class rejected"); ok(1, "[no query to destroy]"); ok(1, "[no need to recreate empty query]"); # Invalid CQL is not recognised as such, because ZOOM-C does not # attempt to parse it: it just gets passed to the server when the # query is used. $q = new ZOOM::Query::CQL("creator=pike and"); ok(defined $q, "invalid CQL accepted (pass-through)"); $q = new ZOOM::Query::CQL("creator=pike and subject=unix"); ok(defined $q, "valid CQL accepted"); eval { $q = new ZOOM::Query::PQF('@and @attr 1=1003 pike') }; ok($@ && $@->isa("ZOOM::Exception") && $@->code() == ZOOM::Error::QUERY_PQF, "invalid PQF rejected"); eval { $q = new ZOOM::Query::PQF('@and @attr 1=1003 pike @attr 1=21 unix') }; ok(!$@, "set PQF into query"); eval { $q->sortby("") }; ok($@ && $@->isa("ZOOM::Exception") && $@->code() == ZOOM::Error::SORTBY, "zero-length sort criteria rejected"); eval { $q->sortby("foo bar baz") }; ok(!$@, "sort criteria accepted"); $q->destroy(); ok(1, "destroyed complex query"); # Up till now, we have been doing query management. Now to actually # use the query. This is done using Connection::search() -- there are # no other uses of query objects -- but we need to establish a # connection for it to work on first. my $host = "z3950.indexdata.com/gils"; my $conn; eval { $conn = new ZOOM::Connection($host, 0, preferredRecordSyntax => "usmarc") }; ok(!$@, "connection to '$host'"); ok(1, "[no need to create empty query]"); eval { $q = new ZOOM::Query::PQF('@and @attr 1=4 utah @attr 1=62 epicenter') }; ok(!$@, "created PQF query"); check_record($conn, $q); $q->destroy(); # Now try a CQL query: this will fail due to lack of server support ok(1, "[no need to create empty query]"); eval { $q = new ZOOM::Query::CQL('title=utah and description=epicenter') }; ok(!$@, "created CQL query"); my $rs; eval { $rs = $conn->search($q) }; ok($@ && $@->isa("ZOOM::Exception") && $@->code() == 107 && $@->diagset() eq "Bib-1", "query rejected: error " . $@->code()); $q->destroy(); # Client-side compiled CQL: this will fail due to lack of config-file ok(1, "[no need to create empty query]"); eval { $q = new ZOOM::Query::CQL2RPN('title=utah and description=epicenter', $conn) }; ok($@ && $@->isa("ZOOM::Exception") && $@->code() == ZOOM::Error::CQL_TRANSFORM && $@->diagset() eq "ZOOM", "can't make CQL2RPN query: error " . $@->code()); # Do a successful client-compiled CQL search ok(1, "[no need to create empty query]"); $conn->option(cqlfile => "samples/cql/pqf.properties"); eval { $q = new ZOOM::Query::CQL2RPN('title=utah and description=epicenter', $conn) }; ok(!$@, "created CQL2RPN query"); check_record($conn, $q); $q->destroy(); # Client-side compiled CCL: this will fail due to lack of config-file ok(1, "[no need to create empty query]"); eval { $q = new ZOOM::Query::CCL2RPN('ti=utah and ab=epicenter', $conn) }; ok($@ && $@->isa("ZOOM::Exception") && $@->code() == ZOOM::Error::CCL_CONFIG && $@->diagset() eq "ZOOM", "can't make CCL2RPN query: error " . $@->code()); # Do a successful client-compiled CCL search ok(1, "[no need to create empty query]"); $conn->option(cclfile => "samples/ccl/default.bib"); eval { $q = new ZOOM::Query::CCL2RPN('ti=utah and ab=epicenter', $conn) }; ok(!$@, "created CCL2RPN query"); check_record($conn, $q); $q->destroy(); $conn->destroy(); ok(1, "destroyed all objects"); sub check_record { my($conn, $q) = @_; my $rs; eval { $rs = $conn->search($q) }; ok(!$@, "search"); die $@ if $@; my $n = $rs->size(); ok($n == 1, "found 1 record as expected"); my $rec = $rs->record(0); ok(1, "got record idenfified by query"); my $data = $rec->render(); ok(1, "rendered record"); ok($data =~ /^035 +\$a ESDD0006$/m, "record is the expected one"); $rs->destroy(); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/26-packages.t�����������������������������������������������������������������0000644�0001750�0001750�00000013454�11403454406�014601� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 26-packages.t' use strict; use warnings; use Test::More tests => 39; BEGIN { use_ok('ZOOM') }; # We will create, and destroy, a new database with a random name my $host = "z3950.indexdata.com:2100"; my $dbname = join("", map { chr(ord("a") + int(rand(26))) } 1..10); # Connect anonymously, and expect this to fail my $conn = makeconn($host, undef, undef, 1011); # Connect as a user, but with incorrect password -- expect failure $conn->destroy(); $conn = makeconn($host, "user", "badpw", 1011); # Connect as a non-privileged user with correct password $conn->destroy(); $conn = makeconn($host, "user", "frog", 0); # Non-privileged user can't create database makedb($conn, $dbname, 223); # Connect as a privileged user with correct password, check DB is absent $conn->destroy(); $conn = makeconn($host, "admin", "fish", 0); $conn->option(databaseName => $dbname); count_hits($conn, $dbname, "the", 109); # Now create the database and check that it is present but empty makedb($conn, $dbname, 0); count_hits($conn, $dbname, "the", 114); # Trying to create the same database again will fail EEXIST makedb($conn, $dbname, 224); # Add a single record, and check that it can be found updaterec($conn, 1, content_of("samples/records/esdd0006.grs"), 0); count_hits($conn, $dbname, "the", 0, 1); # Add the same record with the same ID: overwrite => no change updaterec($conn, 1, content_of("samples/records/esdd0006.grs"), 0); count_hits($conn, $dbname, "the", 0, 1); # Add it again record with different ID => new copy added updaterec($conn, 2, content_of("samples/records/esdd0006.grs"), 0); count_hits($conn, $dbname, "the", 0, 2); # Now drop the newly-created database dropdb($conn, $dbname, 0); # A second dropping should fail, as the database is no longer there. dropdb($conn, $dbname, 235); sub makeconn { my($host, $user, $password, $expected_error) = @_; my $options = new ZOOM::Options(); $options->option(user => $user) if defined $user; $options->option(password => $password) if defined $password; my $conn; eval { $conn = create ZOOM::Connection($options) }; ok(!$@, "unconnected connection object created"); eval { $conn->connect($host, 0) }; my($errcode, $errmsg, $addinfo) = maybe_error($@); ok($errcode == $expected_error, "connection to '$host'" . ($errcode ? " refused ($errcode)" : "")); return $conn; } sub makedb { my($conn, $dbname, $expected_error) = @_; my $p = $conn->package(); # Inspection of the ZOOM-C code shows that this can never fail, in fact. ok(defined $p, "created package"); $p->option(databaseName => $dbname); my $val = $p->option("databaseName"); ok($val eq $dbname, "package option retrieved as expected"); eval { $p->send("create") }; my($errcode, $errmsg, $addinfo) = maybe_error($@); ok($errcode == $expected_error, "database creation '$dbname'" . ($errcode ? " refused ($errcode)" : "")); # Now we can inspect the package options to find out more about # how the server dealt with the request. However, it seems that # the "package database" described in the standard is not used, # and that the only options we can inspect are the following: $val = $p->option("targetReference"); $val = $p->option("xmlUpdateDoc"); # ... and we know nothing about expected or actual values. $p->destroy(); ok(1, "destroyed createdb package"); } sub dropdb { my($conn, $dbname, $expected_error) = @_; my $p = $conn->package(); # No need to keep ok()ing this, or checking the option-setting $p->option(databaseName => $dbname); eval { $p->send("drop") }; my($errcode, $errmsg, $addinfo) = maybe_error($@); ok($errcode == $expected_error, "database drop '$dbname'" . ($errcode ? " refused $errcode" : "")); $p->destroy(); ok(1, "destroyed dropdb package"); } # We always use "specialUpdate", which adds a record or replaces it if # it's already there. By contrast, "insert" fails if the record # already exists, and "replace" fails if it does not. # sub updaterec { my($conn, $id, $file, $expected_error) = @_; my $p = $conn->package(); $p->option(action => "specialUpdate"); $p->option(recordIdOpaque => $id); $p->option(record => $file); eval { $p->send("update") }; my($errcode, $errmsg, $addinfo) = maybe_error($@); ok($errcode == $expected_error, "record update $id" . ($errcode ? " failed $errcode '$errmsg' ($addinfo)" : "")); $p->destroy(); ok(1, "destroyed update package"); } sub count_hits { my($conn, $dbname, $query, $expected_error, $expected_count) = @_; my $rs; eval { $rs = $conn->search_pqf($query) }; my($errcode, $errmsg, $addinfo) = maybe_error($@); ok($errcode == $expected_error, "database '$dbname' " . ($errcode == 0 ? "can be searched" : "not searchable ($errcode)")); return if $errcode != 0; my $n = $rs->size($rs); ok($n == $expected_count, "database '$dbname' has $n records (expected $expected_count)"); } sub content_of { my($filename) = @_; use IO::File; my $f = new IO::File("<$filename") or die "can't open file '$filename': $!"; my $text = join("", <$f>); $f->close(); return $text; } # Return the elements of an exception as separate scalars sub maybe_error { my ($x) = @_; if ($x && $x->isa("ZOOM::Exception")) { return ($x->code(), $x->message(), $x->addinfo()); } else { return (0, undef, undef); } } # To investigate the set of databases created, use Explain Classic: # # $ yaz-client -u admin/fish test.indexdata.com:2118/IR-Explain-1 # Z> find @attr exp1 1=1 databaseinfo # Z> format xml # Z> show 3 # # It seems that Explain still knows about dropped databases. ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/23-resultset.t����������������������������������������������������������������0000644�0001750�0001750�00000006017�11403454406�015047� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 23-resultset.t' use strict; use warnings; use Test::More tests => 24; BEGIN { use_ok('ZOOM') }; my $host = "z3950.indexdata.com/gils"; my $conn; eval { $conn = new ZOOM::Connection($host, 0) }; ok(!$@, "connection to '$host'"); my $query = '@attr 1=4 mineral'; my $rs; eval { $rs = $conn->search_pqf($query) }; ok(!$@, "search for '$query'"); ok($rs->size() == 2, "found 2 records"); my $syntax = "canmarc"; # not supported $rs->option(preferredRecordSyntax => $syntax); my $val = $rs->option("preferredRecordSyntax"); ok($val eq $syntax, "preferred record syntax set to '$val'"); my $rec = $rs->record(0); my($errcode, $errmsg) = $rec->error(); ok($errcode == 238, "can't fetch CANMARC ($errmsg)"); $rs->option(preferredRecordSyntax => "usmarc"); $rec = $rs->record(0); my $data1 = $rec->render(); $rs->option(elementSetName => "b"); my $data2 = $rec->render(); ok($data2 eq $data1, "record doesn't know about RS options"); # Now re-fetch record from result-set with new option $rec = $rs->record(0); $data2 = $rec->render(); ok(length($data2) < length($data1), "re-fetched record is brief, old was full"); $rs->option(preferredRecordSyntax => "xml"); $rec = $rs->record(0); my $cloned = $rec->clone(); ok(defined $cloned, "cloned record"); $data2 = $rec->render(); ok($data2 =~ /<title>/i, "option for XML syntax is honoured"); # Now we test ZOOM_resultset_record_immediate(), which should only # work for records that have already been placed in the cache, and # ZOOM_resultset_records() which populates the cache, and # ZOOM_resultset_cache_reset(), which presumably empties it. # $rec = $rs->record_immediate(0); ok(defined $rec, "prefetched record obtained with _immediate()"); my $data3 = $rec->render(); ok($data3 eq $data2, "_immediate record renders as expected"); $rec = $rs->record_immediate(1); #{ use Data::Dumper; print "rec=$rec = ", Dumper($rec) } ok(!defined $rec, "non-prefetched record obtained with _immediate()"); $rs->cache_reset(); $rec = $rs->record_immediate(0); ok(!defined $rec, "_immediate(0) fails after cache reset"); # Fill both cache slots, but with no record array my $tmp = $rs->records(0, 2, 0); ok(!defined $tmp, "resultset_records() returns undef as expected"); $rec = $rs->record_immediate(0); ok(defined $rec, "_immediate(0) ok after resultset_records()"); # Fetch all records at once using records() $tmp = $rs->records(0, 2, 1); ok(@$tmp == 2, "resultset_records() returned two records"); $data3 = $tmp->[0]->render(); ok($data3 eq $data2, "record returned from resultset_records() renders as expected"); $rec = $rs->record_immediate(1); ok(defined $rec, "_immediate(1) ok after resultset_records()"); $rs->destroy(); ok(1, "destroyed result-set"); $conn->destroy(); ok(1, "destroyed connection"); $data3 = $cloned->render(); ok(1, "rendered cloned record after its result-set was destroyed"); ok($data3 eq $data2, "render of clone as expected"); $cloned->destroy(); ok(1, "destroyed cloned record"); �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/24-sorting.t������������������������������������������������������������������0000644�0001750�0001750�00000003342�11403454406�014501� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 24-sorting.t' use strict; use warnings; use Test::More tests => 29; use MARC::Record; BEGIN { use_ok('ZOOM') }; my $host = "z3950.indexdata.com/gils"; my $conn; eval { $conn = new ZOOM::Connection($host, 0) }; ok(!$@, "connection to '$host'"); my $qstr = '@attr 1=4 map'; my $query = new ZOOM::Query::PQF($qstr); eval { $query->sortby("1=4 <i") }; ok(!$@, "sort specification accepted"); my $rs; eval { $rs = $conn->search($query) }; ok(!$@, "search for '$qstr'"); my $n = $rs->size(); ok($n == 5, "found $n records (expected 5)"); $rs->option(preferredRecordSyntax => "usmarc"); my $previous = ""; # Sorts before all legitimate titles foreach my $i (1 .. $n) { my $rec = $rs->record($i-1); ok(defined $rec, "got record $i of $n"); my $raw = $rec->raw(); my $marc = new_from_usmarc MARC::Record($raw); my $title = $marc->title(); ok($title ge $previous, "title '$title' ge previous '$previous'"); $previous = $title; } # Now reverse the order of sorting my $status = $rs->sort("yaz", "1=4>i"); ok($status < 0, "malformed sort criterion rejected"); $status = $rs->sort("yaz", "1=4 >i"); ok($status == 0, "sort criterion accepted"); $previous = "z"; # Sorts after all legitimate titles foreach my $i (1 .. $n) { my $rec = $rs->record($i-1); ok(defined $rec, "got record $i of $n"); my $raw = $rec->raw(); my $marc = new_from_usmarc MARC::Record($raw); my $title = $marc->title(); ok($title le $previous, "title '$title' le previous '$previous'"); $previous = $title; } $rs->destroy(); ok(1, "destroyed result-set"); $conn->destroy(); ok(1, "destroyed connection"); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/t/2-ZOOM.t����������������������������������������������������������������������0000644�0001750�0001750�00000005621�11403454406�013516� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 2-ZOOM.t' use strict; use warnings; use Test::More tests => 23; BEGIN { use_ok('ZOOM') }; my $msg = ZOOM::diag_str(ZOOM::Error::INVALID_QUERY); ok($msg eq "Invalid query", "diagnostic string lookup works"); $msg = ZOOM::diag_srw_str(27); ok($msg eq "Empty term unsupported", "SRW diagnostic string lookup works"); my $host = "no.such.host"; my $conn; eval { $conn = new ZOOM::Connection($host, 0) }; # For some reason, Red Hat signals this as a TIMEOUT rather than a CONNECT ok($@ && $@->isa("ZOOM::Exception") && (($@->code() == ZOOM::Error::CONNECT && $@->addinfo() eq $host) || ($@->code() == ZOOM::Error::TIMEOUT && $@->addinfo() eq "")), "connection to non-existent host '$host' fails: \$\@=$@"); $host = "z3950.indexdata.com/gils"; eval { $conn = new ZOOM::Connection($host, 0) }; ok(!$@, "connection to '$host'"); $conn->destroy(); ok(1, "destroyed connection"); eval { $conn = create ZOOM::Connection() }; ok(!$@, "unconnected connection object created"); eval { $conn->connect($host, 0) }; ok(!$@, "delayed connection to '$host'"); my $val1 = "foo"; my $val2 = "$val1\0bar"; $conn->option(xyz => $val2); my $val = $conn->option("xyz"); ok($val eq $val1, "option() treats value as NUL-terminated"); $conn->option_binary(xyz => $val2, length($val2)); $val = $conn->option_binary("xyz"); ok($val eq $val2, "option_setl() treats value as opaque chunk, val='$val'"); my $syntax = "usmarc"; $conn->option(preferredRecordSyntax => $syntax); $val = $conn->option("preferredRecordSyntax"); ok($val eq $syntax, "preferred record syntax set to '$val'"); my $query = '@attr @and 1=4 minerals'; my $rs; eval { $rs = $conn->search_pqf($query) }; ok($@ && $@->isa("ZOOM::Exception") && $@->code() == ZOOM::Error::INVALID_QUERY, "search for invalid query '$query' fails"); my($xcode, $xmsg, $xinfo, $xset) = $conn->error_x(); ok($xcode == $@->code() && $xmsg eq $@->message() && $xinfo eq $@->addinfo() && $xset eq $@->diagset(), "error_x() consistent with exception"); ok($conn->errcode() == $@->code(), "errcode() consistent with exception"); ok($conn->errmsg() eq $@->message(), "errmsg() consistent with exception"); ok($conn->addinfo() eq $@->addinfo(), "addinfo() consistent with exception"); ok($conn->diagset() eq $@->diagset(), "diagset() consistent with exception"); $query = '@attr 1=4 minerals'; eval { $rs = $conn->search_pqf($query) }; ok(!$@, "search for '$query'"); my $n = $rs->size($rs); ok($n == 1, "found 1 record as expected"); my $rec = $rs->record(0); my $data = $rec->render(); ok($data =~ /^245 +\$a ISOTOPIC DATES OF ROCKS AND MINERALS$/m, "rendered record has expected title"); my $raw = $rec->raw(); ok($raw =~ /^00966n/, "raw record contains expected header"); $rs->destroy(); ok(1, "destroyed result-set"); $conn->destroy(); ok(1, "destroyed connection"); ���������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/ZOOM.xs�������������������������������������������������������������������������0000644�0001750�0001750�00000033545�11403454406�013311� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include <yaz/zoom.h> #include <yaz/diagsrw.h> #include <yaz/xmalloc.h> #include <yaz/log.h> #include <yaz/yaz-version.h> /* Used by the *_setl() functions */ typedef char opaquechar; /* Used as the return value of the *_getl() functions */ struct datachunk { char *data; int len; }; /* Used to package Perl function-pointer and user-data together */ struct callback_block { SV *function; SV *handle; }; /* The callback function used for ZOOM_options_set_callback(). I do * not claim to fully understand all the stack-hacking magic, and less * still the reference-counting/mortality stuff. Accordingly, the * memory management here is best characterised as What I Could Get To * Work, More Or Less. */ const char *__ZOOM_option_callback (void *handle, const char *name) { struct callback_block *cb = (struct callback_block*) handle; int count; SV *ret; char *s; char *res; dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(cb->handle); XPUSHs(sv_2mortal(newSVpv(name, 0))); PUTBACK; /* Perl_sv_dump(0, cb->function); */ count = call_sv(cb->function, G_SCALAR); SPAGAIN; if (count != 1) croak("callback function for ZOOM_options_get() returned %d values: should have returned exactly one", count); ret = POPs; if (SvPOK(ret)) { s = SvPV_nolen(ret); /* ### `res' never gets freed! I think it is * impossible to solve this problem "correctly" * because the ZOOM-C option callback interface is * inadequate. */ res = xstrdup(s); } else { res = 0; } PUTBACK; FREETMPS; LEAVE; return res; } MODULE = Net::Z3950::ZOOM PACKAGE = Net::Z3950::ZOOM PREFIX=ZOOM_ PROTOTYPES: ENABLE ZOOM_connection ZOOM_connection_new(host, portnum) const char* host int portnum ZOOM_connection ZOOM_connection_create(options) ZOOM_options options void ZOOM_connection_connect(c, host, portnum) ZOOM_connection c const char* host int portnum void ZOOM_connection_destroy(c) ZOOM_connection c const char * ZOOM_connection_option_get(c, key) ZOOM_connection c const char *key struct datachunk ZOOM_connection_option_getl(c, key, len) ZOOM_connection c const char* key int &len CODE: RETVAL.data = (char*) ZOOM_connection_option_getl(c, key, &len); RETVAL.len = len; OUTPUT: RETVAL len void ZOOM_connection_option_set(c, key, val) ZOOM_connection c const char *key const char *val # In ZOOM-C, the `val' parameter is const char*. However, our typemap # treats this as T_PV, i.e. it's "known" that it points to a # NUL-terminated string. Instead, then, I here use opaquechar*, which # is an opaque pointer. The underlying C function can then use this # along with `len' to Do The Right Thing. # void ZOOM_connection_option_setl(c, key, val, len) ZOOM_connection c const char* key opaquechar* val int len # The reference parameters, `cp' and `addinfo', need to already have # values when this function is called, otherwise an "uninitialised # value" warning is generated. As far as I can see, there is no way # around this: no way to specify in a prototype that an argument is # allowed to be undefined, for example. Since these function will # never be called directly by well-behaved client code, but only by # our own wrapper classes, I think we can live with that. # # The poxing about with cpp and caddinfo is due to Perl XS's lack of # support for const char**, but who can blame it? If you ask me, the # whole "const" thing was well-intentioned by ghastly mistake. # int ZOOM_connection_error(c, cp, addinfo) ZOOM_connection c char* &cp char* &addinfo CODE: { const char *ccp, *caddinfo; RETVAL = ZOOM_connection_error(c, &ccp, &caddinfo); cp = (char*) ccp; addinfo = (char*) caddinfo; } OUTPUT: RETVAL cp addinfo # See comments for ZOOM_connection_error() above int ZOOM_connection_error_x(c, cp, addinfo, diagset) ZOOM_connection c const char * &cp const char * &addinfo const char * &diagset CODE: { const char *ccp, *caddinfo, *cdset; RETVAL = ZOOM_connection_error_x(c, &ccp, &caddinfo, &cdset); cp = (char*) ccp; addinfo = (char*) caddinfo; diagset = (char*) cdset; } OUTPUT: RETVAL cp addinfo diagset int ZOOM_connection_errcode(c) ZOOM_connection c const char * ZOOM_connection_errmsg(c) ZOOM_connection c const char * ZOOM_connection_addinfo(c) ZOOM_connection c const char * ZOOM_connection_diagset(c) ZOOM_connection c const char * ZOOM_diag_str(error) int error const char * ZOOM_diag_srw_str(error) int error CODE: RETVAL = yaz_diag_srw_str(error); OUTPUT: RETVAL ZOOM_resultset ZOOM_connection_search(arg0, q) ZOOM_connection arg0 ZOOM_query q ZOOM_resultset ZOOM_connection_search_pqf(c, q) ZOOM_connection c const char *q void ZOOM_resultset_destroy(r) ZOOM_resultset r const char * ZOOM_resultset_option_get(r, key) ZOOM_resultset r const char* key void ZOOM_resultset_option_set(r, key, val) ZOOM_resultset r const char* key const char* val size_t ZOOM_resultset_size(r) ZOOM_resultset r SV * ZOOM_resultset_records(r, start, count, return_records) ZOOM_resultset r size_t start size_t count int return_records CODE: { ZOOM_record *recs = 0; if (return_records) recs = (ZOOM_record*) xmalloc(count * sizeof *recs); ZOOM_resultset_records(r, recs, start, count); if (return_records) { AV *av = newAV(); int i; for (i = 0; i < count; i++) { SV *tmp = newSV(0); sv_setref_pv(tmp, "ZOOM_record", (void*) recs[i]); av_push(av, tmp); } RETVAL = newRV((SV*) av); } else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL ZOOM_record ZOOM_resultset_record(s, pos) ZOOM_resultset s size_t pos ZOOM_record ZOOM_resultset_record_immediate(s, pos) ZOOM_resultset s size_t pos void ZOOM_resultset_cache_reset(r) ZOOM_resultset r # TESTED (but deprecated) void ZOOM_resultset_sort(r, sort_type, sort_spec) ZOOM_resultset r const char* sort_type const char* sort_spec int ZOOM_resultset_sort1(r, sort_type, sort_spec) ZOOM_resultset r const char* sort_type const char* sort_spec # See comments for ZOOM_connection_error() above int ZOOM_record_error(rec, cp, addinfo, diagset) ZOOM_record rec const char* &cp const char* &addinfo const char* &diagset CODE: { const char *ccp = "", *caddinfo = "", *cdset = ""; RETVAL = ZOOM_record_error(rec, &ccp, &caddinfo, &cdset); cp = (char*) ccp; addinfo = (char*) caddinfo; diagset = (char*) cdset; } OUTPUT: RETVAL cp addinfo diagset # See "typemap" for discussion of the "const char *" return-type. const char * ZOOM_record_get_string(rec, type) ZOOM_record rec const char* type INIT: int len; CODE: RETVAL = ZOOM_record_get(rec, type, &len); OUTPUT: RETVAL struct datachunk ZOOM_record_get_binary(rec, type) ZOOM_record rec const char* type CODE: RETVAL.data = (char*) ZOOM_record_get(rec, type, &RETVAL.len); OUTPUT: RETVAL void ZOOM_record_destroy(rec) ZOOM_record rec ZOOM_record ZOOM_record_clone(srec) ZOOM_record srec ZOOM_query ZOOM_query_create() void ZOOM_query_destroy(s) ZOOM_query s int ZOOM_query_cql(s, str) ZOOM_query s const char* str int ZOOM_query_cql2rpn(s, str, conn) ZOOM_query s const char* str ZOOM_connection conn int ZOOM_query_ccl2rpn(s, query_str, config, errcode, errstr, errpos) ZOOM_query s const char* query_str const char* config int &errcode const char* &errstr int &errpos OUTPUT: RETVAL errcode errstr errpos int ZOOM_query_prefix(s, str) ZOOM_query s const char* str int ZOOM_query_sortby(s, criteria) ZOOM_query s const char * criteria ZOOM_scanset ZOOM_connection_scan(c, startterm) ZOOM_connection c const char* startterm ZOOM_scanset ZOOM_connection_scan1(c, startterm) ZOOM_connection c ZOOM_query startterm const char * ZOOM_scanset_term(scan, pos, occ, len) ZOOM_scanset scan size_t pos size_t& occ size_t& len OUTPUT: RETVAL occ len const char * ZOOM_scanset_display_term(scan, pos, occ, len) ZOOM_scanset scan size_t pos size_t& occ size_t& len OUTPUT: RETVAL occ len size_t ZOOM_scanset_size(scan) ZOOM_scanset scan void ZOOM_scanset_destroy(scan) ZOOM_scanset scan const char * ZOOM_scanset_option_get(scan, key) ZOOM_scanset scan const char * key void ZOOM_scanset_option_set(scan, key, val) ZOOM_scanset scan const char * key const char * val # We ignore the return value of ZOOM_options_set_callback(), since it # is always just the address of the __ZOOM_option_callback() function. # The information that we actually want -- the address of the Perl # function in the callback_block -- is unavailable to us, as the # underlying C function doesn't give the block back. # void ZOOM_options_set_callback(opt, function, handle) ZOOM_options opt SV* function; SV* handle; CODE: { /* The tiny amount of memory allocated here is never * released, as options_destroy() doesn't do anything * to the callback information. Not a big deal. * Also, I have no idea how to drive the Perl "mortal" * reference-counting stuff, so I am just allocating * copies which also never get released. Don't sue! */ struct callback_block *block = (struct callback_block*) xmalloc(sizeof *block); block->function = function; block->handle = handle; SvREFCNT(block->function); SvREFCNT(block->handle); ZOOM_options_set_callback(opt, __ZOOM_option_callback, (void*) block); } ZOOM_options ZOOM_options_create() ZOOM_options ZOOM_options_create_with_parent(parent) ZOOM_options parent ZOOM_options ZOOM_options_create_with_parent2(parent1, parent2) ZOOM_options parent1 ZOOM_options parent2 const char * ZOOM_options_get(opt, name) ZOOM_options opt const char* name struct datachunk ZOOM_options_getl(opt, name, len) ZOOM_options opt const char* name int &len CODE: RETVAL.data = (char*) ZOOM_options_getl(opt, name, &len); RETVAL.len = len; OUTPUT: RETVAL len void ZOOM_options_set(opt, name, v) ZOOM_options opt const char* name const char* v void ZOOM_options_setl(opt, name, value, len) ZOOM_options opt const char* name opaquechar* value int len void ZOOM_options_destroy(opt) ZOOM_options opt int ZOOM_options_get_bool(opt, name, defa) ZOOM_options opt const char* name int defa int ZOOM_options_get_int(opt, name, defa) ZOOM_options opt const char* name int defa void ZOOM_options_set_int(opt, name, value) ZOOM_options opt const char* name int value ZOOM_package ZOOM_connection_package(c, options) ZOOM_connection c ZOOM_options options void ZOOM_package_destroy(p) ZOOM_package p void ZOOM_package_send(p, type) ZOOM_package p const char * type const char * ZOOM_package_option_get(p, key) ZOOM_package p const char * key void ZOOM_package_option_set(p, key, val) ZOOM_package p const char * key const char * val # This has to be called with a single argument which is a _reference_ # to an array -- rather than directly with an array, which is of # course identical to passing arbitrarily many arguments. This is # because there doesn't seem to be a way to do varargs in an XS # function. # int ZOOM_event(conns) SV* conns INIT: SV *realconns; I32 n, i; ZOOM_connection *cs; CODE: /*printf("* in ZOOM_event(%p)\n", conns);*/ if (!SvROK(conns)) { /*printf("* argument is not a reference\n");*/ XSRETURN_IV(-1); } realconns = SvRV(conns); /*printf("* realconns = %p\n", realconns);*/ if (SvTYPE(realconns) != SVt_PVAV) { /*printf("* reference is not to an array\n");*/ XSRETURN_IV(-2); } n = av_len((AV*) realconns); n++; /* The av_len() return-value is zero-based */ if (n == 0) { /*printf("* No connections in referenced array\n");*/ XSRETURN_IV(-3); } /*printf("* n = %d\n", n);*/ if ((cs = (ZOOM_connection*) malloc(n * sizeof *cs)) == 0) { /*printf("* Too many connections (%d)\n", (int) n);*/ XSRETURN_IV(-4); } for (i = 0; i < n; i++) { SV **connp = av_fetch((AV*) realconns, i, (I32) 0); SV *conn, *sv; /*printf("* %d of %d: connp = %p\n", (int) i, (int) n,connp);*/ assert(connp != 0); conn = *connp; /*printf("* conn = %p\n", conn);*/ /* * From here on, the tests and assertions seem to * be ignored: if I pass in a reference to * something other than a ZOOM_connection, or even * if I pass a non-reference, the assertions still * pass and everything seems to work until the * segmentation fault bites. */ assert(sv_derived_from(conn, "ZOOM_connection")); /*printf("* passed assert(isa(ZOOM_connection))\n");*/ assert(SvROK(conn)); /*printf("* passed assert SvROK()\n");*/ sv = (SV*) SvRV(conn); /*printf("* sv = %p\n", sv);*/ cs[i] = INT2PTR(ZOOM_connection, SvIV(sv)); /*printf("got cs[%d] of %d = %p\n", (int) i, (int) n, cs[i]);*/ } RETVAL = ZOOM_event((int) n, cs); free(cs); OUTPUT: RETVAL int ZOOM_connection_last_event(cs) ZOOM_connection cs int ZOOM_connection_is_idle(cs) ZOOM_connection cs int ZOOM_connection_peek_event(cs) ZOOM_connection cs # ---------------------------------------------------------------------------- # What follows is the YAZ logging API. This is not strictly part of # ZOOM, but it's so useful that it would be silly to omit. int yaz_log_mask_str(str) const char *str int yaz_log_module_level(name) const char *name void yaz_log_init(level, prefix, name) int level const char *prefix const char *name void yaz_log_init_file(fname) const char *fname void yaz_log_init_level(level) int level void yaz_log_init_prefix(prefix) const char *prefix void yaz_log_time_format(fmt) const char *fmt void yaz_log_init_max_size(mx) int mx # <stdarg.h> interfaces are horrible to code for a Perl-C interface # layer. Instead, we expect Perl applications to construct the # message themselves, and pass it in as an opaque lump. void yaz_log(level, str) int level const char *str CODE: yaz_log(level, "%s", str); # This is also not strictly part of ZOOM unsigned long yaz_version(version_str, sys_str) char *version_str char *sys_str OUTPUT: RETVAL version_str sys_str �����������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/samples/������������������������������������������������������������������������0000755�0001750�0001750�00000000000�11403463020�013573� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/samples/README������������������������������������������������������������������0000644�0001750�0001750�00000004057�11403454406�014471� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������This area contains sample programs that exercise all three of the APIs supported by this module. The programs for each API are contained in separate subdirectories: net-z3950-zoom -- Test programs using the low-level Net::Z3950::ZOOM API, which is an as-literal-as-possible translation of the ZOOM-C API. You should almost certainly not bother reading these programs: they are for the benefit of the module maintainers. zoom -- Test programs using the object-oriented ZOOM interface, which is a nice, Perlish interpretation of the ZOOM abstract API as documented at http://zoom.z3950.org/api/ net-z3950 -- Test programs using the obsolescent Net::Z3950 interface, which is provided by this distribution as a plug-compatible replacement for the old Net::Z3950 module. There is no reason to use this API unless you are maintaining an existing application that uses Net::Z3950. In general, each sample program exists in a different version in all three directories, under the same name in each. The programs are: zoomtst1.pl -- A direct translation of the "zoomtst1.c" application from the YAZ distribution, except that these versions go on to fetch the records that they find, whereas the C version is satisfied just to get the hit count. zoomtst3.pl -- A direct translation of the "zoomtst3.c" application from the YAZ distribution -- simultaneous search of multiple targets. Pretty cool :-) async.pl -- A slightly cleverer version of "zoomtst3.pl" which takes advantage of the new END element introduced in YAZ 2.1.17 to display each server's records as soon as they have been received, rather than waiting until all servers have finished their jobs as in every previous ZOOM-based multiplexer. update.pl -- Create a new database and add a record to it. In addition, this "sample" directory contains sample records that are used by the test-suite to exercise the update functionality. These are found in the "records" subdirectory. It also provides a CQL-to-PQF mapping file (copied blindly from the one in the YAZ distribution), found in the "cql" directory. ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/samples/records/����������������������������������������������������������������0000755�0001750�0001750�00000000000�11403463020�015234� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.26/samples/records/esdd0006.grs����������������������������������������������������0000644�0001750�0001750�00000005221�11226575116�017213� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<gils> <Title> UTAH EARTHQUAKE EPICENTERS <Acronym> UUCCSEIS </Acronym> UTAH GEOLOGICAL AND MINERAL SURVEY APPALACHIAN VALLEY; EARTHQUAKE; EPICENTER; SEISMOLOGY; UTAH Five files of epicenter data arranged by date comprise this data set. These files are searchable by magnitude and longitude/latitude. Hardcopy of listing and plot of requested area available. Epicenter location and date, magnitude, and focal depth available. DIGITAL DATA SETS TERRESTRIAL Data are supplied by the University of Utah Seismograph Station. The Utah Geologcial and Mineral Survey (UGMS) is merely a clearinghouse of the data. US STATE UTAH -114 -109 42 37 -PRESENT UTAH GEOLOGICAL AND MINERAL SURVEY 606 BLACK HAWK WAY SALT LAKE CITY UT 84108 USA (801) 581-6831 UTAH EARTHQUAKE EPICENTERS AUTOMATED BATCH 8,700 PC NETWORK SALT LAKE CITY, UT NONE OPERATIONAL BILL CASE UTAH GEOLOGICAL AND MINERAL SURVEY 606 BLACK HAWK WAY SALT LAKE CITY UT 84108 USA (801) 581-6831 ESDD0006 UTAH GEOLOGICAL AND MINERAL SURVEY 198903 Net-Z3950-ZOOM-1.26/samples/zoom/0000755000175000017500000000000011403463020014557 5ustar mikemikeNet-Z3950-ZOOM-1.26/samples/zoom/zoomtst1.pl0000644000175000017500000000217311403454406016727 0ustar mikemike#!/usr/bin/perl -w # See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch zoomtst1.pl use strict; use warnings; use ZOOM; if (@ARGV < 2 || @ARGV %2 == 1) { print STDERR "Usage: $0 target query [