As far as I can tell, I have added Extended Services support, in the
authormike <mike>
Tue, 8 Nov 2005 15:55:45 +0000 (15:55 +0000)
committermike <mike>
Tue, 8 Nov 2005 15:55:45 +0000 (15:55 +0000)
form of the ZOOM::Connection::package() method and the ZOOM::Package
class (and, OK, the ZOOM::Error::PACKAGE error-code if you want to be
pedantic).  But it's hard to know whether that's meaningfully true as
I don't yet know how to _use_ these functions.

lib/ZOOM.pm

index 4fd8502..b0a3792 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.14 2005-11-08 11:46:59 mike Exp $
+# $Id: ZOOM.pm,v 1.15 2005-11-08 15:55:45 mike Exp $
 
 use strict;
 use warnings;
@@ -46,6 +46,7 @@ sub QUERY_CQL { 20002 }
 sub QUERY_PQF { 20003 }
 sub SORTBY { 20004 }
 sub CLONE { 20005 }
+sub PACKAGE { 20006 }
 
 # The "Event" package contains constants returned by last_event()
 package ZOOM::Event;
@@ -78,6 +79,8 @@ sub diag_str {
        return "can't set sort-specification";
     } elsif ($code == ZOOM::Error::CLONE) {
        return "can't clone record";
+    } elsif ($code == ZOOM::Error::PACKAGE) {
+       return "can't create package";
     }
 
     return Net::Z3950::ZOOM::diag_str($code);
@@ -147,6 +150,9 @@ sub new {
     }, $class;
 }
 
+# PRIVATE to this class and ZOOM::Connection::create() and
+# ZOOM::Connection::package()
+#
 sub _opts {
     my $this = shift();
 
@@ -385,6 +391,18 @@ sub scan {
     return _new ZOOM::ScanSet($this, $startterm, $_ss);
 }
 
+sub package {
+    my $this = shift();
+    my($options) = @_;
+
+    my $_o = defined $options ? $options->_opts() :
+       Net::Z3950::ZOOM::options_create();
+    my $_p = Net::Z3950::ZOOM::connection_package($this->_conn(), $_o)
+       or ZOOM::_oops(ZOOM::Error::PACKAGE);
+
+    return _new ZOOM::Package($this, $options, $_p);
+}
+
 sub destroy {
     my $this = shift();
 
@@ -738,4 +756,66 @@ sub destroy {
 }
 
 
+# ----------------------------------------------------------------------------
+
+package ZOOM::Package;
+
+sub new {
+    my $class = shift();
+    die "You can't create $class objects directly";
+}
+
+# PRIVATE to ZOOM::Connection::package(),
+sub _new {
+    my $class = shift();
+    my($conn, $options, $_p) = @_;
+
+    return bless {
+       conn => $conn,
+       options => $options,
+       _p => $_p,
+    }, $class;
+}
+
+# PRIVATE to this class
+sub _p {
+    my $this = shift();
+
+    my $_p = $this->{_p};
+    die "{_p} undefined: has this Package been destroy()ed?"
+       if !defined $_p;
+
+    return $_p;
+}
+
+sub option {
+    my $this = shift();
+    my($key, $value) = @_;
+
+    my $oldval = Net::Z3950::ZOOM::package_option_get($this->_p(), $key);
+    Net::Z3950::ZOOM::package_option_set($this->_p(), $key, $value)
+       if defined $value;
+
+    return $oldval;
+}
+
+sub send {
+    my $this = shift();
+    my($type) = @_;
+
+    Net::Z3950::ZOOM::package_send($this->_p(), $type);
+    my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
+    $errcode = Net::Z3950::ZOOM::connection_error($this->{conn}->_conn(),
+                                                 $errmsg, $addinfo);
+    die new ZOOM::Exception($errcode, $errmsg, $addinfo) if $errcode;
+}
+
+sub destroy {
+    my $this = shift();
+
+    Net::Z3950::ZOOM::package_destroy($this->_p());
+    $this->{_p} = undef;
+}
+
+
 1;