Net-Z3950-ZOOM-1.30/0000755000175000017500000000000012310065753012133 5ustar mikemikeNet-Z3950-ZOOM-1.30/MANIFEST0000644000175000017500000000200312310065753013257 0ustar mikemikeChanges Makefile.PL MANIFEST README typemap ZOOM.xs t/1-Net-Z3950-ZOOM.t t/10-options.t t/11-option-callback.t t/12-query.t t/13-resultset.t t/14-sorting.t t/15-scan.t t/16-packages.t t/17-logging.t t/18-charset.t t/19-events.t t/2-ZOOM.t t/20-options.t t/21-option-callback.t t/22-query.t t/23-resultset.t t/24-sorting.t t/25-scan.t t/26-packages.t t/27-logging.t t/28-charset.t t/29-events.t lib/Net/Z3950/ZOOM.pm lib/ZOOM.pm lib/ZOOM.pod lib/Net/Z3950.pm MANIFEST.SKIP samples/README samples/ccl/default.bib samples/cql/pqf.properties samples/records/esdd0006.grs samples/net-z3950-zoom/zoomtst1.pl samples/net-z3950-zoom/zoomtst3.pl samples/net-z3950-zoom/async.pl samples/net-z3950/zoomtst1.pl samples/zoom/async.pl samples/zoom/trivial-async.pl samples/zoom/update.pl samples/zoom/zhello.pl samples/zoom/zoom-delete-records samples/zoom/zoomdump samples/zoom/zoomscan.pl samples/zoom/zoomtst1.pl samples/zoom/zoomtst3.pl samples/zoom/zselect META.yml Module meta-data (added by MakeMaker) Net-Z3950-ZOOM-1.30/META.yml0000664000175000017500000000105712310065753013411 0ustar mikemike--- #YAML:1.0 name: Net-Z3950-ZOOM version: 1.30 abstract: Perl extension for invoking the ZOOM-C API. author: - Mike Taylor license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: MARC::Record: 1.38 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Net-Z3950-ZOOM-1.30/t/0000755000175000017500000000000012310065753012376 5ustar mikemikeNet-Z3950-ZOOM-1.30/t/18-charset.t0000644000175000017500000000260211403454406014441 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.30/t/21-option-callback.t0000644000175000017500000000357511403454406016056 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.30/t/2-ZOOM.t0000644000175000017500000000562111403454406013511 0ustar mikemike# 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.30/t/19-events.t0000644000175000017500000000727712310065572014332 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('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.30/t/14-sorting.t0000644000175000017500000000465611403454406014504 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.30/t/17-logging.t0000644000175000017500000000270311403454406014437 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.30/t/27-logging.t0000644000175000017500000000137611403454406014445 0ustar mikemike# 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.30/t/1-Net-Z3950-ZOOM.t0000644000175000017500000001016211403454406014760 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.30/t/16-packages.t0000644000175000017500000001571611403454406014576 0ustar mikemike# 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.30/t/15-scan.t0000644000175000017500000001161211456042761013737 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 => 81; 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(lc($disp) eq lc($term), "display term $i ($disp) equivalent to term ($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; # See comment in 25-scan.t #ok((grep { $term eq $_ } @terms), "title term ($term) was in term list (@terms)"); } 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.30/t/26-packages.t0000644000175000017500000001345412234170763014600 0ustar mikemike# 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.30/t/28-charset.t0000644000175000017500000000177111403454406014450 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.30/t/23-resultset.t0000644000175000017500000000601711403454406015042 0ustar mikemike# 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 =~ //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.30/t/25-scan.t���������������������������������������������������������������������0000644�0001750�0001750�00000007652�11456042655�013753� 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 => 81; 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(lc($disp) eq lc($term), "display term $i ($disp) equivalent to term ($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; # Previously we used to assert that the each title-term was # included in the initial term-list that we got by scanning across # all indexes. Of course this will not in general be true, # because not all terms are title terms, which means that the $n # title terms will include some that are past the end of $n # general terms. So remove that test. #ok((grep { $term eq $_ } @terms), "title term ($term) was in term list (@terms)"); } $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.30/t/11-option-callback.t����������������������������������������������������������0000644�0001750�0001750�00000003776�11403454406�016060� 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.30/t/24-sorting.t������������������������������������������������������������������0000644�0001750�0001750�00000003342�11403454406�014474� 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.30/t/22-query.t��������������������������������������������������������������������0000644�0001750�0001750�00000010220�11403454406�014143� 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.30/t/29-events.t�������������������������������������������������������������������0000644�0001750�0001750�00000004103�12310065572�014314� 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('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.30/t/12-query.t��������������������������������������������������������������������0000644�0001750�0001750�00000012674�11403454406�014161� 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.30/t/10-options.t������������������������������������������������������������������0000644�0001750�0001750�00000011240�11403454406�014471� 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 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.30/t/13-resultset.t����������������������������������������������������������������0000644�0001750�0001750�00000010066�11403454406�015040� 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 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 =~ /<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 = 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.30/t/20-options.t������������������������������������������������������������������0000644�0001750�0001750�00000007165�11403454406�014505� 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.30/lib/����������������������������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�012701� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/lib/ZOOM.pod��������������������������������������������������������������������0000644�0001750�0001750�00000156466�12267472532�014223� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; =head1 NAME ZOOM - Perl extension implementing the ZOOM API for Information Retrieval =head1 SYNOPSIS use ZOOM; eval { $conn = new ZOOM::Connection($host, $port, databaseName => "mydb"); $conn->option(preferredRecordSyntax => "usmarc"); $rs = $conn->search_pqf('@attr 1=4 dinosaur'); $n = $rs->size(); print $rs->record(0)->render(); }; if ($@) { print "Error ", $@->code(), ": ", $@->message(), "\n"; } =head1 DESCRIPTION This module provides a nice, Perlish implementation of the ZOOM Abstract API described and documented at http://zoom.z3950.org/api/ the ZOOM module is implemented as a set of thin classes on top of the non-OO functions provided by this distribution's C<Net::Z3950::ZOOM> module, which in turn is a thin layer on top of the ZOOM-C code supplied as part of Index Data's YAZ Toolkit. Because ZOOM-C is also the underlying code that implements ZOOM bindings in C++, Visual Basic, Scheme, Ruby, .NET (including C#) and other languages, this Perl module works compatibly with those other implementations. (Of course, the point of a public API such as ZOOM is that all implementations should be compatible anyway; but knowing that the same code is running is reassuring.) The ZOOM module provides two enumerations (C<ZOOM::Error> and C<ZOOM::Event>), three utility functions C<diag_str()>, C<event_str()> and C<event()> in the C<ZOOM> package itself, and eight classes: C<ZOOM::Exception>, C<ZOOM::Options>, C<ZOOM::Connection>, C<ZOOM::Query>, C<ZOOM::ResultSet>, C<ZOOM::Record>, C<ZOOM::ScanSet> and C<ZOOM::Package>. Of these, the Query class is abstract, and has four concrete subclasses: C<ZOOM::Query::CQL>, C<ZOOM::Query::PQF>, C<ZOOM::Query::CQL2RPN> and C<ZOOM::Query::CCL2RPN>. Finally, it also provides a C<ZOOM::Query::Log> module which supplies a useful general-purpose logging facility. Many useful ZOOM applications can be built using only the Connection, ResultSet, Record and Exception classes, as in the example code-snippet above. A typical application will begin by creating an Connection object, then using that to execute searches that yield ResultSet objects, then fetching records from the result-sets to yield Record objects. If an error occurs, an Exception object is thrown and can be dealt with. More sophisticated applications might also browse the server's indexes to create a ScanSet, from which indexed terms may be retrieved; others might send ``Extended Services'' Packages to the server, to achieve non-standard tasks such as database creation and record update. Searching using a query syntax other than PQF can be done using an query object of one of the Query subclasses. Finally, sets of options may be manipulated independently of the objects they are associated with using an Options object. In general, method calls throw an exception if anything goes wrong, so you don't need to test for success after each call. See the section below on the Exception class for details. =head1 UTILITY FUNCTIONS =head2 ZOOM::diag_str() $msg = ZOOM::diag_str(ZOOM::Error::INVALID_QUERY); Returns a human-readable English-language string corresponding to the error code that is its own parameter. This works for any error-code returned from C<ZOOM::Exception::code()>, C<ZOOM::Connection::error_x()> or C<ZOOM::Connection::errcode()>, irrespective of whether it is a member of the C<ZOOM::Error> enumeration or drawn from the BIB-1 diagnostic set. =head2 ZOOM::diag_srw_str() $msg = ZOOM::diag_srw_str(18); Returns a human-readable English-language string corresponding to the specified SRW error code. =head2 ZOOM::event_str() $msg = ZOOM::event_str(ZOOM::Event::RECV_APDU); Returns a human-readable English-language string corresponding to the event code that is its own parameter. This works for any value of the C<ZOOM::Event> enumeration. =head2 ZOOM::event() $connsRef = [ $conn1, $conn2, $conn3 ]; $which = ZOOM::event($connsRef); $ev = $connsRef->[$which-1]->last_event() if ($which != 0); Used only in complex asynchronous applications, this function takes a reference to a list of Connection objects, waits until an event occurs on any one of them, and returns an integer indicating which of the connections it occurred on. The return value is a 1-based index into the list; 0 is returned if no event occurs within the longest timeout specified by the C<timeout> options of all the connections. See the section below on asynchronous applications. =head1 CLASSES The eight ZOOM classes are described here in ``sensible order'': first, the four commonly used classes, in the he order that they will tend to be used in most programs (Connection, ResultSet, Record, Exception); then the four more esoteric classes in descending order of how often they are needed. With the exception of the Options class, which is an extension to the ZOOM model, the introduction to each class includes a link to the relevant section of the ZOOM Abstract API. =head2 ZOOM::Connection $conn = new ZOOM::Connection("indexdata.dk:210/gils"); print("server is '", $conn->option("serverImplementationName"), "'\n"); $conn->option(preferredRecordSyntax => "usmarc"); $rs = $conn->search_pqf('@attr 1=4 mineral'); $ss = $conn->scan('@attr 1=1003 a'); if ($conn->errcode() != 0) { die("somthing went wrong: " . $conn->errmsg()) } $conn->destroy() This class represents a connection to an information retrieval server, using an IR protocol such as ANSI/NISO Z39.50, SRW (the Search/Retrieve Webservice), SRU (the Search/Retrieve URL) or OpenSearch. Not all of these protocols require a low-level connection to be maintained, but the Connection object nevertheless provides a location for the necessary cache of configuration and state information, as well as a uniform API to the connection-oriented facilities (searching, index browsing, etc.), provided by these protocols. See the description of the C<Connection> class in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html#3.2 =head3 Methods =head4 new() $conn = new ZOOM::Connection("indexdata.dk", 210); $conn = new ZOOM::Connection("indexdata.dk:210/gils"); $conn = new ZOOM::Connection("tcp:indexdata.dk:210/gils"); $conn = new ZOOM::Connection("http:indexdata.dk:210/gils"); $conn = new ZOOM::Connection("indexdata.dk", 210, databaseName => "mydb", preferredRecordSyntax => "marc"); Creates a new Connection object, and immediately connects it to the specified server. If you want to make a new Connection object but delay forging the connection, use the C<create()> and C<connect()> methods instead. This constructor can be called with two arguments or a single argument. In the former case, the arguments are the name and port number of the Z39.50 server to connect to; in the latter case, the single argument is a YAZ service-specifier string of the form When the two-option form is used (which may be done using a vacuous second argument of zero), any number of additional argument pairs may be provided, which are interpreted as key-value pairs to be set as options after the Connection object is created but before it is connected to the server. This is a convenient way to set options, including those that must be set before connecting such as authentication tokens. The server-name string is of the form: =over 4 =item [I<scheme>:]I<host>[:I<port>][/I<databaseName>] =back In which the I<host> and I<port> parts are as in the two-argument form, the I<databaseName> if provided specifies the name of the database to be used in subsequent searches on this connection, and the optional I<scheme> (default C<tcp>) indicates what protocol should be used. At present, the following schemes are supported: =over 4 =item tcp Z39.50 connection. =item ssl Z39.50 connection encrypted using SSL (Secure Sockets Layer). Not many servers support this, but Index Data's Zebra is one that does. =item unix Z39.50 connection on a Unix-domain (local) socket, in which case the I<hostname> portion of the string is instead used as a filename in the local filesystem. =item http SRU connection over HTTP. =back If the C<http> scheme is used, the particular SRU flavour to be used may be specified by the C<sru> option, which takes the following values: =over 4 =item soap SRU over SOAP (i.e. what used to be called SRW). This is the default. =item get "SRU Classic" (i.e. SRU over HTTP GET). =item post SRU over HTTP POST. =back If an error occurs, an exception is thrown. This may indicate a networking problem (e.g. the host is not found or unreachable), or a protocol-level problem (e.g. a Z39.50 server rejected the Init request). =head4 create() / connect() $options = new ZOOM::Options(); $options->option(implementationName => "my client"); $options->option(implementationId => 12345); $conn = create ZOOM::Connection($options) # or $conn = create ZOOM::Connection(implementationName => "my client", implementationId => 12345); $conn->connect($host, 0); The usual Connection constructor, C<new()> brings a new object into existence and forges the connection to the server all in one operation, which is often what you want. For applications that need more control, however, these two methods separate the two steps, allowing additional steps in between such as the setting of options. C<create()> creates and returns a new Connection object, which is I<not> connected to any server. It may be passed an options block, of type C<ZOOM::Options> (see below), into which options may be set before or after the creation of the Connection. Alternatively and equivalently, C<create()> may be passed a list of key-value option pairs directly. The connection to the server may then be forged by the C<connect()> method, which accepts hostname and port arguments like those of the C<new()> constructor. =head4 error_x() / errcode() / errmsg() / addinfo() / diagset() ($errcode, $errmsg, $addinfo, $diagset) = $conn->error_x(); $errcode = $conn->errcode(); $errmsg = $conn->errmsg(); $addinfo = $conn->addinfo(); $diagset = $conn->diagset(); These methods may be used to obtain information about the last error to have occurred on a connection - although typically they will not been used, as the same information is available through the C<ZOOM::Exception> that is thrown when the error occurs. The C<errcode()>, C<errmsg()>, C<addinfo()> and C<diagset()> methods each return one element of the diagnostic, and C<error_x()> returns all four at once. See the C<ZOOM::Exception> for the interpretation of these elements. =head4 exception() die $conn->exception(); C<exception()> returns the same information as C<error_x()> in the form of a C<ZOOM::Exception> object which may be thrown or rendered. If no error occurred on the connection, then C<exception()> returns an undefined value. =head4 check() $conn->check(); Checks whether an error is pending on the connection, and throw a C<ZOOM::Exception> object if so. Since errors are thrown as they occur for synchronous connections, there is no need ever to call this except in asynchronous applications. =head4 option() / option_binary() print("server is '", $conn->option("serverImplementationName"), "'\n"); $conn->option(preferredRecordSyntax => "usmarc"); $conn->option_binary(iconBlob => "foo\0bar"); die if length($conn->option_binary("iconBlob") != 7); Objects of the Connection, ResultSet, ScanSet and Package classes carry with them a set of named options which affect their behaviour in certain ways. See the ZOOM-C options documentation for details: Connection options are listed at http://indexdata.com/yaz/doc/zoom.tkl#zoom.connections These options are set and fetched using the C<option()> method, which may be called with either one or two arguments. In the two-argument form, the option named by the first argument is set to the value of the second argument, and its old value is returned. In the one-argument form, the value of the specified option is returned. For historical reasons, option values are not binary-clean, so that a value containing a NUL byte will be returned in truncated form. The C<option_binary()> method behaves identically to C<option()> except that it is binary-clean, so that values containing NUL bytes are set and returned correctly. =head4 search() / search_pqf() $rs = $conn->search(new ZOOM::Query::CQL('title=dinosaur')); # The next two lines are equivalent $rs = $conn->search(new ZOOM::Query::PQF('@attr 1=4 dinosaur')); $rs = $conn->search_pqf('@attr 1=4 dinosaur'); The principal purpose of a search-and-retrieve protocol is searching (and, er, retrieval), so the principal method used on a Connection object is C<search()>. It accepts a single argument, a C<ZOOM::Query> object (or, more precisely, an object of a subclass of this class); and it creates and returns a new ResultSet object representing the set of records resulting from the search. Since queries using PQF (Prefix Query Format) are so common, we make them a special case by providing a C<search_pqf()> method. This is identical to C<search()> except that it accepts a string containing the query rather than an object, thereby obviating the need to create a C<ZOOM::Query::PQF> object. See the documentation of that class for information about PQF. =head4 scan() / scan_pqf() $rs = $conn->scan(new ZOOM::Query::CQL('title=dinosaur')); # The next two lines are equivalent $rs = $conn->scan(new ZOOM::Query::PQF('@attr 1=4 dinosaur')); $rs = $conn->scan_pqf('@attr 1=4 dinosaur'); Many Z39.50 servers allow you to browse their indexes to find terms to search for. This is done using the C<scan> method, which creates and returns a new ScanSet object representing the set of terms resulting from the scan. C<scan()> takes a single argument, but it has to work hard: it specifies both what index to scan for terms, and where in the index to start scanning. What's more, the specification of what index to scan includes multiple facets, such as what database fields it's an index of (author, subject, title, etc.) and whether to scan for whole fields or single words (e.g. the title ``I<The Empire Strikes Back>'', or the four words ``Back'', ``Empire'', ``Strikes'' and ``The'', interleaved with words from other titles in the same index. All of this is done by using a Query object representing a query of a single term as the C<scan()> argument. The attributes associated with the term indicate which index is to be used, and the term itself indicates the point in the index at which to start the scan. For example, if the argument is the query C<@attr 1=4 fish>, then =over 4 =item @attr 1=4 This is the BIB-1 attribute with type 1 (meaning access-point, which specifies an index), and type 4 (which means ``title''). So the scan is in the title index. =item fish Start the scan from the lexicographically earliest term that is equal to or falls after ``fish''. =back The argument C<@attr 1=4 @attr 6=3 fish> would behave similarly; but the BIB-1 attribute 6=3 mean completeness=``complete field'', so the scan would be for complete titles rather than for words occurring in titles. This takes a bit of getting used to. The behaviour is C<scan()> is affected by the following options, which may be set on the Connection through which the scan is done: =over 4 =item number [default: 10] Indicates how many terms should be returned in the ScanSet. The number actually returned may be less, if the start-point is near the end of the index, but will not be greater. =item position [default: 1] A 1-based index specifying where in the returned list of terms the seed-term should appear. By default it should be the first term returned, but C<position> may be set, for example, to zero (requesting the next terms I<after> the seed-term), or to the same value as C<number> (requesting the index terms I<before> the seed term). =item stepSize [default: 0] An integer indicating how many indexed terms are to be skipped between each one returned in the ScanSet. By default, no terms are skipped, but overriding this can be useful to get a high-level overview of the index. Since scans using PQF (Prefix Query Format) are so common, we make them a special case by providing a C<scan_pqf()> method. This is identical to C<scan()> except that it accepts a string containing the query rather than an object, thereby obviating the need to create a C<ZOOM::Query::PQF> object. =back =head4 package() $p = $conn->package(); $o = new ZOOM::Options(); $o->option(databaseName => "newdb"); $p = $conn->package($o); Creates and returns a new C<ZOOM::Package>, to be used in invoking an Extended Service. An options block may optionally be passed in. See the C<ZOOM::Package> documentation. =head4 last_event() if ($conn->last_event() == ZOOM::Event::CONNECT) { print "Connected!\n"; } Returns a C<ZOOM::Event> enumerated value indicating the type of the last event that occurred on the connection. This is used only in complex asynchronous applications - see the sections below on the C<ZOOM::Event> enumeration and asynchronous applications. =head4 destroy() $conn->destroy() Destroys a Connection object, tearing down any low-level connection associated with it and freeing its resources. It is an error to reuse a Connection that has been C<destroy()>ed. =head2 ZOOM::ResultSet $rs = $conn->search_pqf('@attr 1=4 mineral'); $n = $rs->size(); for $i (1 .. $n) { $rec = $rs->record($i-1); print $rec->render(); } A ResultSet object represents the set of zero or more records resulting from a search, and is the means whereby these records can be retrieved. A ResultSet object may maintain client side cache or some, less, none, all or more of the server's records: in general, this is supposed to an implementaton detail of no interest to a typical application, although more sophisticated applications do have facilities for messing with the cache. Most applications will only need the C<size()>, C<record()> and C<sort()> methods. There is no C<new()> method nor any other explicit constructor. The only way to create a new ResultSet is by using C<search()> (or C<search_pqf()>) on a Connection. See the description of the C<Result Set> class in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html#3.4 =head3 Methods =head4 option() $rs->option(elementSetName => "f"); Allows options to be set into, and read from, a ResultSet, just like the Connection class's C<option()> method. There is no C<option_binary()> method for ResultSet objects. ResultSet options are listed at http://indexdata.com/yaz/doc/zoom.resultsets.tkl =head4 size() print "Found ", $rs->size(), " records\n"; Returns the number of records in the result set. =head4 record() / record_immediate() $rec = $rs->record(0); $rec2 = $rs->record_immediate(0); $rec3 = $rs->record_immediate(1) or print "second record wasn't in cache\n"; The C<record()> method returns a C<ZOOM::Record> object representing a record from result-set, whose position is indicated by the argument passed in. This is a zero-based index, so that legitimate values range from zero to C<$rs-E<gt>size()-1>. The C<record_immediate()> API is identical, but it never invokes a network operation, merely returning the record from the ResultSet's cache if it's already there, or an undefined value otherwise. So if you use this method, B<you must always check the return value>. =head4 records() $rs->records(0, 10, 0); for $i (0..10) { print $rs->record_immediate($i)->render(); } @nextseven = $rs->records(10, 7, 1); The C<record_immediate()> method only fetches records from the cache, whereas C<record()> fetches them from the server if they have not already been cached; but the ZOOM module has to guess what the most efficient strategy for this is. It might fetch each record, alone when asked for: that's optimal in an application that's only interested in the top hit from each search, but pessimal for one that wants to display a whole list of results. Conversely, the software's strategy might be always to ask for blocks of a twenty records: that's great for assembling long lists of things, but wasteful when only one record is wanted. The problem is that the ZOOM module can't tell, when you call C<$rs-E<gt>record()>, what your intention is. But you can tell it. The C<records()> method fetches a sequence of records, all in one go. It takes three arguments: the first is the zero-based index of the first record in the sequence, the second is the number of records to fetch, and the third is a boolean indication of whether or not to return the retrieved records as well as adding them to the cache. (You can always pass 1 for this if you like, and Perl will discard the unused return value, but there is a small efficiency gain to be had by passing 0.) Once the records have been retrieved from the server (i.e. C<records()> has completed without throwing an exception), they can be fetched much more efficiently using C<record()> - or C<record_immediate()>, which is then guaranteed to succeed. =head4 cache_reset() $rs->cache_reset() Resets the ResultSet's record cache, so that subsequent invocations of C<record_immediate()> will fail. I struggle to imagine a real scenario where you'd want to do this. =head4 sort() if ($rs->sort("yaz", "1=4 >i 1=21 >s") < 0) { die "sort failed"; } Sorts the ResultSet in place (discarding any cached records, as they will in general be sorted into a different position). There are two arguments: the first is a string indicating the type of the sort-specification, and the second is the specification itself. The C<sort()> method returns 0 on success, or -1 if the sort-specification is invalid. At present, the only supported sort-specification type is C<yaz>. Such a specification consists of a space-separated sequence of keys, each of which itself consists of two space-separated words (so that the total number of words in the sort-specification is even). The two words making up each key are a field and a set of flags. The field can take one of two forms: if it contains an C<=> sign, then it is a BIB-1 I<type>=I<value> pair specifying which field to sort (e.g. C<1=4> for a title sort); otherwise it is sent for the server to interpret as best it can. The word of flags is made up from one or more of the following: C<s> for case sensitive, C<i> for case insensitive; C<<> for ascending order and C<E<gt>> for descending order. For example, the sort-specification in the code-fragment above will sort the records in C<$rs> case-insensitively in descending order of title, with records having equivalent titles sorted case-sensitively in ascending order of subject. (The BIB-1 access points 4 and 21 represent title and subject respectively.) =head4 destroy() $rs->destroy() Destroys a ResultSet object, freeing its resources. It is an error to reuse a ResultSet that has been C<destroy()>ed. =head2 ZOOM::Record $rec = $rs->record($i); print $rec->render(); $raw = $rec->raw(); $marc = new_from_usmarc MARC::Record($raw); print "Record title is: ", $marc->title(), "\n"; A Record object represents a record that has been retrived from the server. There is no C<new()> method nor any other explicit constructor. The only way to create a new Record is by using C<record()> (or C<record_immediate()>, or C<records()>) on a ResultSet. In general, records are ``owned'' by their result-sets that they were retrieved from, so they do not have to be explicitly memory-managed: they are deallocated (and therefore can no longer be used) when the result-set is destroyed. See the description of the C<Record> class in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html#3.5 =head3 Methods =head4 error() / exception() if ($rec->error()) { my($code, $msg, $addinfo, $dset) = $rec->error(); print "error $code, $msg ($addinfo) from $dset set\n"; die $rec->exception(); } These functions test for surrogate diagnostics associated with a record: that is, errors pertaining to a particular record rather than to the fetch-some-records operation as a whole. (The latter are known in Z39.50 as non-surrogate diagnostics, and are reported as exceptions thrown by searches.) If a particular record can't be obtained - for example, because it is not available in the requested record syntax - then the record object obtained from the result-set, when interrogated with these functions, will report the error. C<error()> returns the error-code, a human-readable message, additional information and the name of the diagnostic set that the error is from. When called in a scalar context, it just returns the error-code. Since error 0 means "no error", it can be used as a boolean has-there-been-an-error indicator. C<exception()> returns the same information in the form of a C<ZOOM::Exception> object which may be thrown or rendered. If no error occurred on the record, then C<exception()> returns an undefined value. =head4 render() print $rec->render(); print $rec->render("charset=latin1,utf8"); Returns a human-readable representation of the record. Beyond that, no promises are made: careful programs should not make assumptions about the format of the returned string. If the optional argument is provided, then it is interpreted as in the C<get()> method (q.v.) This method is useful mostly for debugging. =head4 raw() use MARC::Record; $raw = $rec->raw(); $marc = new_from_usmarc MARC::Record($raw); $trans = $rec->render("charset=latin1,utf8"); Returns an opaque blob of data that is the raw form of the record. Exactly what this is, and what you can do with it, varies depending on the record-syntax. For example, XML records will be returned as, well, XML; MARC records will be returned as ISO 2709-encoded blocks that can be decoded by software such as the fine C<Marc::Record> module; GRS-1 record will be ... gosh, what an interesting question. But no-one uses GRS-1 any more, do they? If the optional argument is provided, then it is interpreted as in the C<get()> method (q.v.) =head4 get() $raw = $rec->get("raw"); $rendered = $rec->get("render"); $trans = $rec->get("render;charset=latin1,utf8"); $trans = $rec->get("render", "charset=latin1,utf8"); This is the underlying method used by C<render()> and C<raw()>, and which in turn delegates to the C<ZOOM_record_get()> function of the underlying ZOOM-C library. Most applications will find it more natural to work with C<render()> and C<raw()>. C<get()> may be called with either one or two arguments. The two-argument form is syntactic sugar: the two arguments are simply joined with a semi-colon to make a single argument, so the third and fourth example invocations above are equivalent. The second argument (or portion of the first argument following the semicolon) is used in the C<type> argument of C<ZOOM_record_get()>, as described in http://www.indexdata.com/yaz/doc/zoom.records.tkl This is useful primarily for invoking the character-set transformation - in the examples above, from ISO Latin-1 to UTF-8 Unicode. =head4 clone() / destroy() $rec = $rs->record($i); $newrec = $rec->clone(); $rs->destroy(); print $newrec->render(); $newrec->destroy(); Usually, it's convenient that Record objects are owned by their ResultSets and go away when the ResultSet is destroyed; but occasionally you need a Record to outlive its parent and destroy it later, explicitly. To do this, C<clone()> the record, keep the new Record object that is returned, and C<destroy()> it when it's no longer needed. This is B<only> situation in which a Record needs to be destroyed. =head2 ZOOM::Exception In general, method calls throw an exception (of class C<ZOOM::Exception>) if anything goes wrong, so you don't need to test for success after each call. Exceptions are caught by enclosing the main code in an C<eval{}> block and checking C<$@> on exit from that block, as in the code-sample above. There are a small number of exceptions to this rule: the three record-fetching methods in the C<ZOOM::ResultSet> class, C<record()>, C<record_immediate()>, and C<records()> can all return undefined values for legitimate reasons, under circumstances that do not merit throwing an exception. For this reason, the return values of these methods should be checked. See the individual methods' documentation for details. An exception carries the following pieces of information: =over 4 =item error-code A numeric code that specifies the type of error. This can be checked for equality with known values, so that intelligent applications can take appropriate action. =item error-message A human-readable message corresponding with the code. This can be shown to users, but its value should not be tested, as it could vary in different versions or under different locales. =item additional information [optional] A string containing information specific to the error-code. For example, when the error-code is the BIB-1 diagnostic 109 ("Database unavailable"), the additional information is the name of the database that the application tried to use. For some error-codes, there is no additional information at all; for some others, the additional information is undefined and may just be an human-readable string. =item diagnostic set [optional] A short string specifying the diagnostic set from which the error-code was drawn: for example, C<ZOOM> for a ZOOM-specific error such as C<ZOOM::Error::MEMORY> ("out of memory"), and C<BIB-1> for a Z39.50 error-code drawn from the BIB-1 diagnostic set. =back In theory, the error-code should be interpreted in the context of the diagnostic set from which it is drawn; in practice, nearly all errors are from either the ZOOM or BIB-1 diagnostic sets, and the codes in those sets have been chosen so as not to overlap, so the diagnostic set can usually be ignored. See the description of the C<Exception> class in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html#3.7 =head3 Methods =head4 new() die new ZOOM::Exception($errcode, $errmsg, $addinfo, $diagset); Creates and returns a new Exception object with the specified error-code, error-message, additional information and diagnostic set. Applications will not in general need to use this, but may find it useful to simulate ZOOM exceptions. As is usual with Perl, exceptions are thrown using C<die()>. =head4 code() / message() / addinfo() / diagset() print "Error ", $@->code(), ": ", $@->message(), "\n"; print "(addinfo '", $@->addinfo(), "', set '", $@->diagset(), "')\n"; These methods, of no arguments, return the exception's error-code, error-message, additional information and diagnostic set respectively. =head4 render() print $@->render(); Returns a human-readable rendition of an exception. The C<""> operator is overloaded on the Exception class, so that an Exception used in a string context is automatically rendered. Among other consequences, this has the useful result that a ZOOM application that died due to an uncaught exception will emit an informative message before exiting. =head2 ZOOM::ScanSet $ss = $conn->scan('@attr 1=1003 a'); $n = $ss->size(); ($term, $occ) = $ss->term($n-1); $rs = $conn->search_pqf('@attr 1=1003 "' . $term . "'"); assert($rs->size() == $occ); A ScanSet represents a set of candidate search-terms returned from an index scan. Its sole purpose is to provide access to those term, to the corresponding display terms, and to the occurrence-counts of the terms. There is no C<new()> method nor any other explicit constructor. The only way to create a new ScanSet is by using C<scan()> on a Connection. See the description of the C<Scan Set> class in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html#3.6 =head3 Methods =head4 size() print "Found ", $ss->size(), " terms\n"; Returns the number of terms in the scan set. In general, this will be the scan-set size requested by the C<number> option in the Connection on which the scan was performed [default 10], but it may be fewer if the scan is close to the end of the index. =head4 term() / display_term() $ss = $conn->scan('@attr 1=1004 whatever'); ($term, $occurrences) = $ss->term(0); ($displayTerm, $occurrences2) = $ss->display_term(0); assert($occurrences == $occurrences2); if (user_likes_the_look_of($displayTerm)) { $rs = $conn->search_pqf('@attr 1=4 "' . $term . '"'); assert($rs->size() == $occurrences); } These methods return the scanned terms themselves. C<term()> returns the term is a form suitable for submitting as part of a query, whereas C<display_term()> returns it in a form suitable for displaying to a user. Both versions also return the number of occurrences of the term in the index, i.e. the number of hits that will be found if the term is subsequently used in a query. In most cases, the term and display term will be identical; however, they may be different in cases where punctuation or case is normalised, or where identifiers rather than the original document terms are indexed. =head4 option() print "scan status is ", $ss->option("scanStatus"); Allows options to be set into, and read from, a ScanSet, just like the Connection class's C<option()> method. There is no C<option_binary()> method for ScanSet objects. ScanSet options are also described, though not particularly informatively, at http://indexdata.com/yaz/doc/zoom.scan.tkl =head4 destroy() $ss->destroy() Destroys a ScanSet object, freeing its resources. It is an error to reuse a ScanSet that has been C<destroy()>ed. =head2 ZOOM::Package $p = $conn->package(); $p->option(action => "specialUpdate"); $p->option(recordIdOpaque => 145); $p->option(record => content_of("/tmp/record.xml")); $p->send("update"); $p->destroy(); This class represents an Extended Services Package: an instruction to the server to do something not covered by the core parts of the Z39.50 standard (or the equivalent in SRW or SRU). Since the core protocols are read-only, such requests are often used to make changes to the database, such as in the record update example above. Requesting an extended service is a four-step process: first, create a package associated with the connection to the relevant database; second, set options on the package to instruct the server on what to do; third, send the package (which may result in an exception being thrown if the server cannot execute the requested operations; and finally, destroy the package. Package options are listed at http://indexdata.com/yaz/doc/zoom.ext.tkl The particular options that have meaning are determined by the top-level operation string specified as the argument to C<send()>. For example, when the operation is C<update> (the most commonly used extended service), the C<action> option may be set to any of C<recordInsert> (add a new record, failing if that record already exists), C<recordDelete> (delete a record, failing if it is not in the database). C<recordReplace> (replace a record, failing if an old version is not already present) or C<specialUpdate> (add a record, replacing any existing version that may be present). For update, the C<record> option should be set to the full text of the XML record to added, deleted or replaced. Depending on how the server is configured, it may extract the record's unique ID from the text (i.e. from a known element such as the C<001> field of a MARCXML record), or it may require the unique ID to passed in explicitly using the C<recordIdOpaque> option. Extended services packages are B<not currently described> in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html They will be added in a forthcoming version, and will function much as those implemented in this module. =head3 Methods =head4 option() $p->option(recordIdOpaque => "46696f6e61"); Allows options to be set into, and read from, a Package, just like the Connection class's C<option()> method. There is no C<option_binary()> method for Package objects. Package options are listed at http://indexdata.com/yaz/doc/zoom.ext.tkl =head4 send() $p->send("create"); Sends a package to the server associated with the Connection that created it. Problems are reported by throwing an exception. The single parameter indicates the operation that the server is being requested to perform, and controls the interpretation of the package's options. Valid operations include: =over 4 =item itemorder Request a copy of a nominated object, e.g. place an ILL request. =item create Create a new database, the name of which is specified by the C<databaseName> option. =item drop Drop an existing database, the name of which is specified by the C<databaseName> option. =item commit Commit changes made to the database within a transaction. =item update Modify the contents of the database by adding, deleting or replacing records (as described above in the overview of the C<ZOOM::Package> class). =item xmlupdate I have no idea what this does. =back Although the module is capable of I<making> all these requests, not all servers are capable of I<executing> them. Refusal is indicated by throwing an exception. Problems may also be caused by lack of privileges; so C<send()> must be used with caution, and is perhaps best wrapped in a clause that checks for execptions, like so: eval { $p->send("create") }; if ($@ && $@->isa("ZOOM::Exception")) { print "Oops! ", $@->message(), "\n"; return $@->code(); } =head4 destroy() $p->destroy() Destroys a Package object, freeing its resources. It is an error to reuse a Package that has been C<destroy()>ed. =head2 ZOOM::Query $q = new ZOOM::Query::CQL("creator=pike and subject=unix"); $q->sortby("1=4 >i 1=21 >s"); $rs = $conn->search($q); $q->destroy(); C<ZOOM::Query> is a virtual base class from which various concrete subclasses can be derived. Different subclasses implement different types of query. The sole purpose of a Query object is to be used in a C<search()> on a Connection; because PQF is such a common special case, the shortcut Connection method C<search_pqf()> is provided. The following Query subclasses are provided, each providing the same set of methods described below: =over 4 =item ZOOM::Query::PQF Implements Prefix Query Format (PQF), also sometimes known as Prefix Query Notation (PQN). This esoteric but rigorous and expressive format is described in the YAZ Manual at http://indexdata.com/yaz/doc/tools.tkl#PQF =item ZOOM::Query::CQL Implements the Common Query Language (CQL) of SRU, the Search/Retrieve URL. CQL is a much friendlier notation than PQF, using a simple infix notation. The queries are passed ``as is'' to the server rather than being compiled into a Z39.50 Type-1 query, so only CQL-compliant servers can support such querier. CQL is described at http://www.loc.gov/standards/sru/cql/ and in a slight out-of-date but nevertheless useful tutorial at http://zing.z3950.org/cql/intro.html =item ZOOM::Query::CQL2RPN Implements CQL by compiling it on the client-side into a Z39.50 Type-1 (RPN) query, and sending that. This provides essentially the same functionality as C<ZOOM::Query::CQL>, but it will work against any standard Z39.50 server rather than only against the small subset that support CQL natively. The drawback is that, because the compilation is done on the client side, a configuration file is required to direct the mapping of CQL constructs such as index names, relations and modifiers into Type-1 query attributes. An example CQL configuration file is included in the ZOOM-Perl distribution, in the file C<samples/cql/pqf.properties> =item ZOOM::Query::CCL2RPN Implements CCL by compiling it on the client-side into a Z39.50 Type-1 (RPN) query, and sending that. Because the compilation is done on the client side, a configuration file is required to direct the mapping of CCL constructs such as index names and boolean operators into Type-1 query attributes. An example CCL configuration file is included in the ZOOM-Perl distribution, in the file C<samples/ccl/default.bib> CCL is syntactically very similar to CQL, but much looser. While CQL is an entirely precise language in which each possible query has rigorously defined semantics, and is thus suitable for transfer as part of a protocol, CCL is best deployed as a human-facing UI language. =back See the description of the C<Query> class in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html#3.3 =head3 Methods =head4 new() $q = new ZOOM::Query::CQL('title=dinosaur'); $q = new ZOOM::Query::PQF('@attr 1=4 dinosaur'); Creates a new query object, compiling the query passed as its argument according to the rules of the particular query-type being instantiated. If compilation fails, an exception is thrown. Otherwise, the query may be passed to the C<Connection> method C<search()>. $conn->option(cqlfile => "samples/cql/pqf.properties"); $q = new ZOOM::Query::CQL2RPN('title=dinosaur', $conn); Note that for the C<ZOOM::Query::CQL2RPN> subclass, the Connection must also be passed into the constructor. This is used for two purposes: first, its C<cqlfile> option is used to find the CQL configuration file that directs the translations into RPN; and second, if compilation fails, then diagnostic information is cached in the Connection and be retrieved using C<$conn-E<gt>errcode()> and related methods. $conn->option(cclfile => "samples/ccl/default.bib"); # or $conn->option(cclqual => "ti u=4 s=pw\nab u=62 s=pw"); $q = new ZOOM::Query::CCL2RPN('ti=dinosaur', $conn); For the C<ZOOM::Query::CCL2RPN> subclass, too, the Connection must be passed into the constructor, for the same reasons as when client-side CQL compilation is used. The C<cclqual> option, if defined, gives a CCL qualification specification inline; otherwise, the contents of the file named by the C<cclfile> option are used. =head4 sortby() $q->sortby("1=4 >i 1=21 >s"); Sets a sort specification into the query, so that when a C<search()> is run on the query, the result is automatically sorted. The sort specification language is the same as the C<yaz> sort-specification type of the C<ResultSet> method C<sort()>, described above. =head4 destroy() $p->destroy() Destroys a Query object, freeing its resources. It is an error to reuse a Query that has been C<destroy()>ed. =head2 ZOOM::Options $o1 = new ZOOM::Options(); $o1->option(user => "alf"); $o2 = new ZOOM::Options(); $o2->option(password => "fruit"); $opts = new ZOOM::Options($o1, $o2); $conn = create ZOOM::Connection($opts); $conn->connect($host); # Uses the specified username and password Several classes of ZOOM objects carry their own sets of options, which can be manipulated using their C<option()> method. Sometimes, however, it's useful to deal with the option sets directly, and the C<ZOOM::Options> class exists to enable this approach. Option sets are B<not currently described> in the ZOOM Abstract API at http://zoom.z3950.org/api/zoom-current.html They are an extension to that specification. =head3 Methods =head4 new() $o1 = new ZOOM::Options(); $o1and2 = new ZOOM::Options($o1); $o3 = new ZOOM::Options(); $o1and3and4 = new ZOOM::Options($o1, $o3); Creates and returns a new option set. One or two (but no more) existing option sets may be passed as arguments, in which case they become ``parents'' of the new set, which thereby ``inherits'' their options, the values of the first parent overriding those of the second when both have a value for the same key. An option set that inherits from a parent that has its own parents also inherits the grandparent's options, and so on. =head4 option() / option_binary() $o->option(preferredRecordSyntax => "usmarc"); $o->option_binary(iconBlob => "foo\0bar"); die if length($o->option_binary("iconBlob") != 7); These methods are used to get and set options within a set, and behave the same way as the same-named C<Connection> methods - see above. As with the C<Connection> methods, values passed to and retrieved using C<option()> are interpreted as NUL-terminated, while those passed to and retrieved from C<option_binary()> are binary-clean. =head4 bool() $o->option(x => "T"); $o->option(y => "F"); assert($o->bool("x", 1)); assert(!$o->bool("y", 1)); assert($o->bool("z", 1)); The first argument is a key, and the second is a default value. Returns the value associated with the specified key as a boolean, or the default value if the key has not been set. The values C<T> (upper case) and C<1> are considered true; all other values (including C<t> (lower case) and non-zero integers other than one) are considered false. This method is provided in ZOOM-C because in a statically typed language it's convenient to have the result returned as an easy-to-test type. In a dynamically typed language such as Perl, this problem doesn't arise, so C<bool()> is nearly useless; but it is made available in case applications need to duplicate the idiosyncratic interpretation of truth and falsehood and ZOOM-C uses. =head4 int() $o->option(x => "012"); assert($o->int("x", 20) == 12); assert($o->int("y", 20) == 20); Returns the value associated with the specified key as an integer, or the default value if the key has not been set. See the description of C<bool()> for why you almost certainly don't want to use this. =head4 set_int() $o->set_int(x => "29"); Sets the value of the specified option as an integer. Of course, Perl happily converts strings to integers on its own, so you can just use C<option()> for this, but C<set_int()> is guaranteed to use the same string-to-integer conversion as ZOOM-C does, which might occasionally be useful. Though I can't imagine how. =head4 set_callback() sub cb { ($udata, $key) = @; return "$udata-$key-$udata"; } $o->set_callback(\&cb, "xyz"); assert($o->option("foo") eq "xyz-foo-xyz"); This method allows a callback function to be installed in an option set, so that the values of options can be calculated algorithmically rather than, as usual, looked up in a table. Along with the callback function itself, an additional datum is provided: when an option is subsequently looked up, this datum is passed to the callback function along with the key; and its return value is returned to the caller as the value of the option. B<Warning.> Although it ought to be possible to specify callback function using the C<\&name> syntax above, or a literal C<sub { code }> code reference, the complexities of the Perl-internal memory management system mean that the function must currently be specified as a string containing the fully-qualified name, e.g. C<"main::cb">.> B<Warning.> The current implementation of the this method leaks memory, not only when the callback is installed, but on every occasion that it is consulted to look up an option value. =head4 destroy() $o->destroy() Destroys an Options object, freeing its resources. It is an error to reuse an Options object that has been C<destroy()>ed. =head1 ENUMERATIONS The ZOOM module provides two enumerations that list possible return values from particular functions. They are described in the following sections. =head2 ZOOM::Error if ($@->code() == ZOOM::Error::QUERY_PQF) { return "your query was not accepted"; } This class provides a set of manifest constants representing some of the possible error codes that can be raised by the ZOOM module. The methods that return error-codes are C<ZOOM::Exception::code()>, C<ZOOM::Connection::error_x()> and C<ZOOM::Connection::errcode()>. The C<ZOOM::Error> class provides the constants C<NONE>, C<CONNECT>, C<MEMORY>, C<ENCODE>, C<DECODE>, C<CONNECTION_LOST>, C<ZINIT>, C<INTERNAL>, C<TIMEOUT>, C<UNSUPPORTED_PROTOCOL>, C<UNSUPPORTED_QUERY>, C<INVALID_QUERY>, C<CQL_PARSE>, C<CQL_TRANSFORM>, C<CCL_CONFIG>, C<CCL_PARSE>, C<CREATE_QUERY>, C<QUERY_CQL>, C<QUERY_PQF>, C<SORTBY>, C<CLONE>, C<PACKAGE>, C<SCANTERM> and C<LOGLEVEL>, each of which specifies a client-side error. These codes constitute the C<ZOOM> diagnostic set. Since errors may also be diagnosed by the server, and returned to the client, error codes may also take values from the BIB-1 diagnostic set of Z39.50, listed at the Z39.50 Maintenance Agency's web-site at http://www.loc.gov/z3950/agency/defns/bib1diag.html All error-codes, whether client-side from the C<ZOOM::Error> enumeration or server-side from the BIB-1 diagnostic set, can be translated into human-readable messages by passing them to the C<ZOOM::diag_str()> utility function. =head2 ZOOM::Event if ($conn->last_event() == ZOOM::Event::CONNECT) { print "Connected!\n"; } In applications that need it - mostly complex multiplexing applications - The C<ZOOM::Connection::last_event()> method is used to return an indication of the last event that occurred on a particular connection. It always returns a value drawn from this enumeration, that is, one of C<NONE>, C<CONNECT>, C<SEND_DATA>, C<RECV_DATA>, C<TIMEOUT>, C<UNKNOWN>, C<SEND_APDU>, C<RECV_APDU>, C<RECV_RECORD>, C<RECV_SEARCH> or C<ZEND>. See the section below on asynchronous applications. =head1 LOGGING ZOOM::Log::init_level(ZOOM::Log::mask_str("zoom,myapp,-warn")); ZOOM::Log::log("myapp", "starting up with pid ", $$); Logging facilities are provided by a set of functions in the C<ZOOM::Log> module. Note that C<ZOOM::Log> is not a class, and it is not possible to create C<ZOOM::Log> objects: the API is imperative, reflecting that of the underlying YAZ logging facilities. Although there are nine logging functions altogether, you can ignore nearly all of them: most applications that use logging will begin by calling C<mask_str()> and C<init_level()> once each, as above, and will then repeatedly call C<log()>. =head2 mask_str() $level = ZOOM::Log::mask_str("zoom,myapp,-warn"); Returns an integer corresponding to the log-level specified by the parameter. This is a string of zero or more comma-separated module-names, each indicating an individual module to be either added to the default log-level or removed from it (for those components prefixed by a minus-sign). The names may be those of either standard YAZ-logging modules such as C<fatal>, C<debug> and C<warn>, or custom modules such as C<myapp> in the example above. The module C<zoom> requests logging from the ZOOM module itself, which may be helpful for debugging. Note that calling this function does not in any way change the logging state: it merely returns a value. To change the state, this value must be passed to C<init_level()>. =head2 module_level() $level = ZOOM::Log::module_level("zoom"); ZOOM::Log::log($level, "all systems clear: thrusters invogriated"); Returns the integer corresponding to the single log-level specified as the parameter, or zero if that level has not been registered by a prior call to C<mask_str()>. Since C<log()> accepts either a numeric log-level or a string, there is no reason to call this function; but, what the heck, maybe you enjoy that kind of thing. Who are we to judge? =head2 init_level() ZOOM::Log::init_level($level); Initialises the log-level to the specified integer, which is a bitmask of values, typically as returned from C<mask_str()>. All subsequent calls to C<log()> made with a log-level that matches one of the bits in this mask will result in a log-message being emitted. All logging can be turned off by calling C<init_level(0)>. =head2 init_prefix() ZOOM::Log::init_prefix($0); Initialises a prefix string to be included in all log-messages. =head2 init_file() ZOOM::Log::init_file("/tmp/myapp.log"); Initialises the output file to be used for logging: subsequent log-messages are written to the nominated file. If this function is not called, log-messages are written to the standard error stream. =head2 init() ZOOM::Log::init($level, $0, "/tmp/myapp.log"); Initialises the log-level, the logging prefix and the logging output file in a single operation. =head2 time_format() ZOOM::Log::time_format("%Y-%m-%d %H:%M:%S"); Sets the format in which log-messages' timestamps are emitted, by means of a format-string like that used in the C function C<strftime()>. The example above emits year, month, day, hours, minutes and seconds in big-endian order, such that timestamps can be sorted lexicographically. =head2 init_max_size() (This doesn't seem to work, so I won't bother describing it.) =head2 log() ZOOM::Log::log(8192, "reducing to warp-factor $wf"); ZOOM::Log::log("myapp", "starting up with pid ", $$); Provided that the first argument, log-level, is among the modules previously established by C<init_level()>, this function emits a log-message made up of a timestamp, the prefix supplied to C<init_prefix()>, if any, and the concatenation of all arguments after the first. The message is written to the standard output stream, or to the file previous specified by C<init_file()> if this has been called. The log-level argument may be either a numeric value, as returned from C<module_level()>, or a string containing the module name. =head1 ASYNCHRONOUS APPLICATIONS Although asynchronous applications are conceptually complex, the ZOOM support for them is provided through a very simple interface, consisting of one option (C<async>), one function (C<ZOOM::event()>), one Connection method (C<last_event()> and an enumeration (C<ZOOM::Event>). The approach is as follows: =over 4 =item Initialisation Create several connections to the various servers, each of them having the option C<async> set, and with whatever additional options are required - e.g. the piggyback retrieval record-count can be set so that records will be returned in search responses. =item Operations Send searches to the connections, request records, etc. =item Event harvesting Repeatedly call C<ZOOM::event()> to discover what responses are being received from the servers. Each time this function returns, it indicates which of the connections has fired; this connection can then be interrogated with the C<last_event()> method to discover what event has occurred, and the return value - an element of the C<ZOOM::Event> enumeration - can be tested to determine what to do next. For example, the C<ZEND> event indicates that no further operations are outstanding on the connection, so any fetched records can now be immediately obtained. =back Here is a very short program (omitting all error-checking!) which demonstrates this process. It parallel-searches three servers (or more of you add them the list), displaying the first record in the result-set of each server as soon as it becomes available. use ZOOM; @servers = ('z3950.loc.gov:7090/Voyager', 'z3950.indexdata.com:210/gils', 'agricola.nal.usda.gov:7190/Voyager'); for ($i = 0; $i < @servers; $i++) { $z[$i] = new ZOOM::Connection($servers[$i], 0, async => 1, # asynchronous mode count => 1, # piggyback retrieval count preferredRecordSyntax => "usmarc"); $r[$i] = $z[$i]->search_pqf("mineral"); } while (($i = ZOOM::event(\@z)) != 0) { $ev = $z[$i-1]->last_event(); print("connection ", $i-1, ": ", ZOOM::event_str($ev), "\n"); if ($ev == ZOOM::Event::ZEND) { $size = $r[$i-1]->size(); print "connection ", $i-1, ": $size hits\n"; print $r[$i-1]->record(0)->render() if $size > 0; } } =head1 SEE ALSO The ZOOM abstract API, http://zoom.z3950.org/api/zoom-current.html The C<Net::Z3950::ZOOM> module, included in the same distribution as this one. The C<Net::Z3950> module, which this one supersedes. http://perl.z3950.org/ The documentation for the ZOOM-C module of the YAZ Toolkit, which this module is built on. Specifically, its lists of options are useful. http://indexdata.com/yaz/doc/zoom.tkl The BIB-1 diagnostic set of Z39.50, http://www.loc.gov/z3950/agency/defns/bib1diag.html =head1 AUTHOR Mike Taylor, E<lt>mike@indexdata.comE<gt> =head1 COPYRIGHT AND LICENCE Copyright (C) 2005-2014 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. =cut 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/lib/ZOOM.pm���������������������������������������������������������������������0000644�0001750�0001750�00000070063�12106162121�014017� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use IO::File; use Net::Z3950::ZOOM; package ZOOM; # Member naming convention: hash-element names which begin with an # underscore represent underlying ZOOM-C object descriptors; those # which lack them represent Perl's ZOOM objects. (The same convention # is used in naming local variables where appropriate.) # # So, for example, the ZOOM::Connection class has an {_conn} element, # which is a pointer to the ZOOM-C Connection object; but the # ZOOM::ResultSet class has a {conn} element, which is a reference to # the Perl-level Connection object by which it was created. (It may # be that we find we have no need for these references, but for now # they are retained.) # # To get at the underlying ZOOM-C connection object of a result-set # (if you ever needed to do such a thing, which you probably don't) # you'd use $rs->{conn}->_conn(). # ---------------------------------------------------------------------------- # The "Error" package contains constants returned as error-codes. package ZOOM::Error; sub NONE { Net::Z3950::ZOOM::ERROR_NONE } sub CONNECT { Net::Z3950::ZOOM::ERROR_CONNECT } sub MEMORY { Net::Z3950::ZOOM::ERROR_MEMORY } sub ENCODE { Net::Z3950::ZOOM::ERROR_ENCODE } sub DECODE { Net::Z3950::ZOOM::ERROR_DECODE } sub CONNECTION_LOST { Net::Z3950::ZOOM::ERROR_CONNECTION_LOST } sub ZINIT { Net::Z3950::ZOOM::ERROR_INIT } sub INTERNAL { Net::Z3950::ZOOM::ERROR_INTERNAL } sub TIMEOUT { Net::Z3950::ZOOM::ERROR_TIMEOUT } sub UNSUPPORTED_PROTOCOL { Net::Z3950::ZOOM::ERROR_UNSUPPORTED_PROTOCOL } sub UNSUPPORTED_QUERY { Net::Z3950::ZOOM::ERROR_UNSUPPORTED_QUERY } sub INVALID_QUERY { Net::Z3950::ZOOM::ERROR_INVALID_QUERY } sub CQL_PARSE { Net::Z3950::ZOOM::ERROR_CQL_PARSE } sub CQL_TRANSFORM { Net::Z3950::ZOOM::ERROR_CQL_TRANSFORM } sub CCL_CONFIG { Net::Z3950::ZOOM::ERROR_CCL_CONFIG } sub CCL_PARSE { Net::Z3950::ZOOM::ERROR_CCL_PARSE } # The following are added specifically for this OO interface sub CREATE_QUERY { 20001 } sub QUERY_CQL { 20002 } sub QUERY_PQF { 20003 } sub SORTBY { 20004 } sub CLONE { 20005 } sub PACKAGE { 20006 } sub SCANTERM { 20007 } sub LOGLEVEL { 20008 } # Separate space for CCL errors. Great. package ZOOM::CCL::Error; sub OK { Net::Z3950::ZOOM::CCL_ERR_OK } sub TERM_EXPECTED { Net::Z3950::ZOOM::CCL_ERR_TERM_EXPECTED } sub RP_EXPECTED { Net::Z3950::ZOOM::CCL_ERR_RP_EXPECTED } sub SETNAME_EXPECTED { Net::Z3950::ZOOM::CCL_ERR_SETNAME_EXPECTED } sub OP_EXPECTED { Net::Z3950::ZOOM::CCL_ERR_OP_EXPECTED } sub BAD_RP { Net::Z3950::ZOOM::CCL_ERR_BAD_RP } sub UNKNOWN_QUAL { Net::Z3950::ZOOM::CCL_ERR_UNKNOWN_QUAL } sub DOUBLE_QUAL { Net::Z3950::ZOOM::CCL_ERR_DOUBLE_QUAL } sub EQ_EXPECTED { Net::Z3950::ZOOM::CCL_ERR_EQ_EXPECTED } sub BAD_RELATION { Net::Z3950::ZOOM::CCL_ERR_BAD_RELATION } sub TRUNC_NOT_LEFT { Net::Z3950::ZOOM::CCL_ERR_TRUNC_NOT_LEFT } sub TRUNC_NOT_BOTH { Net::Z3950::ZOOM::CCL_ERR_TRUNC_NOT_BOTH } sub TRUNC_NOT_RIGHT { Net::Z3950::ZOOM::CCL_ERR_TRUNC_NOT_RIGHT } # The "Event" package contains constants returned by last_event() package ZOOM::Event; sub NONE { Net::Z3950::ZOOM::EVENT_NONE } sub CONNECT { Net::Z3950::ZOOM::EVENT_CONNECT } sub SEND_DATA { Net::Z3950::ZOOM::EVENT_SEND_DATA } sub RECV_DATA { Net::Z3950::ZOOM::EVENT_RECV_DATA } sub TIMEOUT { Net::Z3950::ZOOM::EVENT_TIMEOUT } sub UNKNOWN { Net::Z3950::ZOOM::EVENT_UNKNOWN } sub SEND_APDU { Net::Z3950::ZOOM::EVENT_SEND_APDU } sub RECV_APDU { Net::Z3950::ZOOM::EVENT_RECV_APDU } sub RECV_RECORD { Net::Z3950::ZOOM::EVENT_RECV_RECORD } sub RECV_SEARCH { Net::Z3950::ZOOM::EVENT_RECV_SEARCH } sub ZEND { Net::Z3950::ZOOM::EVENT_END } # ---------------------------------------------------------------------------- package ZOOM; sub diag_str { my($code) = @_; # Special cases for error specific to the OO layer if ($code == ZOOM::Error::CREATE_QUERY) { return "can't create query object"; } elsif ($code == ZOOM::Error::QUERY_CQL) { return "can't set CQL query"; } elsif ($code == ZOOM::Error::QUERY_PQF) { return "can't set prefix query"; } elsif ($code == ZOOM::Error::SORTBY) { return "can't set sort-specification"; } elsif ($code == ZOOM::Error::CLONE) { return "can't clone record"; } elsif ($code == ZOOM::Error::PACKAGE) { return "can't create package"; } elsif ($code == ZOOM::Error::SCANTERM) { return "can't retrieve term from scan-set"; } elsif ($code == ZOOM::Error::LOGLEVEL) { return "unregistered log-level"; } return Net::Z3950::ZOOM::diag_str($code); } sub diag_srw_str { my($code) = @_; return Net::Z3950::ZOOM::diag_srw_str($code); } sub event_str { return Net::Z3950::ZOOM::event_str(@_); } sub event { my($connsref) = @_; my @_connsref = map { $_->_conn() } @$connsref; return Net::Z3950::ZOOM::event(\@_connsref); } sub _oops { my($code, $addinfo, $diagset) = @_; die new ZOOM::Exception($code, undef, $addinfo, $diagset); } # ---------------------------------------------------------------------------- package ZOOM::Exception; sub new { my $class = shift(); my($code, $message, $addinfo, $diagset) = @_; $diagset ||= "ZOOM"; if (uc($diagset) eq "ZOOM" || uc($diagset) eq "BIB-1") { $message ||= ZOOM::diag_str($code); } elsif (lc($diagset) eq "info:srw/diagnostic/1") { $message ||= ZOOM::diag_srw_str($code); } else { # Should fill in messages for any other known diagsets. $message ||= "(unknown error)"; } return bless { code => $code, message => $message, addinfo => $addinfo, diagset => $diagset, }, $class; } sub code { my $this = shift(); return $this->{code}; } sub message { my $this = shift(); return $this->{message}; } sub addinfo { my $this = shift(); return $this->{addinfo}; } sub diagset { my $this = shift(); return $this->{diagset}; } sub render { my $this = shift(); my $res = "ZOOM error " . $this->code(); $res .= ' "' . $this->message() . '"' if $this->message(); $res .= ' (addinfo: "' . $this->addinfo() . '")' if $this->addinfo(); $res .= " from diag-set '" . $this->diagset() . "'" if $this->diagset(); return $res; } # This means that untrapped exceptions render nicely. use overload '""' => \&render; # ---------------------------------------------------------------------------- package ZOOM::Options; sub new { my $class = shift(); my($p1, $p2) = @_; my $opts; if (@_ == 0) { $opts = Net::Z3950::ZOOM::options_create(); } elsif (@_ == 1) { $opts = Net::Z3950::ZOOM::options_create_with_parent($p1->_opts()); } elsif (@_ == 2) { $opts = Net::Z3950::ZOOM::options_create_with_parent2($p1->_opts(), $p2->_opts()); } else { die "can't make $class object with more than 2 parents"; } return bless { _opts => $opts, }, $class; } # PRIVATE to this class and ZOOM::Connection::create() and # ZOOM::Connection::package() # sub _opts { my $this = shift(); my $_opts = $this->{_opts}; die "{_opts} undefined: has this Options block been destroy()ed?" if !defined $_opts; return $_opts; } sub option { my $this = shift(); my($key, $value) = @_; my $oldval = Net::Z3950::ZOOM::options_get($this->_opts(), $key); Net::Z3950::ZOOM::options_set($this->_opts(), $key, $value) if defined $value; return $oldval; } sub option_binary { my $this = shift(); my($key, $value) = @_; my $dummylen = 0; my $oldval = Net::Z3950::ZOOM::options_getl($this->_opts(), $key, $dummylen); Net::Z3950::ZOOM::options_setl($this->_opts(), $key, $value, length($value)) if defined $value; return $oldval; } # This is a bit stupid, since the scalar values that Perl returns from # option() can be used as a boolean; but it's just possible that some # applications will rely on ZOOM_options_get_bool()'s idiosyncratic # interpretation of what constitutes truth. # sub bool { my $this = shift(); my($key, $default) = @_; return Net::Z3950::ZOOM::options_get_bool($this->_opts(), $key, $default); } # .. and the next two are even more stupid sub int { my $this = shift(); my($key, $default) = @_; return Net::Z3950::ZOOM::options_get_int($this->_opts(), $key, $default); } sub set_int { my $this = shift(); my($key, $value) = @_; Net::Z3950::ZOOM::options_set_int($this->_opts(), $key, $value); } # ### Feel guilty. Feel very, very guilty. I've not been able to # get the callback memory-management right in "ZOOM.xs", with # the result that the values of $function and $udata passed into # this function, which are on the stack, have sometimes been # freed by the time they're used by __ZOOM_option_callback(), # with hilarious results. To avoid this, I copy the values into # module-scoped globals, and pass _those_ into the extension # function. To avoid overwriting those globals by subsequent # calls, I keep all the old ones, pushed onto the @_function and # @_udata arrays, which means that THIS FUNCTION LEAKS MEMORY # LIKE IT'S GOING OUT OF FASHION. Not nice. One day, I should # fix this, but for now there's more important fish to fry. # my(@_function, @_udata); sub set_callback { my $o1 = shift(); my($function, $udata) = @_; push @_function, $function; push @_udata, $udata; Net::Z3950::ZOOM::options_set_callback($o1->_opts(), $_function[-1], $_udata[-1]); } sub destroy { my $this = shift(); Net::Z3950::ZOOM::options_destroy($this->_opts()); $this->{_opts} = undef; } # ---------------------------------------------------------------------------- package ZOOM::Connection; sub new { my $class = shift(); my($host, $port, @options) = @_; my $conn = $class->create(@options); $conn->{host} = $host; $conn->{port} = $port; Net::Z3950::ZOOM::connection_connect($conn->_conn(), $host, $port || 0); $conn->_check(); return $conn; } # PRIVATE to this class, to ZOOM::event() and to ZOOM::Query::CQL2RPN::new() sub _conn { my $this = shift(); my $_conn = $this->{_conn}; die "{_conn} undefined: has this Connection been destroy()ed?" if !defined $_conn; return $_conn; } sub _check { my $this = shift(); my($always_die_on_error) = @_; my($errcode, $errmsg, $addinfo, $diagset) = (undef, "x", "x", "x"); $errcode = Net::Z3950::ZOOM::connection_error_x($this->_conn(), $errmsg, $addinfo, $diagset); if ($errcode) { my $exception = new ZOOM::Exception($errcode, $errmsg, $addinfo, $diagset); if (!$this->option("async") || $always_die_on_error) { ZOOM::Log::log("zoom_check", "throwing error $exception"); die $exception; } else { ZOOM::Log::log("zoom_check", "not reporting error $exception"); } } } # This wrapper for _check() is called only from outside the ZOOM # module, and therefore only in situations where an asynchronous # application is actively asking for an exception to be thrown if an # error has been detected. So it passed always_die_on_error=1 to the # underlying _check() method. # sub check { my $this = shift(); return $this->_check(1); } sub create { my $class = shift(); my(@options) = @_; my $_opts; if (@_ == 1) { $_opts = $_[0]->_opts(); } else { $_opts = Net::Z3950::ZOOM::options_create(); while (@options >= 2) { my $key = shift(@options); my $val = shift(@options); Net::Z3950::ZOOM::options_set($_opts, $key, $val); } die "Odd number of options specified" if @options; } my $_conn = Net::Z3950::ZOOM::connection_create($_opts); my $conn = bless { host => undef, port => undef, _conn => $_conn, }, $class; return $conn; } sub error_x { my $this = shift(); my($errcode, $errmsg, $addinfo, $diagset) = (undef, "dummy", "dummy", "d"); $errcode = Net::Z3950::ZOOM::connection_error_x($this->_conn(), $errmsg, $addinfo, $diagset); return wantarray() ? ($errcode, $errmsg, $addinfo, $diagset) : $errcode; } sub exception { my $this = shift(); my($errcode, $errmsg, $addinfo, $diagset) = $this->error_x(); return undef if $errcode == 0; return new ZOOM::Exception($errcode, $errmsg, $addinfo, $diagset); } sub errcode { my $this = shift(); return Net::Z3950::ZOOM::connection_errcode($this->_conn()); } sub errmsg { my $this = shift(); return Net::Z3950::ZOOM::connection_errmsg($this->_conn()); } sub addinfo { my $this = shift(); return Net::Z3950::ZOOM::connection_addinfo($this->_conn()); } sub diagset { my $this = shift(); return Net::Z3950::ZOOM::connection_diagset($this->_conn()); } sub connect { my $this = shift(); my($host, $port) = @_; $port = 0 if !defined $port; Net::Z3950::ZOOM::connection_connect($this->_conn(), $host, $port); $this->_check(); # No return value } sub option { my $this = shift(); my($key, $value) = @_; my $oldval = Net::Z3950::ZOOM::connection_option_get($this->_conn(), $key); Net::Z3950::ZOOM::connection_option_set($this->_conn(), $key, $value) if defined $value; return $oldval; } sub option_binary { my $this = shift(); my($key, $value) = @_; my $dummylen = 0; my $oldval = Net::Z3950::ZOOM::connection_option_getl($this->_conn(), $key, $dummylen); Net::Z3950::ZOOM::connection_option_setl($this->_conn(), $key, $value, length($value)) if defined $value; return $oldval; } sub search { my $this = shift(); my($query) = @_; my $_rs = Net::Z3950::ZOOM::connection_search($this->_conn(), $query->_query()); $this->_check(); return _new ZOOM::ResultSet($this, $query, $_rs); } sub search_pqf { my $this = shift(); my($pqf) = @_; my $_rs = Net::Z3950::ZOOM::connection_search_pqf($this->_conn(), $pqf); $this->_check(); return _new ZOOM::ResultSet($this, $pqf, $_rs); } sub scan_pqf { my $this = shift(); my($startterm) = @_; my $_ss = Net::Z3950::ZOOM::connection_scan($this->_conn(), $startterm); $this->_check(); return _new ZOOM::ScanSet($this, $startterm, $_ss); } sub scan { my $this = shift(); my($query) = @_; my $_ss = Net::Z3950::ZOOM::connection_scan1($this->_conn(), $query->_query()); $this->_check(); return _new ZOOM::ScanSet($this, $query, $_ss); } sub package { my $this = shift(); my($options) = @_; my $_o = defined $options ? $options->_opts() : Net::Z3950::ZOOM::options_create(); my $_p = Net::Z3950::ZOOM::connection_package($this->_conn(), $_o) or ZOOM::_oops(ZOOM::Error::PACKAGE); return _new ZOOM::Package($this, $options, $_p); } sub last_event { my $this = shift(); return Net::Z3950::ZOOM::connection_last_event($this->_conn()); } sub is_idle { my $this = shift(); return Net::Z3950::ZOOM::connection_is_idle($this->_conn()); } sub peek_event { my $this = shift(); return Net::Z3950::ZOOM::connection_peek_event($this->_conn()); } sub destroy { my $this = shift(); Net::Z3950::ZOOM::connection_destroy($this->_conn()); $this->{_conn} = undef; } # ---------------------------------------------------------------------------- package ZOOM::Query; sub new { my $class = shift(); die "You can't create $class objects: it's a virtual base class"; } # PRIVATE to this class and ZOOM::Connection::search() sub _query { my $this = shift(); my $_query = $this->{_query}; die "{_query} undefined: has this Query been destroy()ed?" if !defined $_query; return $_query; } sub sortby { my $this = shift(); my($sortby) = @_; Net::Z3950::ZOOM::query_sortby($this->_query(), $sortby) == 0 or ZOOM::_oops(ZOOM::Error::SORTBY, $sortby); } sub sortby2 { my $this = shift(); my($strategy, $sortby) = @_; Net::Z3950::ZOOM::query_sortby2($this->_query(), $strategy, $sortby) == 0 or ZOOM::_oops(ZOOM::Error::SORTBY, $sortby); } sub destroy { my $this = shift(); Net::Z3950::ZOOM::query_destroy($this->_query()); $this->{_query} = undef; } package ZOOM::Query::CQL; our @ISA = qw(ZOOM::Query); sub new { my $class = shift(); my($string) = @_; my $q = Net::Z3950::ZOOM::query_create() or ZOOM::_oops(ZOOM::Error::CREATE_QUERY); Net::Z3950::ZOOM::query_cql($q, $string) == 0 or ZOOM::_oops(ZOOM::Error::QUERY_CQL, $string); return bless { _query => $q, }, $class; } package ZOOM::Query::CQL2RPN; our @ISA = qw(ZOOM::Query); sub new { my $class = shift(); my($string, $conn) = @_; my $q = Net::Z3950::ZOOM::query_create() or ZOOM::_oops(ZOOM::Error::CREATE_QUERY); # check() throws the exception we want; but we only want it on failure! Net::Z3950::ZOOM::query_cql2rpn($q, $string, $conn->_conn()) == 0 or $conn->_check(); return bless { _query => $q, }, $class; } # We have to work around the retarded ZOOM_query_ccl2rpn() API package ZOOM::Query::CCL2RPN; our @ISA = qw(ZOOM::Query); sub new { my $class = shift(); my($string, $conn) = @_; my $q = Net::Z3950::ZOOM::query_create() or ZOOM::_oops(ZOOM::Error::CREATE_QUERY); my $config = $conn->option("cclqual"); if (!defined $config) { my $cclfile = $conn->option("cclfile") or ZOOM::_oops(ZOOM::Error::CCL_CONFIG, "no 'cclqual' or 'cclfile' specified"); my $fh = new IO::File("<$cclfile") or ZOOM::_oops(ZOOM::Error::CCL_CONFIG, "can't open cclfile '$cclfile': $!"); $config = join("", <$fh>); $fh->close(); } my($ccl_errcode, $ccl_errstr, $ccl_errpos) = (0, "", 0); if (Net::Z3950::ZOOM::query_ccl2rpn($q, $string, $config, $ccl_errcode, $ccl_errstr, $ccl_errpos) < 0) { # We have no use for $ccl_errcode or $ccl_errpos ZOOM::_oops(ZOOM::Error::CCL_PARSE, $ccl_errstr); } return bless { _query => $q, }, $class; } package ZOOM::Query::PQF; our @ISA = qw(ZOOM::Query); sub new { my $class = shift(); my($string) = @_; my $q = Net::Z3950::ZOOM::query_create() or ZOOM::_oops(ZOOM::Error::CREATE_QUERY); Net::Z3950::ZOOM::query_prefix($q, $string) == 0 or ZOOM::_oops(ZOOM::Error::QUERY_PQF, $string); return bless { _query => $q, }, $class; } # ---------------------------------------------------------------------------- package ZOOM::ResultSet; sub new { my $class = shift(); die "You can't create $class objects directly"; } # PRIVATE to ZOOM::Connection::search() and ZOOM::Connection::search_pqf() sub _new { my $class = shift(); my($conn, $query, $_rs) = @_; return bless { conn => $conn, query => $query, # This is not currently used, which is # just as well since it could be # either a string (when the RS is # created with search_pqf()) or a # ZOOM::Query object (when it's # created with search()) _rs => $_rs, }, $class; } # PRIVATE to this class sub _rs { my $this = shift(); my $_rs = $this->{_rs}; die "{_rs} undefined: has this ResultSet been destroy()ed?" if !defined $_rs; return $_rs; } sub option { my $this = shift(); my($key, $value) = @_; my $oldval = Net::Z3950::ZOOM::resultset_option_get($this->_rs(), $key); Net::Z3950::ZOOM::resultset_option_set($this->_rs(), $key, $value) if defined $value; return $oldval; } sub size { my $this = shift(); return Net::Z3950::ZOOM::resultset_size($this->_rs()); } sub record { my $this = shift(); my($which) = @_; my $_rec = Net::Z3950::ZOOM::resultset_record($this->_rs(), $which); $this->{conn}->_check(); # Even if no error has occurred, I think record() might # legitimately return undef if we're running in asynchronous mode # and the record just hasn't been retrieved yet. This goes double # for record_immediate(). return undef if !defined $_rec; # For some reason, I have to use the explicit "->" syntax in order # to invoke the ZOOM::Record constructor here, even though I don't # have to do the same for _new ZOOM::ResultSet above. Weird. return ZOOM::Record->_new($this, $which, $_rec); } sub record_immediate { my $this = shift(); my($which) = @_; my $_rec = Net::Z3950::ZOOM::resultset_record_immediate($this->_rs(), $which); $this->{conn}->_check(); # The record might legitimately not be there yet return undef if !defined $_rec; return ZOOM::Record->_new($this, $which, $_rec); } sub cache_reset { my $this = shift(); Net::Z3950::ZOOM::resultset_cache_reset($this->_rs()); } sub records { my $this = shift(); my($start, $count, $return_records) = @_; # If the request is out of range, ZOOM-C will currently (as of YAZ # 2.1.38) no-op: it understandably refuses to build and send a # known-bad APDU, but it doesn't set a diagnostic as it ought. So # for now, we do it here. It would be more polite to stash the # error-code in the ZOOM-C connection object for subsequent # discovery (which is what ZOOM-C will presumably do itself when # it's fixed) but since there is no API that allows us to do that, # we just have to throw the exception right now. That's probably # OK for synchronous applications, but not really for # multiplexers. my $size = $this->size(); if ($start + $count-1 >= $size) { # BIB-1 diagnostic 13 is "Present request out-of-range" ZOOM::_oops(13, undef, "BIB-1"); } my $raw = Net::Z3950::ZOOM::resultset_records($this->_rs(), $start, $count, $return_records); # By design, $raw may be undefined (if $return_records is true) return undef if !defined $raw; # We need to package up the returned records in ZOOM::Record objects my @res = (); for my $i (0 .. @$raw-1) { my $_rec = $raw->[$i]; if (!defined $_rec) { push @res, undef; } else { push @res, ZOOM::Record->_new($this, $start+$i, $_rec); } } return \@res; } sub sort { my $this = shift(); my($sort_type, $sort_spec) = @_; return Net::Z3950::ZOOM::resultset_sort1($this->_rs(), $sort_type, $sort_spec); } sub destroy { my $this = shift(); Net::Z3950::ZOOM::resultset_destroy($this->_rs()); $this->{_rs} = undef; } # ---------------------------------------------------------------------------- package ZOOM::Record; sub new { my $class = shift(); die "You can't create $class objects directly"; } # PRIVATE to ZOOM::ResultSet::record(), # ZOOM::ResultSet::record_immediate(), ZOOM::ResultSet::records() and # ZOOM::Record::clone() # sub _new { my $class = shift(); my($rs, $which, $_rec) = @_; return bless { rs => $rs, which => $which, _rec => $_rec, }, $class; } # PRIVATE to this class sub _rec { my $this = shift(); my $_rec = $this->{_rec}; die "{_rec} undefined: has this Record been destroy()ed?" if !defined $_rec; return $_rec; } sub error { my $this = shift(); my($errcode, $errmsg, $addinfo, $diagset) = (undef, "dummy", "dummy", "d"); $errcode = Net::Z3950::ZOOM::record_error($this->_rec(), $errmsg, $addinfo, $diagset); return wantarray() ? ($errcode, $errmsg, $addinfo, $diagset) : $errcode; } sub exception { my $this = shift(); my($errcode, $errmsg, $addinfo, $diagset) = $this->error(); return undef if $errcode == 0; return new ZOOM::Exception($errcode, $errmsg, $addinfo, $diagset); } sub render { my $this = shift(); return $this->get("render", @_); } sub raw { my $this = shift(); return $this->get("raw", @_); } sub get { my $this = shift(); my($type, $args) = @_; $type = "$type;$args" if defined $args; return Net::Z3950::ZOOM::record_get($this->_rec(), $type); } sub clone { my $this = shift(); my $raw = Net::Z3950::ZOOM::record_clone($this->_rec()) or ZOOM::_oops(ZOOM::Error::CLONE); # Arg 1 (rs) is undefined as the new record doesn't belong to an RS return _new ZOOM::Record(undef, undef, $raw); } sub destroy { my $this = shift(); Net::Z3950::ZOOM::record_destroy($this->_rec()); $this->{_rec} = undef; } # ---------------------------------------------------------------------------- package ZOOM::ScanSet; sub new { my $class = shift(); die "You can't create $class objects directly"; } # PRIVATE to ZOOM::Connection::scan(), sub _new { my $class = shift(); my($conn, $startterm, $_ss) = @_; return bless { conn => $conn, startterm => $startterm,# This is not currently used, which is # just as well since it could be # either a string (when the SS is # created with scan()) or a # ZOOM::Query object (when it's # created with scan1()) _ss => $_ss, }, $class; } # PRIVATE to this class sub _ss { my $this = shift(); my $_ss = $this->{_ss}; die "{_ss} undefined: has this ScanSet been destroy()ed?" if !defined $_ss; return $_ss; } sub option { my $this = shift(); my($key, $value) = @_; my $oldval = Net::Z3950::ZOOM::scanset_option_get($this->_ss(), $key); Net::Z3950::ZOOM::scanset_option_set($this->_ss(), $key, $value) if defined $value; return $oldval; } sub size { my $this = shift(); return Net::Z3950::ZOOM::scanset_size($this->_ss()); } sub term { my $this = shift(); my($which) = @_; my($occ, $len) = (0, 0); my $term = Net::Z3950::ZOOM::scanset_term($this->_ss(), $which, $occ, $len) or ZOOM::_oops(ZOOM::Error::SCANTERM); die "length of term '$term' differs from returned len=$len" if length($term) != $len; return ($term, $occ); } sub display_term { my $this = shift(); my($which) = @_; my($occ, $len) = (0, 0); my $term = Net::Z3950::ZOOM::scanset_display_term($this->_ss(), $which, $occ, $len) or ZOOM::_oops(ZOOM::Error::SCANTERM); die "length of display term '$term' differs from returned len=$len" if length($term) != $len; return ($term, $occ); } sub destroy { my $this = shift(); Net::Z3950::ZOOM::scanset_destroy($this->_ss()); $this->{_ss} = undef; } # ---------------------------------------------------------------------------- package ZOOM::Package; sub new { my $class = shift(); die "You can't create $class objects directly"; } # PRIVATE to ZOOM::Connection::package(), sub _new { my $class = shift(); my($conn, $options, $_p) = @_; return bless { conn => $conn, options => $options, _p => $_p, }, $class; } # PRIVATE to this class sub _p { my $this = shift(); my $_p = $this->{_p}; die "{_p} undefined: has this Package been destroy()ed?" if !defined $_p; return $_p; } sub option { my $this = shift(); my($key, $value) = @_; my $oldval = Net::Z3950::ZOOM::package_option_get($this->_p(), $key); Net::Z3950::ZOOM::package_option_set($this->_p(), $key, $value) if defined $value; return $oldval; } sub send { my $this = shift(); my($type) = @_; Net::Z3950::ZOOM::package_send($this->_p(), $type); $this->{conn}->_check(); } sub destroy { my $this = shift(); Net::Z3950::ZOOM::package_destroy($this->_p()); $this->{_p} = undef; } # There follows trivial support for YAZ logging. This is wired out # into the Net::Z3950::ZOOM package, and we here provide wrapper # functions -- nothing more than aliases, really -- in the ZOOM::Log # package. There really is no point in inventing an OO interface. # # Passing @_ directly to the underlying Net::Z3950::ZOOM::* functions # doesn't work, for reasons that I can't begin to fathom, and that # don't particularly interest me. Unpacking into scalars and passing # those _does_ work, so that's what we do. package ZOOM::Log; sub mask_str { my($a) = @_; Net::Z3950::ZOOM::yaz_log_mask_str($a); } sub module_level { my($a) = @_; Net::Z3950::ZOOM::yaz_log_module_level($a); } sub init { my($a, $b, $c) = @_; Net::Z3950::ZOOM::yaz_log_init($a, $b, $c) } sub init_file { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_file($a) } sub init_level { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_level($a) } sub init_prefix { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_prefix($a) } sub time_format { my($a) = @_; Net::Z3950::ZOOM::yaz_log_time_format($a) } sub init_max_size { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_max_size($a) } sub log { my($level, @message) = @_; if ($level !~ /^(0x)?\d+$/) { # Assuming its log-level name, we look it up. my $num = module_level($level); ZOOM::_oops(ZOOM::Error::LOGLEVEL, $level) if $num == 0; $level = $num; } Net::Z3950::ZOOM::yaz_log($level, join("", @message)); } BEGIN { ZOOM::Log::mask_str("zoom_check"); } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/lib/Net/������������������������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�013427� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/lib/Net/Z3950/������������������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�014161� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/lib/Net/Z3950/ZOOM.pm�����������������������������������������������������������0000644�0001750�0001750�00000013372�12310065572�015310� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Net::Z3950::ZOOM; use 5.008; use strict; use warnings; our $VERSION = '1.30'; require XSLoader; XSLoader::load('Net::Z3950::ZOOM', $VERSION); my($vs, $ss) = ("x" x 100, "x" x 100); # allocate space for these strings my $version = Net::Z3950::ZOOM::yaz_version($vs, $ss); if ($version < 0x040000 && ! -f "/tmp/ignore-ZOOM-YAZ-version-mismatch") { warn <<__EOT__; *** WARNING! ZOOM-Perl requires at least version 4.0.0 of YAZ, but is currently running against only version $vs (sys-string '$ss'). Some things may not work. __EOT__ } # The only thing this module does is define the following constants, # which MUST BE KEPT SYNCHRONISED with the definitions in <yaz/zoom.h> # Error codes, as returned from connection_error() sub ERROR_NONE { 0 } sub ERROR_CONNECT { 10000 } sub ERROR_MEMORY { 10001 } sub ERROR_ENCODE { 10002 } sub ERROR_DECODE { 10003 } sub ERROR_CONNECTION_LOST { 10004 } sub ERROR_INIT { 10005 } sub ERROR_INTERNAL { 10006 } sub ERROR_TIMEOUT { 10007 } sub ERROR_UNSUPPORTED_PROTOCOL { 10008 } sub ERROR_UNSUPPORTED_QUERY { 10009 } sub ERROR_INVALID_QUERY { 10010 } sub ERROR_CQL_PARSE { 10011 } sub ERROR_CQL_TRANSFORM { 10012 } sub ERROR_CCL_CONFIG { 10013 } sub ERROR_CCL_PARSE { 10014 } # Event types, as returned from connection_last_event() sub EVENT_NONE { 0 } sub EVENT_CONNECT { 1 } sub EVENT_SEND_DATA { 2 } sub EVENT_RECV_DATA { 3 } sub EVENT_TIMEOUT { 4 } sub EVENT_UNKNOWN { 5 } sub EVENT_SEND_APDU { 6 } sub EVENT_RECV_APDU { 7 } sub EVENT_RECV_RECORD { 8 } sub EVENT_RECV_SEARCH { 9 } sub EVENT_END { 10 } # In YAZ 2.1.17 and later # CCL error-codes, which are in a different space from the ZOOM errors sub CCL_ERR_OK { 0 } sub CCL_ERR_TERM_EXPECTED { 1 } sub CCL_ERR_RP_EXPECTED { 2 } sub CCL_ERR_SETNAME_EXPECTED { 3 } sub CCL_ERR_OP_EXPECTED { 4 } sub CCL_ERR_BAD_RP { 5 } sub CCL_ERR_UNKNOWN_QUAL { 6 } sub CCL_ERR_DOUBLE_QUAL { 7 } sub CCL_ERR_EQ_EXPECTED { 8 } sub CCL_ERR_BAD_RELATION { 9 } sub CCL_ERR_TRUNC_NOT_LEFT { 10 } sub CCL_ERR_TRUNC_NOT_BOTH { 11 } sub CCL_ERR_TRUNC_NOT_RIGHT { 12 } =head1 NAME Net::Z3950::ZOOM - Perl extension for invoking the ZOOM-C API. =head1 SYNOPSIS use Net::Z3950::ZOOM; $conn = Net::Z3950::ZOOM::connection_new($host, $port); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); Net::Z3950::ZOOM::connection_option_set($conn, databaseName => "foo"); # etc. =head1 DESCRIPTION This module provides a simple thin-layer through to the ZOOM-C functions in the YAZ toolkit for Z39.50 and SRW/U communication. You should not be using this very nasty, low-level API. You should be using the C<ZOOM> module instead, which implements a nice, Perlish API on top of this module, conformant to the ZOOM Abstract API described at http://zoom.z3950.org/api/ To enforce the don't-use-this-module prohibition, I am not even going to document it. If you really, really, really want to use it, then it pretty much follows the API described in the ZOOM-C documentation at http://www.indexdata.dk/yaz/doc/zoom.tkl The only additional (non-ZOOM-C) function provided by this module is C<event_str()>, which takes as its argument an event code such as C<Net::Z3950::ZOOM::EVENT_SEND_APDU>, and returns a corresponding short string. =cut sub event_str { my($code) = @_; if ($code == EVENT_NONE) { return "none"; } elsif ($code == EVENT_CONNECT) { return "connect"; } elsif ($code == EVENT_SEND_DATA) { return "send data"; } elsif ($code == EVENT_RECV_DATA) { return "receive data"; } elsif ($code == EVENT_TIMEOUT) { return "timeout"; } elsif ($code == EVENT_UNKNOWN) { return "unknown"; } elsif ($code == EVENT_SEND_APDU) { return "send apdu"; } elsif ($code == EVENT_RECV_APDU) { return "receive apdu"; } elsif ($code == EVENT_RECV_RECORD) { return "receive record"; } elsif ($code == EVENT_RECV_SEARCH) { return "receive search"; } elsif ($code == EVENT_END) { return "end"; } return "impossible event " . $code; } # Switch API variant depending on $type. This works because the # get_string() and get_binary() functions have different returns # types, one of which is implemented as a NUL-terminated string and # the other as a pointer-and-length structure. # # Some Z39.50 servers, when asked for an OPAC-format record in the # case where no circulation information is available, will return a # USMARC record rather than an OPAC record containing only a # bibliographic part. This non-OPAC records is not recognised by the # underlying record_get() code in ZOOM-C, which ends up returning a # null pointer. To make life a little less painful when dealing with # such servers until ZOOM-C is fixed, this code recognises the # wrong-record-syntax case and returns the XML for the bibliographic # part anyway. # sub record_get { my($rec, $type) = @_; my $simpletype = $type; $simpletype =~ s/;.*//; if (grep { $type eq $_ } qw(database syntax schema)) { return record_get_string($rec, $type); } else { my $val = record_get_binary($rec, $type); if ($simpletype eq "opac" && !defined $val) { my $newtype = $type; if ($newtype !~ s/.*?;/xml;/) { $newtype = "xml"; } $val = record_get_binary($rec, $newtype); $val = ("<opacRecord>\n <bibliographicRecord>\n" . $val . " </bibliographicRecord>\n</opacRecord>"); } return $val; } } =head1 SEE ALSO The C<ZOOM> module, included in the same distribution as this one. =head1 AUTHOR Mike Taylor, E<lt>mike@indexdata.comE<gt> =head1 COPYRIGHT AND LICENCE Copyright (C) 2005-2014 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. =cut 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/lib/Net/Z3950.pm����������������������������������������������������������������0000644�0001750�0001750�00000013550�11403454405�014521� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Net::Z3950::ZOOM; our $VERSION = '0.99'; # Supersedes "proper" Net::Z3950 v0.51 # Member naming convention is the same as in ../ZOOM.pm # ---------------------------------------------------------------------------- # Enumerations are copied from the old Net::Z3950 module. # It's not entirely clear yet which of these we actually need, for for # now I am commenting them all out, and faulting in the ones we need. # ---------------------------------------------------------------------------- # Define the operation-code enumeration. The values here are chosen # to be in a distinctive range (i.e. 3950 plus a small integer) so # that if they are misused in another context, they're easy to spot. package Net::Z3950::Op; sub Error { 3951 } sub Init { 3952 } sub Search { 3953 } sub Get { 3954 } sub DeleteRS { 3955 } sub Scan { 3956 } package Net::Z3950; ## Define the record-syntax enumeration. These values must be kept ## synchronised with the values implied by the oid_value enumeration in ## the header file "yaz/oid.h" #package Net::Z3950::RecordSyntax; #sub UNIMARC { 16 } #sub INTERMARC { 17 } #sub CCF { 18 } #sub USMARC { 19 } #sub UKMARC { 20 } #sub NORMARC { 21 } #sub LIBRISMARC { 22 } #sub DANMARC { 23 } #sub FINMARC { 24 } #sub MAB { 25 } #sub CANMARC { 26 } #sub SBN { 27 } #sub PICAMARC { 28 } #sub AUSMARC { 29 } #sub IBERMARC { 30 } #sub CATMARC { 31 } #sub MALMARC { 32 } #sub EXPLAIN { 33 } #sub SUTRS { 34 } #sub OPAC { 35 } #sub SUMMARY { 36 } #sub GRS0 { 37 } #sub GRS1 { 38 } #sub EXTENDED { 39 } #sub TEXT_HTML { 70 } #sub XML { 80 } #sub TEXT_XML { 80 } #sub APPLICATION_XML { 81 } # #use vars '%map'; ## Maps record-syntax name strings to enumeration members #%map = (UNIMARC => UNIMARC, # INTERMARC => INTERMARC, # CCF => CCF, # USMARC => USMARC, # UKMARC => UKMARC, # NORMARC => NORMARC, # LIBRISMARC => LIBRISMARC, # DANMARC => DANMARC, # FINMARC => FINMARC, # MAB => MAB, # CANMARC => CANMARC, # SBN => SBN, # PICAMARC => PICAMARC, # AUSMARC => AUSMARC, # IBERMARC => IBERMARC, # CATMARC => CATMARC, # MALMARC => MALMARC, # EXPLAIN => EXPLAIN, # SUTRS => SUTRS, # OPAC => OPAC, # SUMMARY => SUMMARY, # GRS0 => GRS0, # GRS1 => GRS1, # EXTENDED => EXTENDED, # TEXT_HTML => TEXT_HTML, # XML => XML, # TEXT_XML => TEXT_XML, # APPLICATION_XML => APPLICATION_XML, # ); #package Net::Z3950; # # ## Define the reason-for-decodeAPDU()-failure enumeration. This must ## be kept synchronised with the values #defined in "yazwrap/yazwrap.h" #package Net::Z3950::Reason; #sub EOF { 23951 } # read EOF from connection (server gone) #sub Incomplete { 23952 } # read bytes, but not yet a whole APDU #sub Malformed { 23953 } # couldn't decode APDU (malformed) #sub BadAPDU { 23954 } # APDU was well-formed but unrecognised #sub Error { 23955 } # some other error (consult errno) #package Net::Z3950; # # ## Define the query-type enumeration. This must be kept synchronised ## with the values #defined in "yazwrap/yazwrap.h" #package Net::Z3950::QueryType; #sub Prefix { 39501 } # Yaz's "@attr"-ish forward-Polish notation #sub CCL { 39502 } # Send CCL string to server ``as is'' #sub CCL2RPN { 39503 } # Convert CCL to RPN (type-1) locally #sub CQL { 39504 } # Send CQL string to server ``as is'' #package Net::Z3950; # # ## Define the result-set-status enumeration, used by the ## `resultSetStatus' field in the Net::Z3950::APDU::SearchResponse ## class in cases where `searchStatus' is false (indicating failure). ## This must be kept synchronised with the ASN.1 for the structure ## described in section 3.2.2.1.11 of the Z39.50 standard itself. #package Net::Z3950::ResultSetStatus; #sub Subset { 1 } #sub Interim { 2 } #sub None { 3 } #package Net::Z3950; # # ## Define the present-status enumeration, used by the `presentStatus' ## field in the Net::Z3950::APDU::SearchResponse class in cases where ## `searchStatus' is true (indicating success). This must be kept ## synchronised with the ASN.1 for the structure described in section ## 3.2.2.1.11 of the Z39.50 standard itself. #package Net::Z3950::PresentStatus; #sub Success { 0 } #sub Partial1 { 1 } #sub Partial2 { 2 } #sub Partial3 { 3 } #sub Partial4 { 4 } #sub Failure { 5 } #package Net::Z3950; # # ## Define the scan-status enumeration, used by the `scanStatus' ## field in the Net::Z3950::APDU::ScanResponse class. This must be ## kept synchronised with the ASN.1 for the structure described in ## section 3.2.8.1.6 of the Z39.50 standard itself. #package Net::Z3950::ScanStatus; #sub Success { 0 } #sub Partial1 { 1 } #sub Partial2 { 2 } #sub Partial3 { 3 } #sub Partial4 { 4 } #sub Partial5 { 5 } #sub Failure { 6 } #package Net::Z3950; # ---------------------------------------------------------------------------- package Net::Z3950; sub errstr { my($errcode) = @_; # This is not 100% compatible, because it will translate # ZOOM-level errors as well as BIB-1 diagnostic codes. return Net::Z3950::ZOOM::diag_str($errcode) } sub opstr { my($op) = @_; return "error" if $op == Net::Z3950::Op::Error; return "init" if $op == Net::Z3950::Op::Init; return "search" if $op == Net::Z3950::Op::Search; return "get" if $op == Net::Z3950::Op::Get; return "deleteRS" if $op == Net::Z3950::Op::DeleteRS; return "scan" if $op == Net::Z3950::Op::Scan; return "unknown op " . $op; } # ---------------------------------------------------------------------------- package Net::Z3950::Manager; sub new { Net::Z3950::Connection->new() } # ---------------------------------------------------------------------------- package Net::Z3950::Connection; sub new { die "The Net::Z3950::ZOOM distribution does not yet support the Net::Z3950 'Classic' API. A subsequent version will do so; until then, please continue using Net::Z3950 itself if you need its API." } 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/ZOOM.xs�������������������������������������������������������������������������0000644�0001750�0001750�00000033721�12106162121�013267� 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 int ZOOM_query_sortby2(s, strategy, criteria) ZOOM_query s const char * strategy 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.30/README��������������������������������������������������������������������������0000644�0001750�0001750�00000004367�12267472532�013035� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������The 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-2014 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.30/MANIFEST.SKIP�������������������������������������������������������������������0000644�0001750�0001750�00000000157�11430536345�014036� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.cvsignore .git debian lib/CVS t/CVS archive build-stamp install-stamp IDMETA mkdist.sh modules zoom-perl.spec �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/typemap�������������������������������������������������������������������������0000644�0001750�0001750�00000004631�11403454406�013540� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ZOOM_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.30/Changes�������������������������������������������������������������������������0000644�0001750�0001750�00000037235�12310065572�013437� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Revision history for Perl extension Net::Z3950::ZOOM. 1.30 Wed Mar 12 14:08:26 CET 2014 - Update test 19-events.t and 29-events.t Events check: allow for multiple Connect events - Require YAZ 4 or later - Require perl-XML-LibXML-XPathContext on RHEL/CentOS v5 only. 1.29 Mon Oct 14 10:41:28 CEST 2013 - Debian/RPM packages now built with YAZ 5. - Do not depend on libyaz4-devel in Debian package (only required for building) - Include the useful example program samples/zoom-delete-records which is installed as part of "make install". - Fix documentation of connect() method so that it doesn't imply that it can accept options. 1.28 Fri Oct 15 13:34:41 BST 2010 - In the test-suite, provide a more explicit report when the scan identity test (display term == term) fails. - The displayTerm==term assertion is now case-insensitive, as it ought always to have been: previously, the test-suite relied on a specific implementaton detail of the test-server, which has recently changed causing extraneous test-suite failures. - Also in the test-suite for scan, remove the test that all title-terms are in the general-term list, an assumption that should never have been made. 1.27 Wed Aug 11 17:13:07 BST 2010 - Support for Index Data build procedures, including making Debian/Ubuntu and Red Hat packages from clean tarballs. - No upstream changes -- packaging only. 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 <yaz/log.h>" 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.30/Makefile.PL���������������������������������������������������������������������0000644�0001750�0001750�00000004743�12310065572�014114� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# 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 $yazconf = "yaz-config"; my $yazver = `$yazconf --version`; my $yazinc = `$yazconf --cflags threads`; my $yazlibs = `$yazconf --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, "4.0.0"); # 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 <mike@>') : ()), 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', 'samples/zoom/zoom-delete-records' ], ); 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 -us -uc -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.30/samples/������������������������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�013577� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/cql/��������������������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�014356� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/cql/pqf.properties������������������������������������������������������0000644�0001750�0001750�00000011174�11403454405�017264� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Propeties file to drive org.z3950.zing.cql.CQLNode's toPQF() # back-end and the YAZ CQL-to-PQF converter. This specifies the # interpretation of various CQL indexes, relations, etc. in terms # of Type-1 query attributes. # # This configuration file generates queries using BIB-1 attributes. # See http://www.loc.gov/z3950/agency/zing/cql/dc-indexes.html # for the Maintenance Agency's work-in-progress mapping of Dublin Core # indexes to Attribute Architecture (util, XD and BIB-2) # attributes. # Identifiers for prefixes used in this file. (index.*) set.cql = info:srw/cql-context-set/1/cql-v1.1 set.rec = info:srw/cql-context-set/2/rec-1.0 set.dc = info:srw/cql-context-set/1/dc-v1.1 set.bath = http://zing.z3950.org/cql/bath/2.0/ # default set (in query) set = info:srw/cql-context-set/1/dc-v1.1 # The default access point and result-set references index.cql.serverChoice = 1=1016 # srw.serverChoice is deprecated in favour of cql.serverChoice # BIB-1 "any" index.rec.id = 1=12 index.dc.title = 1=4 index.dc.subject = 1=21 index.dc.creator = 1=1003 index.dc.author = 1=1003 ### Unofficial synonym for "creator" index.dc.editor = 1=1020 index.dc.publisher = 1=1018 index.dc.description = 1=62 # "abstract" index.dc.date = 1=30 index.dc.resourceType = 1=1031 # guesswork: "Material-type" index.dc.format = 1=1034 # guesswork: "Content-type" index.dc.resourceIdentifier = 1=12 # "Local number" index.dc.source = 1=1019 # "Record-source" index.dc.language = 1=54 # "Code--language" index.dc.relation = 1=? ### No idea how to represent this index.dc.coverage = 1=? ### No idea how to represent this index.dc.rights = 1=? ### No idea how to represent this # Relation attributes are selected according to the CQL relation by # looking up the "relation.<relation>" property: # relation.< = 2=1 relation.le = 2=2 relation.eq = 2=3 relation.exact = 2=3 relation.ge = 2=4 relation.> = 2=5 relation.<> = 2=6 ### These two are not really right: relation.all = 2=3 relation.any = 2=3 # BIB-1 doesn't have a server choice relation, so we just make the # choice here, and use equality (which is clearly correct). relation.scr = 2=3 # Relation modifiers. # relationModifier.relevant = 2=102 relationModifier.fuzzy = 2=100 ### 100 is "phonetic", which is not quite the same thing relationModifier.stem = 2=101 relationModifier.phonetic = 2=100 # Position attributes may be specified for anchored terms (those # beginning with "^", which is stripped) and unanchored (those not # beginning with "^"). This may change when we get a BIB-1 truncation # attribute that says "do what CQL does". # position.first = 3=1 6=1 # "first in field" position.any = 3=3 6=1 # "any position in field" position.last = 3=4 6=1 # not a standard BIB-1 attribute position.firstAndLast = 3=3 6=3 # search term is anchored to be complete field # Structure attributes may be specified for individual relations; a # default structure attribute my be specified by the pseudo-relation # "*", to be used whenever a relation not listed here occurs. # structure.exact = 4=108 # string structure.all = 4=2 structure.any = 4=2 structure.* = 4=1 # phrase # Truncation attributes used to implement CQL wildcard patterns. The # simpler forms, left, right- and both-truncation will be used for the # simplest patterns, so that we produce PQF queries that conform more # closely to the Bath Profile. However, when a more complex pattern # such as "foo*bar" is used, we fall back on Z39.58-style masking. # truncation.right = 5=1 truncation.left = 5=2 truncation.both = 5=3 truncation.none = 5=100 truncation.z3958 = 5=104 # Finally, any additional attributes that should always be included # with each term can be specified in the "always" property. # always = 6=1 # 6=1: completeness = incomplete subfield # Bath Profile support, added Thu Dec 18 13:06:20 GMT 2003 # See the Bath Profile for SRW at # http://zing.z3950.org/cql/bath.html # including the Bath Context Set defined within that document. # # In this file, we only map index-names to BIB-1 use attributes, doing # so in accordance with the specifications of the Z39.50 Bath Profile, # and leaving the relations, wildcards, etc. to fend for themselves. index.bath.keyTitle = 1=33 index.bath.possessingInstitution = 1=1044 index.bath.name = 1=1002 index.bath.personalName = 1=1 index.bath.corporateName = 1=2 index.bath.conferenceName = 1=3 index.bath.uniformTitle = 1=6 index.bath.isbn = 1=7 index.bath.issn = 1=8 index.bath.geographicName = 1=58 index.bath.notes = 1=63 index.bath.topicalSubject = 1=1079 index.bath.genreForm = 1=1075 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/net-z3950-zoom/���������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�016137� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/net-z3950-zoom/async.pl�������������������������������������������������0000644�0001750�0001750�00000005540�11403454405�017613� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch zoomtst3.pl <t1> [...] <tN> <query> # for example: # perl -I../../blib/lib -I../../blib/arch async.pl z3950.loc.gov:7090/Voyager z3950.indexdata.com:210/gils endeavor.flo.org:7090/Voyager mineral use strict; use warnings; use Net::Z3950::ZOOM; if (@ARGV < 2) { print STDERR "Usage: $0 target1 target2 ... targetN query\n"; print STDERR " eg. $0 z3950.indexdata.dk/gils localhost:9999 fish\n"; exit 1; } my $n = @ARGV-1; my(@z, @r); # connections, result sets my $o = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set($o, async => 1); # Get first 10 records of result set (using piggyback) Net::Z3950::ZOOM::options_set($o, count => 10); # Preferred record syntax Net::Z3950::ZOOM::options_set($o, preferredRecordSyntax => "usmarc"); Net::Z3950::ZOOM::options_set($o, elementSetName => "B"); # Connect to all targets: options are the same for all of them for (my $i = 0; $i < $n; $i++) { $z[$i] = Net::Z3950::ZOOM::connection_create($o); Net::Z3950::ZOOM::connection_connect($z[$i], $ARGV[$i], 0); } # Search all for (my $i = 0; $i < $n; $i++) { $r[$i] = Net::Z3950::ZOOM::connection_search_pqf($z[$i], $ARGV[-1]); } # Network I/O. Pass number of connections and array of connections my $nremaining = $n; AGAIN: my $i; while (($i = Net::Z3950::ZOOM::event(\@z)) != 0) { my $ev = Net::Z3950::ZOOM::connection_last_event($z[$i-1]); print("connection ", $i-1, ": event $ev (", Net::Z3950::ZOOM::event_str($ev), ")\n"); last if $ev == Net::Z3950::ZOOM::EVENT_END; } if ($i != 0) { # Not the end of the whole loop; one server is ready to display $i--; my($error, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $tname = $ARGV[$i]; # Display errors if any $error = Net::Z3950::ZOOM::connection_error($z[$i], $errmsg, $addinfo); if ($error) { print STDERR "$tname error: $errmsg ($error) $addinfo\n"; goto MAYBE_AGAIN; } # OK, no major errors. Look at the result count my $size = Net::Z3950::ZOOM::resultset_size($r[$i]); print "$tname: $size hits\n"; # Go through all records at target $size = 10 if $size > 10; for (my $pos = 0; $pos < $size; $pos++) { print "$tname: fetching ", $pos+1, " of $size\n"; my $tmp = Net::Z3950::ZOOM::resultset_record($r[$i], $pos); if (!defined $tmp) { print "$tname: can't get record ", $pos+1, "\n"; next; } my $rec = Net::Z3950::ZOOM::record_get($tmp, "render"); if (!defined $rec) { print "$tname: can't render record ", $pos+1, "\n"; next; } print $pos+1, "\n", $rec, "\n"; } } MAYBE_AGAIN: if (--$nremaining > 0) { goto AGAIN; } # Housekeeping for (my $i = 0; $i < $n; $i++) { Net::Z3950::ZOOM::resultset_destroy($r[$i]); Net::Z3950::ZOOM::connection_destroy($z[$i]); } Net::Z3950::ZOOM::options_destroy($o); ����������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/net-z3950-zoom/zoomtst3.pl����������������������������������������������0000644�0001750�0001750�00000005776�11403454405�020313� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch zoomtst3.pl <t1> [...] <tN> <query> # for example: # perl -I../../blib/lib -I../../blib/arch zoomtst3.pl z3950.loc.gov:7090/Voyager z3950.indexdata.com:210/gils endeavor.flo.org:7090/Voyager mineral use strict; use warnings; use Net::Z3950::ZOOM; if (@ARGV < 2) { print STDERR "Usage: $0 target1 target2 ... targetN query\n"; print STDERR " eg. $0 z3950.indexdata.dk/gils localhost:9999 fish\n"; exit 1; } my $n = @ARGV-1; my(@z, @r); # connections, result sets my $o = Net::Z3950::ZOOM::options_create(); Net::Z3950::ZOOM::options_set($o, async => 1); # Get first 10 records of result set (using piggyback) Net::Z3950::ZOOM::options_set($o, count => 10); # Preferred record syntax Net::Z3950::ZOOM::options_set($o, preferredRecordSyntax => "usmarc"); Net::Z3950::ZOOM::options_set($o, elementSetName => "B"); # Connect to all targets: options are the same for all of them for (my $i = 0; $i < $n; $i++) { $z[$i] = Net::Z3950::ZOOM::connection_create($o); Net::Z3950::ZOOM::connection_connect($z[$i], $ARGV[$i], 0); } # Search all for (my $i = 0; $i < $n; $i++) { $r[$i] = Net::Z3950::ZOOM::connection_search_pqf($z[$i], $ARGV[-1]); } # Network I/O. Pass number of connections and array of connections while ((my $i = Net::Z3950::ZOOM::event(\@z)) != 0) { my $ev = Net::Z3950::ZOOM::connection_last_event($z[$i-1]); print("connection ", $i-1, ": event $ev (", Net::Z3950::ZOOM::event_str($ev), ")\n"); # It would be nice to display results as they come in, but the # ability to do so is dependent on the END event, which was # introduced only in YAZ 2.1.17. If you have a sufficiently new # YAZ, please use the alternative "async.pl", which is similar to # this program except in its asynchronous display. } # No more to be done. Inspect results for (my $i = 0; $i < $n; $i++) { my($error, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $tname = $ARGV[$i]; # Display errors if any $error = Net::Z3950::ZOOM::connection_error($z[$i], $errmsg, $addinfo); if ($error) { print STDERR "$tname error: $errmsg ($error) $addinfo\n"; next; } # OK, no major errors. Look at the result count my $size = Net::Z3950::ZOOM::resultset_size($r[$i]); print "$tname: $size hits\n"; # Go through all records at target $size = 10 if $size > 10; for (my $pos = 0; $pos < $size; $pos++) { print "$tname: fetching ", $pos+1, " of $size\n"; my $tmp = Net::Z3950::ZOOM::resultset_record($r[$i], $pos); if (!defined $tmp) { print "$tname: can't get record ", $pos+1, "\n"; next; } my $rec = Net::Z3950::ZOOM::record_get($tmp, "render"); if (!defined $rec) { print "$tname: can't render record ", $pos+1, "\n"; next; } print $pos+1, "\n", $rec, "\n"; } } # Housekeeping for (my $i = 0; $i < $n; $i++) { Net::Z3950::ZOOM::resultset_destroy($r[$i]); Net::Z3950::ZOOM::connection_destroy($z[$i]); } Net::Z3950::ZOOM::options_destroy($o); ��Net-Z3950-ZOOM-1.30/samples/net-z3950-zoom/zoomtst1.pl����������������������������������������������0000644�0001750�0001750�00000002532�11403454405�020274� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch zoomtst1.pl <target> <query> use strict; use warnings; use Net::Z3950::ZOOM; if (@ARGV != 2) { print STDERR "Usage: $0 target query\n"; print STDERR " eg. $0 z3950.indexdata.dk/gils computer\n"; exit 1; } my($host, $query) = @ARGV; my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy"); my $conn = Net::Z3950::ZOOM::connection_new($host, 0); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); die("Can't connect to host '$host': ", "errcode='$errcode', errmsg='$errmsg', addinfo='$addinfo'") if $errcode != 0; Net::Z3950::ZOOM::connection_option_set($conn, preferredRecordSyntax => "usmarc"); my $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, $query); $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo); die("Can't search for '$query': ", "errcode='$errcode', errmsg='$errmsg', addinfo='$addinfo'") if $errcode != 0; my $n = Net::Z3950::ZOOM::resultset_size($rs); print "Query '$query' found $n records\n"; for my $i (0..$n-1) { my $rec = Net::Z3950::ZOOM::resultset_record($rs, $i); print "=== Record ", $i+1, " of $n ===\n"; print Net::Z3950::ZOOM::record_get($rec, "render"); } Net::Z3950::ZOOM::resultset_destroy($rs); Net::Z3950::ZOOM::connection_destroy($conn); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/net-z3950/��������������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�015155� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/net-z3950/zoomtst1.pl���������������������������������������������������0000644�0001750�0001750�00000002276�11403454405�017317� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch zoomtst1.pl <target> <query> use strict; use warnings; use Net::Z3950; if (@ARGV != 2) { print STDERR "Usage: $0 target query\n"; print STDERR " eg. $0 z3950.indexdata.dk/gils computer\n"; exit 1; } my($host, $query) = @ARGV; # Database name defaults to "Default" in Net::Z3950 and must be overridden $host =~ s/\/(.*)//; my $db = $1; my $conn = new Net::Z3950::Connection($host, 0, databaseName => $db) or die "can't connect to '$host': $!"; # Default format is GRS-1 in Net::Z3950 $conn->option(preferredRecordSyntax => "usmarc"); # Default format is "B" in Net::Z3950 $conn->option(elementSetName => "F"); my $rs = $conn->search(-prefix => $query) or die "can't search for '$query': ", $conn->errmsg(); my $n = $rs->size(); print "Query '$query' found $n records\n"; # Note that the record-index is 1-based here, 0-based in ZOOM-C for my $i (1..$n) { my $rec = $rs->record($i) or die "can't fetch record $i: ", $rs->errmsg(); print "=== Record $i of $n ===\n"; # Rendering format for MARC records is different print $rec->render(), "\n"; } $rs->delete(); $conn->close(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/�������������������������������������������������������������������0000755�0001750�0001750�00000000000�12310065753�014563� 5����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/zselect������������������������������������������������������������0000755�0001750�0001750�00000004157�11403454405�016167� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Example command-line: # ./zselect -t q localhost:3313/IR-Explain---1 "net.port=3950" "concat(zeerex:serverInfo/zeerex:host, ':', zeerex:serverInfo/zeerex:port, '/', zeerex:serverInfo/zeerex:database)" use strict; use warnings; use Getopt::Std; use ZOOM; use XML::LibXML; use XML::LibXML::XPathContext; my %opts = (t => "p"); if (!getopts('t:', \%opts) || @ARGV != 3) { print STDERR "Usage: $0 [-t queryType] <target> <query> <xpath> Query types: p Query is in prefix query format (PQF) [default] c Query is in CCL, sent directly to server q Query is in CQL, sent directly to server C Query is in CCL, translated on client side Q Query is in CQL, translated on client side "; exit 1; } my($target, $qstring, $xpath) = @ARGV; my $type = $opts{t}; my %type2class = ( p => "PQF", c => "CCL", # Bizarrely, not yet implemented in ZOOM q => "CQL", C => "CCL2RPN", Q => "CQL2RPN", ); my $class = $type2class{$type}; if (!defined $class) { print STDERR "$0: unrecognised query type '$type'\n"; exit 2; } my $conn = new ZOOM::Connection($target); my $query = "ZOOM::Query::$class"->new($qstring, $conn); $conn->option(presentChunk => 50); my $rs = $conn->search($query); my $n = $rs->size(); #print "found $n record", ($n==1 ? "" : "s"), "\n"; $rs->option(preferredRecordSyntax => "xml"); $conn->option(elementSetName => "zeerex"); my $parser = new XML::LibXML(); foreach my $i (1..$n) { my $rec = $rs->record($i-1); my $xml = $rec->render(); my $doc = $parser->parse_string($xml); my $root = $doc->getDocumentElement(); my $xc = XML::LibXML::XPathContext->new($root); register_namespaces($xc); print $xc->find($xpath), "\n"; } # I feel really bad about having to have a hardwired list of supported # namespaces, but since it's entirely the fault of LibXML's retarded # lack of proper namespace support in its XPath handling, I am not # going to let it spoil my day. # sub register_namespaces { my($xc) = @_; $xc->registerNs(zeerex => 'http://explain.z3950.org/dtd/2.0/'); $xc->registerNs(irspy => 'http://indexdata.com/irspy/1.0'); # More to come } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/zoomdump�����������������������������������������������������������0000755�0001750�0001750�00000001422�11403454405�016360� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # Dumps the contents of the nominated Zebra database to a set of # separate XML files with numeric names. use strict; use warnings; use ZOOM; if (@ARGV != 1) { print STDERR "Usage: $0 target\n"; exit 1; } my $conn = new ZOOM::Connection($ARGV[0]); $conn->option(preferredRecordSyntax => "xml"); $conn->option(elementSetName => "zebra::data"); my $rs = $conn->search_pqf('@attr 1=_ALLRECORDS @attr 2=103 ""'); my $n = $rs->size(); $| = 1; print "$0: dumping $n records\n"; foreach my $i (1..$n) { print "."; print " $i/$n (", int($i*100/$n), "%)\n" if $i % 50 == 0; my $rec = $rs->record($i-1); my $xml = $rec->render(); open F, ">$i.xml" or die "can't open\n"; print F $xml; close F; } print " $n/$n (100%)\n" if $n % 50 != 0; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/async.pl�����������������������������������������������������������0000644�0001750�0001750�00000004525�11403454405�016241� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch async.pl <t1> [...] <tN> <query> # for example: # perl -I../../blib/lib -I../../blib/arch async.pl z3950.loc.gov:7090/Voyager z3950.indexdata.com:210/gils endeavor.flo.org:7090/Voyager mineral use strict; use warnings; use ZOOM; if (@ARGV < 2) { print STDERR "Usage: $0 target1 target2 ... targetN query\n"; print STDERR " eg. $0 z3950.indexdata.dk/gils localhost:9999 fish\n"; exit 1; } my $n = @ARGV-1; my(@z, @r); # connections, result sets my $o = new ZOOM::Options(); $o->option(async => 1); # Get first 10 records of result set (using piggyback) $o->option(count => 10); # Preferred record syntax $o->option(preferredRecordSyntax => "usmarc"); $o->option(elementSetName => "F"); # Connect to all targets: options are the same for all of them for (my $i = 0; $i < $n; $i++) { $z[$i] = create ZOOM::Connection($o); $z[$i]->connect($ARGV[$i]); } # Search all for (my $i = 0; $i < $n; $i++) { $r[$i] = $z[$i]->search_pqf($ARGV[-1]); } # Network I/O. Pass number of connections and array of connections my $nremaining = $n; AGAIN: my $i; while (($i = ZOOM::event(\@z)) != 0) { my $ev = $z[$i-1]->last_event(); print("connection ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n"); last if $ev == ZOOM::Event::ZEND; } if ($i != 0) { # Not the end of the whole loop; one server is ready to display $i--; my $tname = $ARGV[$i]; my($error, $errmsg, $addinfo, $diagset) = $z[$i]->error_x(); if ($error) { print STDERR "$tname error: $errmsg ($error) $addinfo\n"; goto MAYBE_AGAIN; } # OK, no major errors. Look at the result count my $size = $r[$i]->size(); print "$tname: $size hits\n"; # Go through all records at target $size = 10 if $size > 10; for (my $pos = 0; $pos < $size; $pos++) { print "$tname: fetching ", $pos+1, " of $size\n"; my $tmp = $r[$i]->record($pos); if (!defined $tmp) { print "$tname: can't get record ", $pos+1, "\n"; next; } my $rec = $tmp->render(); if (!defined $rec) { print "$tname: can't render record ", $pos+1, "\n"; next; } print $pos+1, "\n", $rec, "\n"; } } MAYBE_AGAIN: if (--$nremaining > 0) { goto AGAIN; } # Housekeeping for (my $i = 0; $i < $n; $i++) { $r[$i]->destroy(); $z[$i]->destroy(); } $o->destroy(); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/zoom-delete-records������������������������������������������������0000755�0001750�0001750�00000003655�11516026725�020410� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl # # zoom-delete-records user=admin,password=fruitbat,localhost:8018/IR-Explain---1 'concat(count(irspy:status/irspy:probe[@ok=1]), "/", count(irspy:status/irspy:probe))' 'count(irspy:status/irspy:probe[@ok=1]) = 0 and count(irspy:status/irspy:probe) >= 10' use XML::LibXML; use ZOOM; use strict; use warnings; die "Usage: $0 <database> <displayXPath> <deleteXPath>\n" if @ARGV != 3; my($dbname, $displayXPath, $deleteXPath) = @ARGV; my $libxml = new XML::LibXML; my $conn = new ZOOM::Connection($dbname); my $rs = $conn->search(new ZOOM::Query::CQL("cql.allRecords=1")); $rs->option(elementSetName => "zeerex"); my $n = $rs->size(); foreach my $i (1 .. $n) { my $xml = $rs->record($i-1)->render(); my $rec = $libxml->parse_string($xml)->documentElement(); my $xc = XML::LibXML::XPathContext->new($rec); $xc->registerNs(zeerex => "http://explain.z3950.org/dtd/2.0/"); $xc->registerNs(irspy => "http://indexdata.com/irspy/1.0"); my $val = $xc->findvalue($displayXPath); print "Record $i/$n: $val"; $val = $xc->findvalue($deleteXPath); if ($val eq "true") { my $id = ZOOM_record_id($rs, $i); print " DELETE $id"; my $p = $conn->package(); $p->option(action => "recordDelete"); $p->option(record => $xml); $p->send("update"); $p->destroy(); } print "\n"; } my $p = $conn->package(); $p->send("commit"); $p->destroy(); sub ZOOM_record_id { my($rs, $i) = @_; # There is no standard way in Z39.50 to discover the opaque record # ID of a given record, which is a bit silly as you need this in # order to update or delete it using Extended Services. So we # adopt the convention that fetching the record with element-set # "id" returns the ID. This convention is implemented by the # IRSpy database, among others. my $old = $rs->option(elementSetName => "id"); my $id = $rs->record($i-1)->render(); $rs->option(elementSetName => $old); return $id; } �����������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/zoomscan.pl��������������������������������������������������������0000644�0001750�0001750�00000002535�11403454405�016754� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # This is the scanning counterpart to zoomscan.pl's searching # perl -I../../blib/lib -I../../blib/arch zoomscan.pl <target> <scanQuery> # # For example (using Z39.50 and SRW, Type-1 and CQL): # perl zoomscan.pl tcp:localhost:8018/IR-Explain---1 '@attr 1=dc.title the' # perl zoomscan.pl http://localhost:8018/IR-Explain---1 '@attr 1=dc.title the' # perl zoomscan.pl -q http://localhost:8018/IR-Explain---1 'dc.title=the' use strict; use warnings; use Getopt::Std; use ZOOM; my %opts; if (!getopts('q', \%opts) || @ARGV != 2) { print STDERR "Usage: $0 [options] target scanQuery -q Query is CQL [default: PQF] eg. $0 z3950.indexdata.dk/gils computer\n"; exit 1; } my($host, $scanQuery) = @ARGV; eval { my $conn = new ZOOM::Connection($host, 0); $conn->option(preferredRecordSyntax => "usmarc"); ### Could use ZOOM::Query::CQL below, but that only works in SRU/W. my $q = $opts{q} ? new ZOOM::Query::CQL($scanQuery) : new ZOOM::Query::PQF($scanQuery); my $ss = $conn->scan($q); my $n = $ss->size(); for my $i (0..$n-1) { my($term, $occ) = $ss->term($i); print $i+1, ": $term"; print " ($occ)" if defined $occ; print "\n"; } $ss->destroy(); $conn->destroy(); }; if ($@) { die "Non-ZOOM error: $@" if !$@->isa("ZOOM::Exception"); print STDERR "ZOOM error $@\n"; exit 1; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/zoomtst3.pl��������������������������������������������������������0000644�0001750�0001750�00000005000�11403454405�016713� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch zoomtst3.pl <t1> [...] <tN> <query> # for example: # perl -I../../blib/lib -I../../blib/arch zoomtst3.pl z3950.loc.gov:7090/Voyager z3950.indexdata.com:210/gils endeavor.flo.org:7090/Voyager mineral use strict; use warnings; use ZOOM; if (@ARGV < 2) { print STDERR "Usage: $0 target1 target2 ... targetN query\n"; print STDERR " eg. $0 z3950.indexdata.dk/gils localhost:9999 fish\n"; exit 1; } my $n = @ARGV-1; my(@z, @r); # connections, result sets my $o = new ZOOM::Options(); $o->option(async => 1); # Get first 10 records of result set (using piggyback) $o->option(count => 10); # Preferred record syntax $o->option(preferredRecordSyntax => "usmarc"); $o->option(elementSetName => "F"); # Connect to all targets: options are the same for all of them for (my $i = 0; $i < $n; $i++) { $z[$i] = create ZOOM::Connection($o); $z[$i]->connect($ARGV[$i]); } # Search all for (my $i = 0; $i < $n; $i++) { $r[$i] = $z[$i]->search_pqf($ARGV[-1]); } # Network I/O. Pass number of connections and array of connections while ((my $i = ZOOM::event(\@z)) != 0) { my $ev = $z[$i-1]->last_event(); print("connection ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n"); # It would be nice to display results as they come in, but the # ability to do so is dependent on the END event, which was # introduced only in YAZ 2.1.17. If you have a sufficiently new # YAZ, please use the alternative "async.pl", which is similar to # this program except in its asynchronous display. } # No more to be done. Inspect results for (my $i = 0; $i < $n; $i++) { my $tname = $ARGV[$i]; my($error, $errmsg, $addinfo, $diagset) = $z[$i]->error_x(); if ($error) { print STDERR "$tname error: $errmsg ($error) $addinfo\n"; next; } # OK, no major errors. Look at the result count my $size = $r[$i]->size(); print "$tname: $size hits\n"; # Go through all records at target $size = 10 if $size > 10; for (my $pos = 0; $pos < $size; $pos++) { print "$tname: fetching ", $pos+1, " of $size\n"; my $tmp = $r[$i]->record($pos); if (!defined $tmp) { print "$tname: can't get record ", $pos+1, "\n"; next; } my $rec = $tmp->render(); if (!defined $rec) { print "$tname: can't render record ", $pos+1, "\n"; next; } print $pos+1, "\n", $rec, "\n"; } } # Housekeeping for (my $i = 0; $i < $n; $i++) { $r[$i]->destroy(); $z[$i]->destroy(); } $o->destroy(); Net-Z3950-ZOOM-1.30/samples/zoom/zoomtst1.pl��������������������������������������������������������0000644�0001750�0001750�00000002173�11403454406�016722� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # See ../README for a description of this program. # perl -I../../blib/lib -I../../blib/arch zoomtst1.pl <target> <query> use strict; use warnings; use ZOOM; if (@ARGV < 2 || @ARGV %2 == 1) { print STDERR "Usage: $0 target query [<option> <value> ...]\n"; print STDERR " eg. $0 z3950.indexdata.dk/gils computer\n"; exit 1; } my $host = shift(@ARGV); my $query = shift(@ARGV); eval { my $conn = new ZOOM::Connection($host, 0); $conn->option(preferredRecordSyntax => "usmarc"); while (@ARGV) { my $key = shift(@ARGV); my $value = shift(@ARGV); $conn->option($key => $value); } my $rs = $conn->search_pqf($query); my $n = $rs->size(); print "Query '$query' found $n records\n"; for my $i (0..$n-1) { my $rec = $rs->record($i); print "=== Record ", $i+1, " of $n ===\n"; print $rec->render(); } $rs->destroy(); $conn->destroy(); }; if ($@) { die "Non-ZOOM error: $@" if !$@->isa("ZOOM::Exception"); print STDERR "Error ", $@->code(), ": ", $@->message(); print STDERR " (", $@->addinfo(), ")" if $@->addinfo(); print STDERR "\n"; exit 1; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/zhello.pl����������������������������������������������������������0000755�0001750�0001750�00000001126�11403454405�016416� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w use strict; use warnings; use ZOOM; if (@ARGV != 1) { print STDERR "Usage: $0 target\n"; exit 1; } my $conn = new ZOOM::Connection($ARGV[0]); foreach my $opt (qw(search present delSet resourceReport triggerResourceCtrl resourceCtrl accessCtrl scan sort extendedServices level_1Segmentation level_2Segmentation concurrentOperations namedResultSets encapsulation resultCount negotiationModel duplicationDetection queryType104 pQESCorrection stringSchema)) { print $conn->option("init_opt_$opt") ? " " : "!"; print "$opt\n"; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Z3950-ZOOM-1.30/samples/zoom/update.pl����������������������������������������������������������0000755�0001750�0001750�00000010045�11403454405�016403� 0����������������������������������������������������������������������������������������������������ustar �mike����������������������������mike�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w use strict; use warnings; use ZOOM; my $options = new ZOOM::Options(); $options->option(user => "admin"); $options->option(password => "fish"); my $conn = create ZOOM::Connection($options); $conn->connect("test.indexdata.com:2118"); print "connected\n"; my $dbname = "mike$$"; $conn->option(databaseName => $dbname); send_package($conn, "create", databaseName => $dbname); print "$0: created database '$dbname'\n"; my $rs = $conn->search_pqf("mineral"); my $n = $rs->size($rs); print "$0: found $n records\n"; send_package($conn, "update", action => "specialUpdate", recordIdOpaque => 1, record => join("", <DATA>)); print "$0: added record\n"; $rs = $conn->search_pqf("mineral"); $n = $rs->size($rs); print "$0: found $n records\n"; send_package($conn, "drop", databaseName => $dbname); print "$0: deleted database\n"; eval { $rs = $conn->search_pqf("mineral"); }; if (!$@) { print "$0: uh-oh\n"; } elsif ($@->isa("ZOOM::Exception")) { print "$0: database no longer there\n"; } else { die "@='$@'"; } sub send_package { my($conn, $op, %options) = @_; my $p = $conn->package(); foreach my $key (keys %options) { $p->option($key, $options{$key}); } $p->send($op); $p->destroy(); } __DATA__ <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.30/samples/zoom/trivial-async.pl0000644000175000017500000000130011226575116017703 0ustar mikemikeuse ZOOM; @servers = ('z3950.loc.gov:7090/Voyager', 'z3950.indexdata.com:210/gils', 'agricola.nal.usda.gov:7190/Voyager'); for ($i = 0; $i < @servers; $i++) { $z[$i] = new ZOOM::Connection($servers[$i], 0, async => 1, # asynchronous mode count => 1, # piggyback retrieval count preferredRecordSyntax => "usmarc"); $r[$i] = $z[$i]->search_pqf("mineral"); } while (($i = ZOOM::event(\@z)) != 0) { $ev = $z[$i-1]->last_event(); print("connection ", $i-1, ": ", ZOOM::event_str($ev), "\n"); if ($ev == ZOOM::Event::ZEND) { $size = $r[$i-1]->size(); print "connection ", $i-1, ": $size hits\n"; print $r[$i-1]->record(0)->render() if $size > 0; } } Net-Z3950-ZOOM-1.30/samples/records/0000755000175000017500000000000012310065753015240 5ustar mikemikeNet-Z3950-ZOOM-1.30/samples/records/esdd0006.grs0000644000175000017500000000522111226575116017206 0ustar mikemike 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.30/samples/README0000644000175000017500000000405711403454406014464 0ustar mikemikeThis 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.30/samples/ccl/0000755000175000017500000000000012310065753014340 5ustar mikemikeNet-Z3950-ZOOM-1.30/samples/ccl/default.bib0000644000175000017500000000173111416624430016443 0ustar mikemike# CCL field mappings # # The rule below is used when no fields are specified term t=l,r s=al # # Simple rule for a field called "clean" clean t=l,r # # Rules for some BIB-1 fields au u=1 s=pw ti u=4 s=pw isbn u=7 issn u=8 cc u=20 su u=21 s=pw date u=30 r=r dp u=31 r=r da u=32 r=r la u=54 s=pw ab u=62 s=pw note u=63 s=pw af u=1006 s=pw # # Rules for a few GILS fields north gils-attset,u=2040 r=o south gils-attset,u=2041 r=o east gils-attset,u=2038 r=o west gils-attest,u=2039 r=o distributor gils-attset,u=2000 s=pw distributorname gils-attset,u=2001 s=pw # Explain fields ExplainCategory exp1,1=1 HumanStringLanguage exp1,1=2 DatabaseName exp1,1=3 TargetName exp1,1=4 AttributeSetOID exp1,1=5 RecordSyntaxOID exp1,1=6 TagSetOID exp1,1=7 ExtededServiceOID exp1,1=8 DateAdded exp1,1=9 DateChanged exp1,1=10 DateExpires exp1,1=11 ElementSetName exp1,1=12