lib/ZOOM.pm

   1 # $Id: ZOOM.pm,v 1.4 2005-10-12 09:44:46 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 lack them represent Perl's ZOOM objects.  (The same convention
  11 # is used in naming local variables where appropriate.)
  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.  (It may
  17 # be that we find we have no need for these references, but for now
  18 # they are retained.)
  19 #
  20 # To get at the underlying ZOOM-C connection object of a result-set
  21 # (if you ever needed to do such a thing, which you probably don't)
  22 # you'd use $rs->{conn}->_conn().
  23
  24 # ----------------------------------------------------------------------------
  25
  26 package ZOOM::Exception;
  27
  28 sub new {
  29     my $class = shift();
  30     my($code, $message, $addinfo) = @_;
  31
  32     return bless {
  33         code => $code,
  34         message => $message,
  35         addinfo => $addinfo,
  36     }, $class;
  37 }
  38
  39 sub code {
  40     my $this = shift();
  41     return $this->code();
  42 }
  43
  44 sub message {
  45     my $this = shift();
  46     return $this->message();
  47 }
  48
  49 sub addinfo {
  50     my $this = shift();
  51     return $this->addinfo();
  52 }
  53
  54
  55 # ----------------------------------------------------------------------------
  56
  57 package ZOOM::Connection;
  58
  59 sub new {
  60     my $class = shift();
  61     my($host, $port) = @_;
  62
  63     my $_conn = Net::Z3950::ZOOM::connection_new($host, $port);
  64     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
  65     $errcode = Net::Z3950::ZOOM::connection_error($_conn, $errmsg, $addinfo);
  66     die new ZOOM::Exception($errcode, $errmsg, $addinfo) if $errcode;
  67
  68     return bless {
  69         host => $host,
  70         port => $port,
  71         _conn => $_conn,
  72     };
  73 }
  74
  75 # PRIVATE within this class
  76 sub _conn {
  77     my $this = shift();
  78
  79     my $_conn = $this->{_conn};
  80     die "{_conn} undefined: has this ResultSet been destroy()ed?"
  81         if !defined $_conn;
  82
  83     return $_conn;
  84 }
  85
  86 sub option {
  87     my $this = shift();
  88     my($key, $value) = @_;
  89
  90     my $oldval = Net::Z3950::ZOOM::connection_option_get($this->_conn(), $key);
  91     Net::Z3950::ZOOM::connection_option_set($this->_conn(), $key, $value)
  92         if defined $value;
  93
  94     return $oldval;
  95 }
  96
  97 sub search_pqf {
  98     my $this = shift();
  99     my($query) = @_;
 100
 101     my $_rs = Net::Z3950::ZOOM::connection_search_pqf($this->_conn(), $query);
 102     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
 103     $errcode = Net::Z3950::ZOOM::connection_error($this->_conn(),
 104                                                   $errmsg, $addinfo);
 105     die new ZOOM::Exception($errcode, $errmsg, $addinfo) if $errcode;
 106
 107     return _new ZOOM::ResultSet($this, $query, $_rs);
 108 }
 109
 110 sub destroy {
 111     my $this = shift();
 112
 113     Net::Z3950::ZOOM::connection_destroy($this->_conn());
 114     $this->{_conn} = undef;
 115 }
 116
 117
 118 # ----------------------------------------------------------------------------
 119
 120 package ZOOM::ResultSet;
 121
 122 sub new {
 123     my $class = shift();
 124     die "You can't create $class objects directly";
 125 }
 126
 127 # PRIVATE to ZOOM::Connection::search()
 128 sub _new {
 129     my $class = shift();
 130     my($conn, $query, $_rs) = @_;
 131
 132     return bless {
 133         conn => $conn,
 134         query => $query,
 135         _rs => $_rs,
 136     }, $class;
 137 }
 138
 139 # PRIVATE within this class
 140 sub _rs {
 141     my $this = shift();
 142
 143     my $_rs = $this->{_rs};
 144     die "{_rs} undefined: has this ResultSet been destroy()ed?"
 145         if !defined $_rs;
 146
 147     return $_rs;
 148 }
 149
 150 sub size {
 151     my $this = shift();
 152
 153     return Net::Z3950::ZOOM::resultset_size($this->_rs());
 154 }
 155
 156 sub record {
 157     my $this = shift();
 158     my($which) = @_;
 159
 160     my $_rec = Net::Z3950::ZOOM::resultset_record($this->_rs(), $which);
 161     ### Check for error -- but how?
 162
 163     # For some reason, I have to use the explicit "->" syntax in order
 164     # to invoke the ZOOM::Record constructor here, even though I don't
 165     # have to do the same for _new ZOOM::ResultSet above.  Weird.
 166     return ZOOM::Record->_new($this, $which, $_rec);
 167 }
 168
 169 sub destroy {
 170     my $this = shift();
 171
 172     Net::Z3950::ZOOM::resultset_destroy($this->_rs());
 173     $this->{_rs} = undef;
 174 }
 175
 176
 177 # ----------------------------------------------------------------------------
 178
 179 package ZOOM::Record;
 180
 181 sub new {
 182     my $class = shift();
 183     die "You can't create $class objects directly";
 184 }
 185
 186 # PRIVATE to ZOOM::ResultSet::record()
 187 sub _new {
 188     my $class = shift();
 189     my($rs, $which, $_rec) = @_;
 190
 191     return bless {
 192         rs => $rs,
 193         which => $which,
 194         _rec => $_rec,
 195     }, $class;
 196 }
 197
 198 # PRIVATE within this class
 199 sub _rec {
 200     my $this = shift();
 201
 202     return $this->{_rec};
 203 }
 204
 205 sub render {
 206     my $this = shift();
 207
 208     my $len = 0;
 209     my $string = Net::Z3950::ZOOM::record_get($this->_rec(), "render", $len);
 210     # I don't think we need '$len' at all.  ### Probably the Perl-to-C
 211     # glue code should use the value of `len' as well as the opaque
 212     # data-pointer returned, to ensure that the SV contains all of the
 213     # returned data and does not stop at the first NUL character in
 214     # binary data.  Carefully check the ZOOM_record_get() documentation.
 215     return $string;
 216 }
 217
 218 sub raw {
 219     my $this = shift();
 220
 221     my $len = 0;
 222     my $string = Net::Z3950::ZOOM::record_get($this->_rec(), "raw", $len);
 223     # See comment about $len in render()
 224     return $string;
 225 }
 226
 227
 228 1;