X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=lib%2FZOOM.pm;h=28dc285e7c5cdd37c2ebff5ffee192725d51620d;hb=692fb30bc0ab6d6e1536405ed7040ecd2b7c94ce;hp=5f87d1ee0966df023d3a5a320b5b062d2512ae57;hpb=b81ecf91be67f569ec7a4dbdd65101f65c47a954;p=ZOOM-Perl-moved-to-github.git diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm index 5f87d1e..28dc285 100644 --- a/lib/ZOOM.pm +++ b/lib/ZOOM.pm @@ -1,13 +1,13 @@ -# $Id: ZOOM.pm,v 1.19 2005-11-16 16:48:11 mike Exp $ +# $Id: ZOOM.pm,v 1.35 2006-06-15 15:43:14 mike Exp $ 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 @@ -40,6 +40,10 @@ 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 } @@ -47,6 +51,24 @@ 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; @@ -60,6 +82,7 @@ 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 } # ---------------------------------------------------------------------------- @@ -81,15 +104,30 @@ sub diag_str { 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 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, diag_str($code), $addinfo, $diagset); + die new ZOOM::Exception($code, undef, $addinfo, $diagset); } # ---------------------------------------------------------------------------- @@ -100,11 +138,18 @@ sub new { my $class = shift(); my($code, $message, $addinfo, $diagset) = @_; + $diagset ||= "ZOOM"; + if ($diagset eq "ZOOM") { + $message ||= ZOOM::diag_str($code); + } else { + # Should fill in messages for other diagsets, too. + } + return bless { code => $code, message => $message, addinfo => $addinfo, - diagset => $diagset || "ZOOM", + diagset => $diagset, }, $class; } @@ -132,6 +177,7 @@ sub render { my $this = shift(); my $res = "ZOOM error " . $this->code() . ' "' . $this->message() . '"'; $res .= ' (addinfo: "' . $this->addinfo() . '")' if $this->addinfo(); + $res .= " from diag-set '" . $this->diagset() . "'" if $this->diagset(); return $res; } @@ -266,19 +312,31 @@ package ZOOM::Connection; sub new { my $class = shift(); - my($host, $port) = @_; + my($host, $port, @options) = @_; + + my $_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_new($host, $port || 0); + my $_conn = Net::Z3950::ZOOM::connection_create($_opts); + Net::Z3950::ZOOM::connection_connect($_conn, $host, $port || 0); my $conn = bless { host => $host, port => $port, _conn => $_conn, }; + $conn->_check(); return $conn; } -# PRIVATE to this class +# PRIVATE to this class, to ZOOM::event() and to ZOOM::Query::CQL2RPN::new() sub _conn { my $this = shift(); @@ -344,6 +402,7 @@ 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 @@ -393,7 +452,7 @@ sub search_pqf { return _new ZOOM::ResultSet($this, $pqf, $_rs); } -sub scan { +sub scan_pqf { my $this = shift(); my($startterm) = @_; @@ -402,6 +461,16 @@ sub scan { 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) = @_; @@ -414,6 +483,12 @@ sub package { return _new ZOOM::Package($this, $options, $_p); } +sub last_event { + my $this = shift(); + + return Net::Z3950::ZOOM::connection_last_event($this->_conn()); +} + sub destroy { my $this = shift(); @@ -476,6 +551,62 @@ sub new { } +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); @@ -553,7 +684,12 @@ sub record { my($which) = @_; my $_rec = Net::Z3950::ZOOM::resultset_record($this->_rs(), $which); - ### Check for error -- but how? + $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 @@ -568,7 +704,8 @@ sub record_immediate { my $_rec = Net::Z3950::ZOOM::resultset_record_immediate($this->_rs(), $which); - ### Check for error -- but how? + $this->{conn}->_check(); + # The record might legitimately not be there yet return undef if !defined $_rec; return ZOOM::Record->_new($this, $which, $_rec); @@ -586,7 +723,7 @@ sub records { my $raw = Net::Z3950::ZOOM::resultset_records($this->_rs(), $start, $count, $return_records); - ### Why don't we throw an exception if $raw is undefined? + # 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 @@ -657,22 +794,27 @@ sub _rec { sub render { my $this = shift(); - my $len = 0; - my $string = Net::Z3950::ZOOM::record_get($this->_rec(), "render", $len); - # I don't think we need '$len' at all. ### Probably the Perl-to-C - # glue code should use the value of `len' as well as the opaque - # data-pointer returned, to ensure that the SV contains all of the - # returned data and does not stop at the first NUL character in - # binary data. Carefully check the ZOOM_record_get() documentation. - return $string; + 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; my $len = 0; - my $string = Net::Z3950::ZOOM::record_get($this->_rec(), "raw", $len); - # See comment about $len in render() + my $string = Net::Z3950::ZOOM::record_get($this->_rec(), $type, $len); + # I don't think we need '$len' at all. ### Probably the Perl-to-C + # glue code should use the value of `len' as well as the opaque + # data-pointer returned, to ensure that the SV contains all of the + # returned data and does not stop at the first NUL character in + # binary data. Carefully check the ZOOM_record_get() documentation. return $string; } @@ -710,7 +852,12 @@ sub _new { return bless { conn => $conn, - startterm => $startterm, + 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; } @@ -749,9 +896,9 @@ sub term { my($occ, $len) = (0, 0); my $term = Net::Z3950::ZOOM::scanset_term($this->_ss(), $which, - $occ, $len); - ### Throw exception? - return undef if !defined $term; + $occ, $len) + or ZOOM::_oops(ZOOM::Error::SCANTERM); + die "length of term '$term' differs from returned len=$len" if length($term) != $len; @@ -764,9 +911,9 @@ sub display_term { my($occ, $len) = (0, 0); my $term = Net::Z3950::ZOOM::scanset_display_term($this->_ss(), $which, - $occ, $len); - ### Throw exception? - return undef if !defined $term; + $occ, $len) + or ZOOM::_oops(ZOOM::Error::SCANTERM); + die "length of display term '$term' differs from returned len=$len" if length($term) != $len; @@ -840,4 +987,41 @@ sub destroy { } +# 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)); +} + + 1;