lib/ZOOM.pm

   1 # $Id: ZOOM.pm,v 1.3 2005-10-11 16:23:32 mike Exp $
   2
   3 use strict;
   4 use warnings;
   5 use Net::Z3950::ZOOM;
   6
   7
   8 # Member naming convention: hash-element names which begin with an
   9 # underscore represent underlying ZOOM-C object descriptors; those
  10 # which do not represent Perl's ZOOM objects.  (The same convention is
  11 # used in naming local variables.)
  12 #
  13 # So, for example, the ZOOM::Connection class has an {_conn} element,
  14 # which is a pointer to the ZOOM-C Connection object; but the
  15 # ZOOM::ResultSet class has a {conn} element, which is a reference to
  16 # the Perl-level Connection object by which it was created.
  17 #
  18 # To get at the underlying ZOOM-C connection object of a result-set
  19 # (if you ever needed to do such a thing, which you probably don't)
  20 # you'd use $rs->{conn}->_conn().
  21
  22 # ----------------------------------------------------------------------------
  23
  24 package ZOOM::Exception;
  25
  26 sub new {
  27     my $class = shift();
  28     my($code, $message, $addinfo) = @_;
  29
  30     return bless {
  31         code => $code,
  32         message => $message,
  33         addinfo => $addinfo,
  34     }, $class;
  35 }
  36
  37 sub code {
  38     my $this = shift();
  39     return $this->code();
  40 }
  41
  42 sub message {
  43     my $this = shift();
  44     return $this->message();
  45 }
  46
  47 sub addinfo {
  48     my $this = shift();
  49     return $this->addinfo();
  50 }
  51
  52
  53 # ----------------------------------------------------------------------------
  54
  55 package ZOOM::Connection;
  56
  57 sub new {
  58     my $class = shift();
  59     my($host, $port) = @_;
  60
  61     my $_conn = Net::Z3950::ZOOM::connection_new($host, $port);
  62     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
  63     $errcode = Net::Z3950::ZOOM::connection_error($_conn, $errmsg, $addinfo);
  64     die new ZOOM::Exception($errcode, $errmsg, $addinfo) if $errcode;
  65
  66     return bless {
  67         host => $host,
  68         port => $port,
  69         _conn => $_conn,
  70     };
  71 }
  72
  73 # PRIVATE within this class
  74 sub _conn {
  75     my $this = shift();
  76
  77     return $this->{_conn};
  78 }
  79
  80 sub option_set {
  81     my $this = shift();
  82     my($key, $value) = @_;
  83
  84     Net::Z3950::ZOOM::connection_option_set($this->_conn(), $key, $value);
  85 }
  86
  87 sub search_pqf {
  88     my $this = shift();
  89     my($query) = @_;
  90
  91     my $_rs = Net::Z3950::ZOOM::connection_search_pqf($this->_conn(), $query);
  92     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
  93     $errcode = Net::Z3950::ZOOM::connection_error($this->_conn(),
  94                                                   $errmsg, $addinfo);
  95     die new ZOOM::Exception($errcode, $errmsg, $addinfo) if $errcode;
  96
  97     return _new ZOOM::ResultSet($this, $query, $_rs);
  98 }
  99
 100
 101 # ----------------------------------------------------------------------------
 102
 103 package ZOOM::ResultSet;
 104
 105 sub new {
 106     my $class = shift();
 107     die "You can't create $class objects directly";
 108 }
 109
 110 # PRIVATE to ZOOM::Connection::search()
 111 sub _new {
 112     my $class = shift();
 113     my($conn, $query, $_rs) = @_;
 114
 115     return bless {
 116         conn => $conn,
 117         query => $query,
 118         _rs => $_rs,
 119     }, $class;
 120 }
 121
 122 # PRIVATE within this class
 123 sub _rs {
 124     my $this = shift();
 125
 126     return $this->{rs};
 127 }
 128
 129 sub size {
 130     my $this = shift();
 131
 132     return Net::Z3950::ZOOM::resultset_size($this->_rs());
 133 }
 134
 135 sub record {
 136     my $this = shift();
 137     my($which) = @_;
 138
 139     my $_rec = Net::Z3950::ZOOM::resultset_record($this->_rs(), $which);
 140     ### Check for error -- but how?
 141     return _new ZOOM::Record($this, $which, $_rec);
 142 }
 143
 144
 145 # ----------------------------------------------------------------------------
 146
 147 package ZOOM::Record;
 148
 149 sub new {
 150     my $class = shift();
 151     die "You can't create $class objects directly";
 152 }
 153
 154 # PRIVATE to ZOOM::ResultSet::record()
 155 sub _new {
 156     my $class = shift();
 157     my($rs, $which, $_rec) = @_;
 158
 159     return bless {
 160         rs => $rs,
 161         which => $which,
 162         _rec => $_rec,
 163     }, $class;
 164 }