From 9140a0be284807f6509e1b3800c6093633940e17 Mon Sep 17 00:00:00 2001 From: mike Date: Tue, 28 Nov 2006 16:47:19 +0000 Subject: [PATCH] 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. --- Changes | 12 ++++++++++-- Makefile.PL | 4 ++-- ZOOM.xs | 23 ++++++++++++++++++++++- lib/ZOOM.pm | 22 ++++++++++++++++++++-- t/13-resultset.t | 12 +++++++++--- t/23-resultset.t | 11 ++++++++--- 6 files changed, 71 insertions(+), 13 deletions(-) diff --git a/Changes b/Changes index 16a34a8..4fe93d4 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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(); -- 1.7.10.4