Many changes to the ZOOM::Options class:

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

diff --git a/lib/ZOOM.pm b/lib/ZOOM.pm
index 1542c6d..a75c407 100644 (file)
--- a/lib/ZOOM.pm
+++ b/lib/ZOOM.pm
@@ -1,4 +1,4 @@
-# $Id: ZOOM.pm,v 1.6 2005-10-12 16:13:20 mike Exp $
+# $Id: ZOOM.pm,v 1.8 2005-10-19 13:53:35 mike Exp $
 
 use strict;
 use warnings;
@@ -67,6 +67,7 @@ package ZOOM::Exception;
 sub new {
     my $class = shift();
     my($code, $message, $addinfo) = @_;
+    ### support diag-set, too
 
     return bless {
        code => $code,
@@ -93,6 +94,101 @@ sub addinfo {
 
 # ----------------------------------------------------------------------------
 
+package ZOOM::Options;
+
+sub new {
+    my $class = shift();
+    my($p1, $p2) = @_;
+
+    my $opts;
+    if (@_ == 0) {
+       $opts = Net::Z3950::ZOOM::options_create();
+    } elsif (@_ == 1) {
+       $opts = Net::Z3950::ZOOM::options_create_with_parent($p1->_opts());
+    } elsif (@_ == 2) {
+       $opts = Net::Z3950::ZOOM::options_create_with_parent2($p1->_opts(),
+                                                             $p2->_opts());
+    } else {
+       die "can't make $class object with more than 2 parents";
+    }
+
+    return bless {
+       _opts => $opts,
+    }, $class;
+}
+
+sub _opts {
+    my $this = shift();
+
+    my $_opts = $this->{_opts};
+    die "{_opts} undefined: has this Options block been destroy()ed?"
+       if !defined $_opts;
+
+    return $_opts;
+}
+
+sub option {
+    my $this = shift();
+    my($key, $value) = @_;
+
+    my $oldval = Net::Z3950::ZOOM::options_get($this->_opts(), $key);
+    Net::Z3950::ZOOM::options_set($this->_opts(), $key, $value)
+       if defined $value;
+
+    return $oldval;
+}
+
+sub option_binary {
+    my $this = shift();
+    my($key, $value) = @_;
+
+    my $dummylen = 0;
+    my $oldval = Net::Z3950::ZOOM::options_getl($this->_opts(),
+                                               $key, $dummylen);
+    Net::Z3950::ZOOM::options_setl($this->_opts(), $key,
+                                  $value, length($value))
+       if defined $value;
+
+    return $oldval;
+}
+
+# This is a bit stupid, since the scalar values that Perl returns from
+# option() can be used as a boolean; but it's just possible that some
+# applications will rely on ZOOM_options_get_bool()'s idiosyncratic
+# interpretation of what constitutes truth.
+#
+sub bool {
+    my $this = shift();
+    my($key, $default) = @_;
+
+    return Net::Z3950::ZOOM::options_get_bool($this->_opts(), $key, $default);
+}
+
+# .. and the next two are even more stupid
+sub int {
+    my $this = shift();
+    my($key, $default) = @_;
+
+    return Net::Z3950::ZOOM::options_get_int($this->_opts(), $key, $default);
+}
+
+sub set_int {
+    my $this = shift();
+    my($key, $value) = @_;
+
+    Net::Z3950::ZOOM::options_set_int($this->_opts(), $key, $value);
+}
+
+sub destroy {
+    my $this = shift();
+
+    Net::Z3950::ZOOM::options_destroy($this->_opts());
+    $this->{_opts} = undef;
+}
+
+
+# ----------------------------------------------------------------------------
+
 package ZOOM::Connection;
 
 sub new {
@@ -111,6 +207,18 @@ sub new {
     };
 }
 
+sub create {
+    my $class = shift();
+    my($options) = @_;
+
+    my $_conn = Net::Z3950::ZOOM::connection_create($options->_opts());
+    return bless {
+       host => undef,
+       port => undef,
+       _conn => $_conn,
+    };
+}
+
 # PRIVATE within this class
 sub _conn {
     my $this = shift();
@@ -122,6 +230,42 @@ sub _conn {
     return $_conn;
 }
 
+sub error_x {
+    my $this = shift();
+
+    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);
+}
+
+sub errcode {
+    my $this = shift();
+    return Net::Z3950::ZOOM::connection_errcode($this->_conn());
+}
+
+sub errmsg {
+    my $this = shift();
+    return Net::Z3950::ZOOM::connection_errmsg($this->_conn());
+}
+
+sub addinfo {
+    my $this = shift();
+    return Net::Z3950::ZOOM::connection_addinfo($this->_conn());
+}
+
+sub connect {
+    my $this = shift();
+    my($host, $port) = @_;
+
+    Net::Z3950::ZOOM::connection_connect($this->_conn(), $host, $port);
+    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;
+    # No return value
+}
+
 sub option {
     my $this = shift();
     my($key, $value) = @_;
@@ -133,6 +277,21 @@ sub option {
     return $oldval;
 }
 
+sub option_binary {
+    my $this = shift();
+    my($key, $value) = @_;
+
+    my $dummylen = 0;
+    my $oldval = Net::Z3950::ZOOM::connection_option_getl($this->_conn(),
+                                                         $key, $dummylen);
+    Net::Z3950::ZOOM::connection_option_setl($this->_conn(), $key,
+                                            $value, length($value))
+       if defined $value;
+
+    return $oldval;
+}
+
+
 sub search_pqf {
     my $this = shift();
     my($query) = @_;