Testing for record cloning and deletion.

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

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index 3cd252a..157c4af 100644 (file)
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.10 2005-10-31 15:10:49 mike Exp $
+# $Id: ZOOM.pm,v 1.13 2005-11-07 15:48:08 mike Exp $
 
 use strict;
 use warnings;
@@ -45,6 +45,7 @@ sub CREATE_QUERY { 20001 }
 sub QUERY_CQL { 20002 }
 sub QUERY_PQF { 20003 }
 sub SORTBY { 20004 }
+sub CLONE { 20005 }
 
 # The "Event" package contains constants returned by last_event()
 package ZOOM::Event;
@@ -75,6 +76,8 @@ sub diag_str {
        return "can't set prefix query";
     } elsif ($code == ZOOM::Error::SORTBY) {
        return "can't set sort-specification";
+    } elsif ($code == ZOOM::Error::CLONE) {
+       return "can't clone record";
     }
 
     return Net::Z3950::ZOOM::diag_str($code);
@@ -270,7 +273,7 @@ sub create {
     };
 }
 
-# PRIVATE within this class
+# PRIVATE to this class
 sub _conn {
     my $this = shift();
 
@@ -386,6 +389,7 @@ sub new {
     die "You can't create $class objects: it's a virtual base class";
 }
 
+# PRIVATE to this class and ZOOM::Connection::search()
 sub _query {
     my $this = shift();
 
@@ -457,7 +461,7 @@ sub new {
     die "You can't create $class objects directly";
 }
 
-# PRIVATE to ZOOM::Connection::search()
+# PRIVATE to ZOOM::Connection::search() and ZOOM::Connection::search_pqf()
 sub _new {
     my $class = shift();
     my($conn, $query, $_rs) = @_;
@@ -474,7 +478,7 @@ sub _new {
     }, $class;
 }
 
-# PRIVATE within this class
+# PRIVATE to this class
 sub _rs {
     my $this = shift();
 
@@ -485,6 +489,17 @@ sub _rs {
     return $_rs;
 }
 
+sub option {
+    my $this = shift();
+    my($key, $value) = @_;
+
+    my $oldval = Net::Z3950::ZOOM::resultset_option_get($this->_rs(), $key);
+    Net::Z3950::ZOOM::resultset_option_set($this->_rs(), $key, $value)
+       if defined $value;
+
+    return $oldval;
+}
+
 sub size {
     my $this = shift();
 
@@ -497,6 +512,7 @@ sub record {
 
     my $_rec = Net::Z3950::ZOOM::resultset_record($this->_rs(), $which);
     ### Check for error -- but how?
+    return undef if !defined $_rec;
 
     # For some reason, I have to use the explicit "->" syntax in order
     # to invoke the ZOOM::Record constructor here, even though I don't
@@ -504,6 +520,54 @@ sub record {
     return ZOOM::Record->_new($this, $which, $_rec);
 }
 
+sub record_immediate {
+    my $this = shift();
+    my($which) = @_;
+
+    my $_rec = Net::Z3950::ZOOM::resultset_record_immediate($this->_rs(),
+                                                           $which);
+    ### Check for error -- but how?
+    return undef if !defined $_rec;
+
+    return ZOOM::Record->_new($this, $which, $_rec);
+}
+
+sub cache_reset {
+    my $this = shift();
+
+    Net::Z3950::ZOOM::resultset_cache_reset($this->_rs());
+}
+
+sub records {
+    my $this = shift();
+    my($start, $count, $return_records) = @_;
+
+    my $raw = Net::Z3950::ZOOM::resultset_records($this->_rs(), $start, $count,
+                                                 $return_records);
+    return undef if !defined $raw;
+
+    # We need to package up the returned records in ZOOM::Record objects
+    my @res = ();
+    for my $i (0 .. @$raw-1) {
+       my $_rec = $raw->[$i];
+       if (!defined $_rec) {
+           push @res, undef;
+       } else {
+           push @res, ZOOM::Record->_new($this, $start+$i, $_rec);
+       }
+    }
+
+    return \@res;
+}
+
+sub sort {
+    my $this = shift();
+    my($sort_type, $sort_spec) = @_;
+
+    Net::Z3950::ZOOM::resultset_sort($this->_rs(), $sort_type, $sort_spec);
+    ### There's no way to check for success, as this is a void function
+}
+
 sub destroy {
     my $this = shift();
 
@@ -521,7 +585,10 @@ sub new {
     die "You can't create $class objects directly";
 }
 
-# PRIVATE to ZOOM::ResultSet::record()
+# PRIVATE to ZOOM::ResultSet::record(),
+# ZOOM::ResultSet::record_immediate(), ZOOM::ResultSet::records() and
+# ZOOM::Record::clone()
+#
 sub _new {
     my $class = shift();
     my($rs, $which, $_rec) = @_;
@@ -533,11 +600,15 @@ sub _new {
     }, $class;
 }
 
-# PRIVATE within this class
+# PRIVATE to this class
 sub _rec {
     my $this = shift();
 
-    return $this->{_rec};
+    my $_rec = $this->{_rec};
+    die "{_rec} undefined: has this Record been destroy()ed?"
+       if !defined $_rec;
+
+    return $_rec;
 }
 
 sub render {
@@ -562,5 +633,22 @@ sub raw {
     return $string;
 }
 
+sub clone {
+    my $this = shift();
+
+    my $raw = Net::Z3950::ZOOM::record_clone($this->_rec())
+       or ZOOM::_oops(ZOOM::Error::CLONE);
+
+    # Arg 1 (rs) is undefined as the new record doesn't belong to an RS
+    return _new ZOOM::Record(undef, undef, $raw);
+}
+
+sub destroy {
+    my $this = shift();
+
+    Net::Z3950::ZOOM::record_destroy($this->_rec());
+    $this->{_rec} = undef;
+}
+
 
 1;