X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=lib%2FZOOM.pm;h=0a42e3e9b04310b47d0e364402e6d610f7774afc;hb=beb0211a4003983bbacbe2b8c1a6f08144ccc39a;hp=9b12e869b8c6d12f01169494a6774ce70afc1481;hpb=74780888cdb9168a4e00399f8f28108223599258;p=ZOOM-Perl-moved-to-github.git

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index 9b12e86..0a42e3e 100644
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.40 2006-11-02 17:56:33 mike Exp $
+# $Id: ZOOM.pm,v 1.48 2007-05-09 12:03:52 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 }
@@ -337,12 +337,32 @@ sub _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);
-    die new ZOOM::Exception($errcode, $errmsg, $addinfo, $diagset)
-	if $errcode;
+    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 {
@@ -379,7 +399,15 @@ 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 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 {
@@ -499,6 +527,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();
 
@@ -734,7 +768,13 @@ sub 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.
+    # 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"
@@ -811,6 +851,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();
 
@@ -1043,5 +1102,6 @@ sub log {
     Net::Z3950::ZOOM::yaz_log($level, join("", @message));
 }
 
+BEGIN { ZOOM::Log::mask_str("zoom_check"); }
 
 1;