New

[ZOOM-Perl-moved-to-github.git] / lib / ZOOM.pm

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index 2fa8be2..a906442 100644 (file)
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.38 2006-10-10 17:02:27 mike Exp $
+# $Id: ZOOM.pm,v 1.41 2006-11-03 09:23:06 mike Exp $
 
 use strict;
 use warnings;
@@ -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.
@@ -731,6 +731,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)