X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=lib%2FZOOM.pm;h=8ac0c93c77be42ffb5d6c6df8288e44124f82b4a;hb=7b583a6b1f71de301657e19b140524cdf6b77bb6;hp=e4b28016cd88251bad87daeb4ee9d0cbad5aeddf;hpb=bc71325f3d0bbe522c276929d2b0abdbd0595cba;p=ZOOM-Perl-moved-to-github.git diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm index e4b2801..8ac0c93 100644 --- a/lib/ZOOM.pm +++ b/lib/ZOOM.pm @@ -1,4 +1,4 @@ -# $Id: ZOOM.pm,v 1.25 2005-12-22 12:48:15 mike Exp $ +# $Id: ZOOM.pm,v 1.33 2006-04-12 12:00:48 mike Exp $ use strict; use warnings; @@ -7,7 +7,6 @@ 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 @@ -64,6 +63,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 } # ---------------------------------------------------------------------------- @@ -94,6 +94,17 @@ sub diag_str { 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) = @_; @@ -275,19 +286,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 and to ZOOM::Query::CQL2RPN::new() +# PRIVATE to this class, to ZOOM::event() and to ZOOM::Query::CQL2RPN::new() sub _conn { my $this = shift(); @@ -353,6 +376,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 @@ -433,6 +457,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(); @@ -701,22 +731,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; }