X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=lib%2FZOOM.pm;h=96cfd3c13f5cbb635351dd4d79dc4c14364dfdb2;hb=98b6a8aea3d6aa14a114fad4e4da22b308117923;hp=0e3e5836f05346d3e9e32ff2e1f667b5e97112bb;hpb=a093850375464520c98525423b6222f89e7f7b1a;p=ZOOM-Perl-moved-to-github.git

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index 0e3e583..96cfd3c 100644
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.36 2006-10-04 17:15:03 mike Exp $
+# $Id: ZOOM.pm,v 1.44 2007-01-16 11:17:28 mike Exp $
 
 use strict;
 use warnings;
@@ -34,7 +34,7 @@ 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 INIT { Net::Z3950::ZOOM::ERROR_INIT }
+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 }
@@ -139,7 +139,7 @@ sub new {
     my($code, $message, $addinfo, $diagset) = @_;
 
     $diagset ||= "ZOOM";
-    if ($diagset eq "ZOOM") {
+    if (uc($diagset) eq "ZOOM" || uc($diagset) eq "BIB-1") {
 	$message ||= ZOOM::diag_str($code);
     } else {
 	# Should fill in messages for other diagsets, too.
@@ -314,25 +314,13 @@ sub new {
     my $class = shift();
     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_create($_opts);
-    Net::Z3950::ZOOM::connection_connect($_conn, $host, $port || 0);
-    my $conn = bless {
-	host => $host,
-	port => $port,
-	_conn => $_conn,
-    };
+    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;
 }
 
@@ -359,14 +347,30 @@ sub _check {
 
 sub create {
     my $class = shift();
-    my($options) = @_;
+    my(@options) = @_;
 
-    my $_conn = Net::Z3950::ZOOM::connection_create($options->_opts());
-    return bless {
+    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 {
@@ -375,7 +379,7 @@ sub error_x {
     my($errcode, $errmsg, $addinfo, $diagset) = (undef, "dummy", "dummy", "d");
     $errcode = Net::Z3950::ZOOM::connection_error_x($this->_conn(), $errmsg,
 						    $addinfo, $diagset);
-    return ($errcode, $errmsg, $addinfo, $diagset);
+    return wantarray() ? ($errcode, $errmsg, $addinfo, $diagset) : $errcode;
 }
 
 sub errcode {
@@ -495,6 +499,12 @@ sub is_idle {
     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();
 
@@ -727,6 +737,22 @@ 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)
@@ -797,6 +823,25 @@ sub _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();