Add Net::Z3950::ZOOM::record_error() and

->error() to return non-surrogate diagnostics, and
->exception() to return the same information wrapped in a
ZOOM::Exception object.  Add tests.  Requires YAZ 2.1.40.

diff --git a/Changes b/Changes
index 16a34a8..4fe93d4 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,8 +1,16 @@
-$Id: Changes,v 1.49 2006-11-04 11:48:15 mike Exp $
+$Id: Changes,v 1.50 2006-11-28 16:47:19 mike Exp $
 
 Revision history for Perl extension Net::Z3950::ZOOM.
 
-1.13  READY TO GO
+1.14  (IN PROGRESS)
+       - Add $record->error() to return non-surrogate diagnostics,
+         and $record->exception() to return the same information
+         wrapped in a ZOOM::Exception object.
+       - Requires YAZ 2.1.40, which provides ZOOM_record_error().
+       - $conn->error_x() now returns the error-code when called in
+         scalar context, rather than the diagnostic set name.
+
+1.13  Sat Nov  4 16:47:00 GMT 2006
        - ZOOM::Connection::create() may now take either a single
          argument, which is a ZOOM::Options object, or any even
          number of argument (including zero), which are key => value

diff --git a/Makefile.PL b/Makefile.PL
index f2a05c4..9e7d4e5 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,4 +1,4 @@
-# $Id: Makefile.PL,v 1.15 2006-10-04 17:13:44 mike Exp $
+# $Id: Makefile.PL,v 1.16 2006-11-28 16:47:19 mike Exp $
 
 use 5.008;
 use ExtUtils::MakeMaker;
@@ -16,7 +16,7 @@ will also need to install "libyaz-dev" in order to build this module.
 }
 
 chomp($yazver);
-check_version($yazver, "2.1.35");
+check_version($yazver, "2.1.40");
 
 # For Windows use
 # $yazinc = '-Ic:\yaz\include'

diff --git a/ZOOM.xs b/ZOOM.xs
index 3314067..96e0548 100644 (file)
--- a/ZOOM.xs
+++ b/ZOOM.xs
@@ -1,4 +1,4 @@
-/* $Id: ZOOM.xs,v 1.43 2006-10-04 17:14:12 mike Exp $ */
+/* $Id: ZOOM.xs,v 1.44 2006-11-28 16:47:19 mike Exp $ */
 
 #include "EXTERN.h"
 #include "perl.h"
@@ -288,6 +288,27 @@ ZOOM_resultset_sort1(r, sort_type, sort_spec)
        const char* sort_type
        const char* sort_spec
 
+# See comments for ZOOM_connection_error() above
+int
+ZOOM_record_error(rec, cp, addinfo, diagset)
+       ZOOM_record rec
+       const char* &cp
+       const char* &addinfo
+       const char* &diagset
+       CODE:
+               {
+               const char *ccp, *caddinfo, *cdset;
+               RETVAL = ZOOM_record_error(rec, &ccp, &caddinfo, &cdset);
+               cp = (char*) ccp;
+               addinfo = (char*) caddinfo;
+               diagset = (char*) cdset;
+               }
+       OUTPUT:
+               RETVAL
+               cp
+               addinfo
+               diagset
+
 # See "typemap" for discussion of the "const char *" return-type.
 #
 ### but should use datachunk for in some (not all!) cases.

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index a906442..a88be64 100644 (file)
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.41 2006-11-03 09:23:06 mike Exp $
+# $Id: ZOOM.pm,v 1.42 2006-11-28 16:47:19 mike Exp $
 
 use strict;
 use warnings;
@@ -379,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 {
@@ -817,6 +817,24 @@ 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 new ZOOM::Exception($errcode, $errmsg, $addinfo, $diagset);
+}
+
+
 sub render {
     my $this = shift();
 

diff --git a/t/13-resultset.t b/t/13-resultset.t
index 5c771f1..046bb7b 100644 (file)
--- a/t/13-resultset.t
+++ b/t/13-resultset.t
@@ -1,11 +1,11 @@
-# $Id: 13-resultset.t,v 1.8 2006-11-02 17:48:26 mike Exp $
+# $Id: 13-resultset.t,v 1.9 2006-11-28 16:47:19 mike Exp $
 
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl 13-resultset.t'
 
 use strict;
 use warnings;
-use Test::More tests => 23;
+use Test::More tests => 24;
 BEGIN { use_ok('Net::Z3950::ZOOM') };
 
 my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
@@ -21,12 +21,18 @@ $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo);
 ok($errcode == 0, "search for '$query'");
 ok(Net::Z3950::ZOOM::resultset_size($rs) == 2, "found 2 records");
 
-my $syntax = "usmarc";
+my $syntax = "canmarc";
 Net::Z3950::ZOOM::resultset_option_set($rs, preferredRecordSyntax => $syntax);
 my $val = Net::Z3950::ZOOM::resultset_option_get($rs, "preferredRecordSyntax");
 ok($val eq $syntax, "preferred record syntax set to '$val'");
 
 my $rec = Net::Z3950::ZOOM::resultset_record($rs, 0);
+my $diagset = "";
+$errcode = Net::Z3950::ZOOM::record_error($rec, $errmsg, $addinfo, $diagset);
+ok($errcode == 238, "can't fetch CANMARC ($errmsg)");
+
+Net::Z3950::ZOOM::resultset_option_set($rs, preferredRecordSyntax => "usmarc");
+$rec = Net::Z3950::ZOOM::resultset_record($rs, 0);
 my $len = 0;
 my $data1 = Net::Z3950::ZOOM::record_get($rec, "render", $len);
 Net::Z3950::ZOOM::resultset_option_set($rs, elementSetName => "b");

diff --git a/t/23-resultset.t b/t/23-resultset.t
index 5e4d9c8..87c4bac 100644 (file)
--- a/t/23-resultset.t
+++ b/t/23-resultset.t
@@ -1,11 +1,11 @@
-# $Id: 23-resultset.t,v 1.5 2006-11-02 17:48:26 mike Exp $
+# $Id: 23-resultset.t,v 1.6 2006-11-28 16:47:19 mike Exp $
 
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl 23-resultset.t'
 
 use strict;
 use warnings;
-use Test::More tests => 23;
+use Test::More tests => 24;
 BEGIN { use_ok('ZOOM') };
 
 my $host = "z3950.indexdata.com/gils";
@@ -19,12 +19,17 @@ eval { $rs = $conn->search_pqf($query) };
 ok(!$@, "search for '$query'");
 ok($rs->size() == 2, "found 2 records");
 
-my $syntax = "usmarc";
+my $syntax = "canmarc";                # not supported
 $rs->option(preferredRecordSyntax => $syntax);
 my $val = $rs->option("preferredRecordSyntax");
 ok($val eq $syntax, "preferred record syntax set to '$val'");
 
 my $rec = $rs->record(0);
+my($errcode, $errmsg) = $rec->error();
+ok($errcode == 238, "can't fetch CANMARC ($errmsg)");
+
+$rs->option(preferredRecordSyntax => "usmarc");
+$rec = $rs->record(0);
 my $data1 = $rec->render();
 $rs->option(elementSetName => "b");
 my $data2 = $rec->render();