X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=lib%2FZOOM.pm;h=5783adb96a8f8f100662808b3a7874e196d42cca;hb=18c49becbb590b5b9b03d7ee5edfe143d6d63c8a;hp=cc0cf8e03e0db3f6c306384e647a15988e40fe25;hpb=0be02044c8dfc4bd43979670589144712aeee30e;p=ZOOM-Perl-moved-to-github.git

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index cc0cf8e..5783adb 100644
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.43 2006-12-01 14:13:41 mike Exp $
+# $Id: ZOOM.pm,v 1.49 2007-09-14 10:34:35 mike Exp $
 
 use strict;
 use warnings;
@@ -113,6 +113,12 @@ sub diag_str {
     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(@_);
 }
@@ -141,8 +147,11 @@ sub new {
     $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 other diagsets, too.
+	# Should fill in messages for any other known diagsets.
+	$message ||= "(unknown error)";
     }
 
     return bless {
@@ -175,7 +184,9 @@ sub diagset {
 
 sub render {
     my $this = shift();
-    my $res = "ZOOM error " . $this->code() . ' "' . $this->message() . '"';
+
+    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;
@@ -337,12 +348,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 {
@@ -382,6 +413,14 @@ sub error_x {
     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());
@@ -499,6 +538,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();
 
@@ -1068,5 +1113,6 @@ sub log {
     Net::Z3950::ZOOM::yaz_log($level, join("", @message));
 }
 
+BEGIN { ZOOM::Log::mask_str("zoom_check"); }
 
 1;