-# $Id: ZOOM.pm,v 1.41 2006-11-03 09:23:06 mike Exp $
-
use strict;
use warnings;
use IO::File;
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 }
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(@_);
}
$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 {
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;
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 {
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 {
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();
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();
my($type, $args) = @_;
$type = "$type;$args" if defined $args;
- my $len = 0;
- 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;
+ return Net::Z3950::ZOOM::record_get($this->_rec(), $type);
}
sub clone {
Net::Z3950::ZOOM::yaz_log($level, join("", @message));
}
+BEGIN { ZOOM::Log::mask_str("zoom_check"); }
1;