Support for scanning: Connnection::scan() and the ScanSet class.

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

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index e1bc921..4fd8502 100644 (file)
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.11 2005-11-03 16:32:10 mike Exp $
+# $Id: ZOOM.pm,v 1.14 2005-11-08 11:46:59 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();
 
@@ -369,6 +372,19 @@ sub search_pqf {
     return _new ZOOM::ResultSet($this, $pqf, $_rs);
 }
 
+sub scan {
+    my $this = shift();
+    my($startterm) = @_;
+
+    my $_ss = Net::Z3950::ZOOM::connection_scan($this->_conn(), $startterm);
+    my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
+    $errcode = Net::Z3950::ZOOM::connection_error($this->_conn(),
+                                                 $errmsg, $addinfo);
+    die new ZOOM::Exception($errcode, $errmsg, $addinfo) if $errcode;
+
+    return _new ZOOM::ScanSet($this, $startterm, $_ss);
+}
+
 sub destroy {
     my $this = shift();
 
@@ -386,6 +402,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 +474,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 +491,7 @@ sub _new {
     }, $class;
 }
 
-# PRIVATE within this class
+# PRIVATE to this class
 sub _rs {
     my $this = shift();
 
@@ -556,6 +573,14 @@ sub records {
     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();
 
@@ -573,7 +598,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) = @_;
@@ -585,11 +613,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 {
@@ -614,5 +646,96 @@ 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;
+}
+
+
+# ----------------------------------------------------------------------------
+
+package ZOOM::ScanSet;
+
+sub new {
+    my $class = shift();
+    die "You can't create $class objects directly";
+}
+
+# PRIVATE to ZOOM::Connection::scan(),
+sub _new {
+    my $class = shift();
+    my($conn, $startterm, $_ss) = @_;
+
+    return bless {
+       conn => $conn,
+       startterm => $startterm,
+       _ss => $_ss,
+    }, $class;
+}
+
+# PRIVATE to this class
+sub _ss {
+    my $this = shift();
+
+    my $_ss = $this->{_ss};
+    die "{_ss} undefined: has this ScanSet been destroy()ed?"
+       if !defined $_ss;
+
+    return $_ss;
+}
+
+sub size {
+    my $this = shift();
+
+    return Net::Z3950::ZOOM::scanset_size($this->_ss());
+}
+
+sub term {
+    my $this = shift();
+    my($which) = @_;
+
+    my($occ, $len) = (0, 0);
+    my $term = Net::Z3950::ZOOM::scanset_term($this->_ss(), $which,
+                                             $occ, $len);
+    return undef if !defined $term;
+    die "length of term '$term' differs from returned len=$len"
+       if length($term) != $len;
+
+    return ($term, $occ);
+}
+
+sub display_term {
+    my $this = shift();
+    my($which) = @_;
+
+    my($occ, $len) = (0, 0);
+    my $term = Net::Z3950::ZOOM::scanset_display_term($this->_ss(), $which,
+                                                     $occ, $len);
+    return undef if !defined $term;
+    die "length of display term '$term' differs from returned len=$len"
+       if length($term) != $len;
+
+    return ($term, $occ);
+}
+
+sub destroy {
+    my $this = shift();
+
+    Net::Z3950::ZOOM::scanset_destroy($this->_ss());
+    $this->{_ss} = undef;
+}
+
 
 1;