-# $Id: ZOOM.pm,v 1.4 2005-10-12 09:44:46 mike Exp $
+# $Id: ZOOM.pm,v 1.7 2005-10-17 13:47:25 mike Exp $
use strict;
use warnings;
use Net::Z3950::ZOOM;
+package ZOOM;
+
+sub diag_str {
+ my($code) = @_;
+ return Net::Z3950::ZOOM::diag_str($code);
+}
+
+
# Member naming convention: hash-element names which begin with an
# underscore represent underlying ZOOM-C object descriptors; those
# which lack them represent Perl's ZOOM objects. (The same convention
# ----------------------------------------------------------------------------
+# The "Error" package contains constants returned as error-codes.
+package ZOOM::Error;
+sub NONE { Net::Z3950::ZOOM::ERROR_NONE }
+sub CONNECT { Net::Z3950::ZOOM::ERROR_CONNECT }
+sub MEMORY { Net::Z3950::ZOOM::ERROR_MEMORY }
+sub ENCODE { Net::Z3950::ZOOM::ERROR_ENCODE }
+sub DECODE { Net::Z3950::ZOOM::ERROR_DECODE }
+sub CONNECTION_LOST { Net::Z3950::ZOOM::ERROR_CONNECTION_LOST }
+sub INIT { Net::Z3950::ZOOM::ERROR_INIT }
+sub INTERNAL { Net::Z3950::ZOOM::ERROR_INTERNAL }
+sub TIMEOUT { Net::Z3950::ZOOM::ERROR_TIMEOUT }
+sub UNSUPPORTED_PROTOCOL { Net::Z3950::ZOOM::ERROR_UNSUPPORTED_PROTOCOL }
+sub UNSUPPORTED_QUERY { Net::Z3950::ZOOM::ERROR_UNSUPPORTED_QUERY }
+sub INVALID_QUERY { Net::Z3950::ZOOM::ERROR_INVALID_QUERY }
+
+# The "Event" package contains constants returned by last_event()
+package ZOOM::Event;
+sub NONE { Net::Z3950::ZOOM::EVENT_NONE }
+sub CONNECT { Net::Z3950::ZOOM::EVENT_CONNECT }
+sub SEND_DATA { Net::Z3950::ZOOM::EVENT_SEND_DATA }
+sub RECV_DATA { Net::Z3950::ZOOM::EVENT_RECV_DATA }
+sub TIMEOUT { Net::Z3950::ZOOM::EVENT_TIMEOUT }
+sub UNKNOWN { Net::Z3950::ZOOM::EVENT_UNKNOWN }
+sub SEND_APDU { Net::Z3950::ZOOM::EVENT_SEND_APDU }
+sub RECV_APDU { Net::Z3950::ZOOM::EVENT_RECV_APDU }
+sub RECV_RECORD { Net::Z3950::ZOOM::EVENT_RECV_RECORD }
+sub RECV_SEARCH { Net::Z3950::ZOOM::EVENT_RECV_SEARCH }
+
+
+# ----------------------------------------------------------------------------
+
package ZOOM::Exception;
sub new {
my $class = shift();
my($code, $message, $addinfo) = @_;
+ ### support diag-set, too
return bless {
code => $code,
sub code {
my $this = shift();
- return $this->code();
+ return $this->{code};
}
sub message {
my $this = shift();
- return $this->message();
+ return $this->{message};
}
sub addinfo {
my $this = shift();
- return $this->addinfo();
+ return $this->{addinfo};
}
# ----------------------------------------------------------------------------
+package ZOOM::Options;
+
+sub new {
+ my $class = shift();
+ ### Should use create_with_parent{,2}() depending on arguments
+
+ return bless {
+ _opts => Net::Z3950::ZOOM::options_create(),
+ }, $class;
+}
+
+sub _opts {
+ my $this = shift();
+
+ return $this->{_opts};
+}
+
+# ----------------------------------------------------------------------------
+
package ZOOM::Connection;
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();
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) = @_;
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) = @_;