lib/ZOOM.pm

   1 # $Id: ZOOM.pm,v 1.26 2006-02-10 16:24:34 mike Exp $
   2
   3 use strict;
   4 use warnings;
   5 use Net::Z3950::ZOOM;
   6
   7
   8 package ZOOM;
   9
  10
  11 # Member naming convention: hash-element names which begin with an
  12 # underscore represent underlying ZOOM-C object descriptors; those
  13 # which lack them represent Perl's ZOOM objects.  (The same convention
  14 # is used in naming local variables where appropriate.)
  15 #
  16 # So, for example, the ZOOM::Connection class has an {_conn} element,
  17 # which is a pointer to the ZOOM-C Connection object; but the
  18 # ZOOM::ResultSet class has a {conn} element, which is a reference to
  19 # the Perl-level Connection object by which it was created.  (It may
  20 # be that we find we have no need for these references, but for now
  21 # they are retained.)
  22 #
  23 # To get at the underlying ZOOM-C connection object of a result-set
  24 # (if you ever needed to do such a thing, which you probably don't)
  25 # you'd use $rs->{conn}->_conn().
  26
  27 # ----------------------------------------------------------------------------
  28
  29 # The "Error" package contains constants returned as error-codes.
  30 package ZOOM::Error;
  31 sub NONE { Net::Z3950::ZOOM::ERROR_NONE }
  32 sub CONNECT { Net::Z3950::ZOOM::ERROR_CONNECT }
  33 sub MEMORY { Net::Z3950::ZOOM::ERROR_MEMORY }
  34 sub ENCODE { Net::Z3950::ZOOM::ERROR_ENCODE }
  35 sub DECODE { Net::Z3950::ZOOM::ERROR_DECODE }
  36 sub CONNECTION_LOST { Net::Z3950::ZOOM::ERROR_CONNECTION_LOST }
  37 sub INIT { Net::Z3950::ZOOM::ERROR_INIT }
  38 sub INTERNAL { Net::Z3950::ZOOM::ERROR_INTERNAL }
  39 sub TIMEOUT { Net::Z3950::ZOOM::ERROR_TIMEOUT }
  40 sub UNSUPPORTED_PROTOCOL { Net::Z3950::ZOOM::ERROR_UNSUPPORTED_PROTOCOL }
  41 sub UNSUPPORTED_QUERY { Net::Z3950::ZOOM::ERROR_UNSUPPORTED_QUERY }
  42 sub INVALID_QUERY { Net::Z3950::ZOOM::ERROR_INVALID_QUERY }
  43 sub CQL_PARSE { Net::Z3950::ZOOM::ERROR_CQL_PARSE }
  44 sub CQL_TRANSFORM { Net::Z3950::ZOOM::ERROR_CQL_TRANSFORM }
  45 # The following are added specifically for this OO interface
  46 sub CREATE_QUERY { 20001 }
  47 sub QUERY_CQL { 20002 }
  48 sub QUERY_PQF { 20003 }
  49 sub SORTBY { 20004 }
  50 sub CLONE { 20005 }
  51 sub PACKAGE { 20006 }
  52 sub SCANTERM { 20007 }
  53 sub LOGLEVEL { 20008 }
  54
  55 # The "Event" package contains constants returned by last_event()
  56 package ZOOM::Event;
  57 sub NONE { Net::Z3950::ZOOM::EVENT_NONE }
  58 sub CONNECT { Net::Z3950::ZOOM::EVENT_CONNECT }
  59 sub SEND_DATA { Net::Z3950::ZOOM::EVENT_SEND_DATA }
  60 sub RECV_DATA { Net::Z3950::ZOOM::EVENT_RECV_DATA }
  61 sub TIMEOUT { Net::Z3950::ZOOM::EVENT_TIMEOUT }
  62 sub UNKNOWN { Net::Z3950::ZOOM::EVENT_UNKNOWN }
  63 sub SEND_APDU { Net::Z3950::ZOOM::EVENT_SEND_APDU }
  64 sub RECV_APDU { Net::Z3950::ZOOM::EVENT_RECV_APDU }
  65 sub RECV_RECORD { Net::Z3950::ZOOM::EVENT_RECV_RECORD }
  66 sub RECV_SEARCH { Net::Z3950::ZOOM::EVENT_RECV_SEARCH }
  67
  68 # ----------------------------------------------------------------------------
  69
  70 package ZOOM;
  71
  72 sub diag_str {
  73     my($code) = @_;
  74
  75     # Special cases for error specific to the OO layer
  76     if ($code == ZOOM::Error::CREATE_QUERY) {
  77         return "can't create query object";
  78     } elsif ($code == ZOOM::Error::QUERY_CQL) {
  79         return "can't set CQL query";
  80     } elsif ($code == ZOOM::Error::QUERY_PQF) {
  81         return "can't set prefix query";
  82     } elsif ($code == ZOOM::Error::SORTBY) {
  83         return "can't set sort-specification";
  84     } elsif ($code == ZOOM::Error::CLONE) {
  85         return "can't clone record";
  86     } elsif ($code == ZOOM::Error::PACKAGE) {
  87         return "can't create package";
  88     } elsif ($code == ZOOM::Error::SCANTERM) {
  89         return "can't retrieve term from scan-set";
  90     } elsif ($code == ZOOM::Error::LOGLEVEL) {
  91         return "unregistered log-level";
  92     }
  93
  94     return Net::Z3950::ZOOM::diag_str($code);
  95 }
  96
  97 sub _oops {
  98     my($code, $addinfo, $diagset) = @_;
  99
 100     die new ZOOM::Exception($code, diag_str($code), $addinfo, $diagset);
 101 }
 102
 103 # ----------------------------------------------------------------------------
 104
 105 package ZOOM::Exception;
 106
 107 sub new {
 108     my $class = shift();
 109     my($code, $message, $addinfo, $diagset) = @_;
 110
 111     return bless {
 112         code => $code,
 113         message => $message,
 114         addinfo => $addinfo,
 115         diagset => $diagset || "ZOOM",
 116     }, $class;
 117 }
 118
 119 sub code {
 120     my $this = shift();
 121     return $this->{code};
 122 }
 123
 124 sub message {
 125     my $this = shift();
 126     return $this->{message};
 127 }
 128
 129 sub addinfo {
 130     my $this = shift();
 131     return $this->{addinfo};
 132 }
 133
 134 sub diagset {
 135     my $this = shift();
 136     return $this->{diagset};
 137 }
 138
 139 sub render {
 140     my $this = shift();
 141     my $res = "ZOOM error " . $this->code() . ' "' . $this->message() . '"';
 142     $res .= ' (addinfo: "' . $this->addinfo() . '")' if $this->addinfo();
 143     $res .= " from diag-set '" . $this->diagset() . "'" if $this->diagset();
 144     return $res;
 145 }
 146
 147 # This means that untrapped exceptions render nicely.
 148 use overload '""' => \&render;
 149
 150 # ----------------------------------------------------------------------------
 151
 152 package ZOOM::Options;
 153
 154 sub new {
 155     my $class = shift();
 156     my($p1, $p2) = @_;
 157
 158     my $opts;
 159     if (@_ == 0) {
 160         $opts = Net::Z3950::ZOOM::options_create();
 161     } elsif (@_ == 1) {
 162         $opts = Net::Z3950::ZOOM::options_create_with_parent($p1->_opts());
 163     } elsif (@_ == 2) {
 164         $opts = Net::Z3950::ZOOM::options_create_with_parent2($p1->_opts(),
 165                                                               $p2->_opts());
 166     } else {
 167         die "can't make $class object with more than 2 parents";
 168     }
 169
 170     return bless {
 171         _opts => $opts,
 172     }, $class;
 173 }
 174
 175 # PRIVATE to this class and ZOOM::Connection::create() and
 176 # ZOOM::Connection::package()
 177 #
 178 sub _opts {
 179     my $this = shift();
 180
 181     my $_opts = $this->{_opts};
 182     die "{_opts} undefined: has this Options block been destroy()ed?"
 183         if !defined $_opts;
 184
 185     return $_opts;
 186 }
 187
 188 sub option {
 189     my $this = shift();
 190     my($key, $value) = @_;
 191
 192     my $oldval = Net::Z3950::ZOOM::options_get($this->_opts(), $key);
 193     Net::Z3950::ZOOM::options_set($this->_opts(), $key, $value)
 194         if defined $value;
 195
 196     return $oldval;
 197 }
 198
 199 sub option_binary {
 200     my $this = shift();
 201     my($key, $value) = @_;
 202
 203     my $dummylen = 0;
 204     my $oldval = Net::Z3950::ZOOM::options_getl($this->_opts(),
 205                                                 $key, $dummylen);
 206     Net::Z3950::ZOOM::options_setl($this->_opts(), $key,
 207                                    $value, length($value))
 208         if defined $value;
 209
 210     return $oldval;
 211 }
 212
 213 # This is a bit stupid, since the scalar values that Perl returns from
 214 # option() can be used as a boolean; but it's just possible that some
 215 # applications will rely on ZOOM_options_get_bool()'s idiosyncratic
 216 # interpretation of what constitutes truth.
 217 #
 218 sub bool {
 219     my $this = shift();
 220     my($key, $default) = @_;
 221
 222     return Net::Z3950::ZOOM::options_get_bool($this->_opts(), $key, $default);
 223 }
 224
 225 # .. and the next two are even more stupid
 226 sub int {
 227     my $this = shift();
 228     my($key, $default) = @_;
 229
 230     return Net::Z3950::ZOOM::options_get_int($this->_opts(), $key, $default);
 231 }
 232
 233 sub set_int {
 234     my $this = shift();
 235     my($key, $value) = @_;
 236
 237     Net::Z3950::ZOOM::options_set_int($this->_opts(), $key, $value);
 238 }
 239
 240 #   ### Feel guilty.  Feel very, very guilty.  I've not been able to
 241 #       get the callback memory-management right in "ZOOM.xs", with
 242 #       the result that the values of $function and $udata passed into
 243 #       this function, which are on the stack, have sometimes been
 244 #       freed by the time they're used by __ZOOM_option_callback(),
 245 #       with hilarious results.  To avoid this, I copy the values into
 246 #       module-scoped globals, and pass _those_ into the extension
 247 #       function.  To avoid overwriting those globals by subsequent
 248 #       calls, I keep all the old ones, pushed onto the @_function and
 249 #       @_udata arrays, which means that THIS FUNCTION LEAKS MEMORY
 250 #       LIKE IT'S GOING OUT OF FASHION.  Not nice.  One day, I should
 251 #       fix this, but for now there's more important fish to fry.
 252 #
 253 my(@_function, @_udata);
 254 sub set_callback {
 255     my $o1 = shift();
 256     my($function, $udata) = @_;
 257
 258     push @_function, $function;
 259     push @_udata, $udata;
 260     Net::Z3950::ZOOM::options_set_callback($o1->_opts(),
 261                                            $_function[-1], $_udata[-1]);
 262 }
 263
 264 sub destroy {
 265     my $this = shift();
 266
 267     Net::Z3950::ZOOM::options_destroy($this->_opts());
 268     $this->{_opts} = undef;
 269 }
 270
 271
 272 # ----------------------------------------------------------------------------
 273
 274 package ZOOM::Connection;
 275
 276 sub new {
 277     my $class = shift();
 278     my($host, $port) = @_;
 279
 280     my $_conn = Net::Z3950::ZOOM::connection_new($host, $port || 0);
 281     my $conn = bless {
 282         host => $host,
 283         port => $port,
 284         _conn => $_conn,
 285     };
 286     $conn->_check();
 287     return $conn;
 288 }
 289
 290 # PRIVATE to this class and to ZOOM::Query::CQL2RPN::new()
 291 sub _conn {
 292     my $this = shift();
 293
 294     my $_conn = $this->{_conn};
 295     die "{_conn} undefined: has this Connection been destroy()ed?"
 296         if !defined $_conn;
 297
 298     return $_conn;
 299 }
 300
 301 sub _check {
 302     my $this = shift();
 303
 304     my($errcode, $errmsg, $addinfo, $diagset) = (undef, "x", "x", "x");
 305     $errcode = Net::Z3950::ZOOM::connection_error_x($this->_conn(), $errmsg,
 306                                                     $addinfo, $diagset);
 307     die new ZOOM::Exception($errcode, $errmsg, $addinfo, $diagset)
 308         if $errcode;
 309 }
 310
 311 sub create {
 312     my $class = shift();
 313     my($options) = @_;
 314
 315     my $_conn = Net::Z3950::ZOOM::connection_create($options->_opts());
 316     return bless {
 317         host => undef,
 318         port => undef,
 319         _conn => $_conn,
 320     };
 321 }
 322
 323 sub error_x {
 324     my $this = shift();
 325
 326     my($errcode, $errmsg, $addinfo, $diagset) = (undef, "dummy", "dummy", "d");
 327     $errcode = Net::Z3950::ZOOM::connection_error_x($this->_conn(), $errmsg,
 328                                                     $addinfo, $diagset);
 329     return ($errcode, $errmsg, $addinfo, $diagset);
 330 }
 331
 332 sub errcode {
 333     my $this = shift();
 334     return Net::Z3950::ZOOM::connection_errcode($this->_conn());
 335 }
 336
 337 sub errmsg {
 338     my $this = shift();
 339     return Net::Z3950::ZOOM::connection_errmsg($this->_conn());
 340 }
 341
 342 sub addinfo {
 343     my $this = shift();
 344     return Net::Z3950::ZOOM::connection_addinfo($this->_conn());
 345 }
 346
 347 sub diagset {
 348     my $this = shift();
 349     return Net::Z3950::ZOOM::connection_diagset($this->_conn());
 350 }
 351
 352 sub connect {
 353     my $this = shift();
 354     my($host, $port) = @_;
 355
 356     $port = 0 if !defined $port;
 357     Net::Z3950::ZOOM::connection_connect($this->_conn(), $host, $port);
 358     $this->_check();
 359     # No return value
 360 }
 361
 362 sub option {
 363     my $this = shift();
 364     my($key, $value) = @_;
 365
 366     my $oldval = Net::Z3950::ZOOM::connection_option_get($this->_conn(), $key);
 367     Net::Z3950::ZOOM::connection_option_set($this->_conn(), $key, $value)
 368         if defined $value;
 369
 370     return $oldval;
 371 }
 372
 373 sub option_binary {
 374     my $this = shift();
 375     my($key, $value) = @_;
 376
 377     my $dummylen = 0;
 378     my $oldval = Net::Z3950::ZOOM::connection_option_getl($this->_conn(),
 379                                                           $key, $dummylen);
 380     Net::Z3950::ZOOM::connection_option_setl($this->_conn(), $key,
 381                                              $value, length($value))
 382         if defined $value;
 383
 384     return $oldval;
 385 }
 386
 387 sub search {
 388     my $this = shift();
 389     my($query) = @_;
 390
 391     my $_rs = Net::Z3950::ZOOM::connection_search($this->_conn(),
 392                                                   $query->_query());
 393     $this->_check();
 394     return _new ZOOM::ResultSet($this, $query, $_rs);
 395 }
 396
 397 sub search_pqf {
 398     my $this = shift();
 399     my($pqf) = @_;
 400
 401     my $_rs = Net::Z3950::ZOOM::connection_search_pqf($this->_conn(), $pqf);
 402     $this->_check();
 403     return _new ZOOM::ResultSet($this, $pqf, $_rs);
 404 }
 405
 406 sub scan_pqf {
 407     my $this = shift();
 408     my($startterm) = @_;
 409
 410     my $_ss = Net::Z3950::ZOOM::connection_scan($this->_conn(), $startterm);
 411     $this->_check();
 412     return _new ZOOM::ScanSet($this, $startterm, $_ss);
 413 }
 414
 415 sub scan {
 416     my $this = shift();
 417     my($query) = @_;
 418
 419     my $_ss = Net::Z3950::ZOOM::connection_scan1($this->_conn(),
 420                                                  $query->_query());
 421     $this->_check();
 422     return _new ZOOM::ScanSet($this, $query, $_ss);
 423 }
 424
 425 sub package {
 426     my $this = shift();
 427     my($options) = @_;
 428
 429     my $_o = defined $options ? $options->_opts() :
 430         Net::Z3950::ZOOM::options_create();
 431     my $_p = Net::Z3950::ZOOM::connection_package($this->_conn(), $_o)
 432         or ZOOM::_oops(ZOOM::Error::PACKAGE);
 433
 434     return _new ZOOM::Package($this, $options, $_p);
 435 }
 436
 437 sub destroy {
 438     my $this = shift();
 439
 440     Net::Z3950::ZOOM::connection_destroy($this->_conn());
 441     $this->{_conn} = undef;
 442 }
 443
 444
 445 # ----------------------------------------------------------------------------
 446
 447 package ZOOM::Query;
 448
 449 sub new {
 450     my $class = shift();
 451     die "You can't create $class objects: it's a virtual base class";
 452 }
 453
 454 # PRIVATE to this class and ZOOM::Connection::search()
 455 sub _query {
 456     my $this = shift();
 457
 458     my $_query = $this->{_query};
 459     die "{_query} undefined: has this Query been destroy()ed?"
 460         if !defined $_query;
 461
 462     return $_query;
 463 }
 464
 465 sub sortby {
 466     my $this = shift();
 467     my($sortby) = @_;
 468
 469     Net::Z3950::ZOOM::query_sortby($this->_query(), $sortby) == 0
 470         or ZOOM::_oops(ZOOM::Error::SORTBY, $sortby);
 471 }
 472
 473 sub destroy {
 474     my $this = shift();
 475
 476     Net::Z3950::ZOOM::query_destroy($this->_query());
 477     $this->{_query} = undef;
 478 }
 479
 480
 481 package ZOOM::Query::CQL;
 482 our @ISA = qw(ZOOM::Query);
 483
 484 sub new {
 485     my $class = shift();
 486     my($string) = @_;
 487
 488     my $q = Net::Z3950::ZOOM::query_create()
 489         or ZOOM::_oops(ZOOM::Error::CREATE_QUERY);
 490     Net::Z3950::ZOOM::query_cql($q, $string) == 0
 491         or ZOOM::_oops(ZOOM::Error::QUERY_CQL, $string);
 492
 493     return bless {
 494         _query => $q,
 495     }, $class;
 496 }
 497
 498
 499 package ZOOM::Query::CQL2RPN;
 500 our @ISA = qw(ZOOM::Query);
 501
 502 sub new {
 503     my $class = shift();
 504     my($string, $conn) = @_;
 505
 506     my $q = Net::Z3950::ZOOM::query_create()
 507         or ZOOM::_oops(ZOOM::Error::CREATE_QUERY);
 508     # check() throws the exception we want; but we only want it on failure!
 509     Net::Z3950::ZOOM::query_cql2rpn($q, $string, $conn->_conn()) == 0
 510         or $conn->_check();
 511
 512     return bless {
 513         _query => $q,
 514     }, $class;
 515 }
 516
 517
 518 package ZOOM::Query::PQF;
 519 our @ISA = qw(ZOOM::Query);
 520
 521 sub new {
 522     my $class = shift();
 523     my($string) = @_;
 524
 525     my $q = Net::Z3950::ZOOM::query_create()
 526         or ZOOM::_oops(ZOOM::Error::CREATE_QUERY);
 527     Net::Z3950::ZOOM::query_prefix($q, $string) == 0
 528         or ZOOM::_oops(ZOOM::Error::QUERY_PQF, $string);
 529
 530     return bless {
 531         _query => $q,
 532     }, $class;
 533 }
 534
 535
 536 # ----------------------------------------------------------------------------
 537
 538 package ZOOM::ResultSet;
 539
 540 sub new {
 541     my $class = shift();
 542     die "You can't create $class objects directly";
 543 }
 544
 545 # PRIVATE to ZOOM::Connection::search() and ZOOM::Connection::search_pqf()
 546 sub _new {
 547     my $class = shift();
 548     my($conn, $query, $_rs) = @_;
 549
 550     return bless {
 551         conn => $conn,
 552         query => $query,        # This is not currently used, which is
 553                                 # just as well since it could be
 554                                 # either a string (when the RS is
 555                                 # created with search_pqf()) or a
 556                                 # ZOOM::Query object (when it's
 557                                 # created with search())
 558         _rs => $_rs,
 559     }, $class;
 560 }
 561
 562 # PRIVATE to this class
 563 sub _rs {
 564     my $this = shift();
 565
 566     my $_rs = $this->{_rs};
 567     die "{_rs} undefined: has this ResultSet been destroy()ed?"
 568         if !defined $_rs;
 569
 570     return $_rs;
 571 }
 572
 573 sub option {
 574     my $this = shift();
 575     my($key, $value) = @_;
 576
 577     my $oldval = Net::Z3950::ZOOM::resultset_option_get($this->_rs(), $key);
 578     Net::Z3950::ZOOM::resultset_option_set($this->_rs(), $key, $value)
 579         if defined $value;
 580
 581     return $oldval;
 582 }
 583
 584 sub size {
 585     my $this = shift();
 586
 587     return Net::Z3950::ZOOM::resultset_size($this->_rs());
 588 }
 589
 590 sub record {
 591     my $this = shift();
 592     my($which) = @_;
 593
 594     my $_rec = Net::Z3950::ZOOM::resultset_record($this->_rs(), $which);
 595     $this->{conn}->_check();
 596
 597     # Even if no error has occurred, I think record() might
 598     # legitimately return undef if we're running in asynchronous mode
 599     # and the record just hasn't been retrieved yet.  This goes double
 600     # for record_immediate().
 601     return undef if !defined $_rec;
 602
 603     # For some reason, I have to use the explicit "->" syntax in order
 604     # to invoke the ZOOM::Record constructor here, even though I don't
 605     # have to do the same for _new ZOOM::ResultSet above.  Weird.
 606     return ZOOM::Record->_new($this, $which, $_rec);
 607 }
 608
 609 sub record_immediate {
 610     my $this = shift();
 611     my($which) = @_;
 612
 613     my $_rec = Net::Z3950::ZOOM::resultset_record_immediate($this->_rs(),
 614                                                             $which);
 615     $this->{conn}->_check();
 616     # The record might legitimately not be there yet
 617     return undef if !defined $_rec;
 618
 619     return ZOOM::Record->_new($this, $which, $_rec);
 620 }
 621
 622 sub cache_reset {
 623     my $this = shift();
 624
 625     Net::Z3950::ZOOM::resultset_cache_reset($this->_rs());
 626 }
 627
 628 sub records {
 629     my $this = shift();
 630     my($start, $count, $return_records) = @_;
 631
 632     my $raw = Net::Z3950::ZOOM::resultset_records($this->_rs(), $start, $count,
 633                                                   $return_records);
 634     # By design, $raw may be undefined (if $return_records is true)
 635     return undef if !defined $raw;
 636
 637     # We need to package up the returned records in ZOOM::Record objects
 638     my @res = ();
 639     for my $i (0 .. @$raw-1) {
 640         my $_rec = $raw->[$i];
 641         if (!defined $_rec) {
 642             push @res, undef;
 643         } else {
 644             push @res, ZOOM::Record->_new($this, $start+$i, $_rec);
 645         }
 646     }
 647
 648     return \@res;
 649 }
 650
 651 sub sort {
 652     my $this = shift();
 653     my($sort_type, $sort_spec) = @_;
 654
 655     return Net::Z3950::ZOOM::resultset_sort1($this->_rs(),
 656                                              $sort_type, $sort_spec);
 657 }
 658
 659 sub destroy {
 660     my $this = shift();
 661
 662     Net::Z3950::ZOOM::resultset_destroy($this->_rs());
 663     $this->{_rs} = undef;
 664 }
 665
 666
 667 # ----------------------------------------------------------------------------
 668
 669 package ZOOM::Record;
 670
 671 sub new {
 672     my $class = shift();
 673     die "You can't create $class objects directly";
 674 }
 675
 676 # PRIVATE to ZOOM::ResultSet::record(),
 677 # ZOOM::ResultSet::record_immediate(), ZOOM::ResultSet::records() and
 678 # ZOOM::Record::clone()
 679 #
 680 sub _new {
 681     my $class = shift();
 682     my($rs, $which, $_rec) = @_;
 683
 684     return bless {
 685         rs => $rs,
 686         which => $which,
 687         _rec => $_rec,
 688     }, $class;
 689 }
 690
 691 # PRIVATE to this class
 692 sub _rec {
 693     my $this = shift();
 694
 695     my $_rec = $this->{_rec};
 696     die "{_rec} undefined: has this Record been destroy()ed?"
 697         if !defined $_rec;
 698
 699     return $_rec;
 700 }
 701
 702 sub render {
 703     my $this = shift();
 704
 705     my $len = 0;
 706     my $string = Net::Z3950::ZOOM::record_get($this->_rec(), "render", $len);
 707     # I don't think we need '$len' at all.  ### Probably the Perl-to-C
 708     # glue code should use the value of `len' as well as the opaque
 709     # data-pointer returned, to ensure that the SV contains all of the
 710     # returned data and does not stop at the first NUL character in
 711     # binary data.  Carefully check the ZOOM_record_get() documentation.
 712     return $string;
 713 }
 714
 715 sub raw {
 716     my $this = shift();
 717
 718     my $len = 0;
 719     my $string = Net::Z3950::ZOOM::record_get($this->_rec(), "raw", $len);
 720     # See comment about $len in render()
 721     return $string;
 722 }
 723
 724 sub clone {
 725     my $this = shift();
 726
 727     my $raw = Net::Z3950::ZOOM::record_clone($this->_rec())
 728         or ZOOM::_oops(ZOOM::Error::CLONE);
 729
 730     # Arg 1 (rs) is undefined as the new record doesn't belong to an RS
 731     return _new ZOOM::Record(undef, undef, $raw);
 732 }
 733
 734 sub destroy {
 735     my $this = shift();
 736
 737     Net::Z3950::ZOOM::record_destroy($this->_rec());
 738     $this->{_rec} = undef;
 739 }
 740
 741
 742 # ----------------------------------------------------------------------------
 743
 744 package ZOOM::ScanSet;
 745
 746 sub new {
 747     my $class = shift();
 748     die "You can't create $class objects directly";
 749 }
 750
 751 # PRIVATE to ZOOM::Connection::scan(),
 752 sub _new {
 753     my $class = shift();
 754     my($conn, $startterm, $_ss) = @_;
 755
 756     return bless {
 757         conn => $conn,
 758         startterm => $startterm,# This is not currently used, which is
 759                                 # just as well since it could be
 760                                 # either a string (when the SS is
 761                                 # created with scan()) or a
 762                                 # ZOOM::Query object (when it's
 763                                 # created with scan1())
 764         _ss => $_ss,
 765     }, $class;
 766 }
 767
 768 # PRIVATE to this class
 769 sub _ss {
 770     my $this = shift();
 771
 772     my $_ss = $this->{_ss};
 773     die "{_ss} undefined: has this ScanSet been destroy()ed?"
 774         if !defined $_ss;
 775
 776     return $_ss;
 777 }
 778
 779 sub option {
 780     my $this = shift();
 781     my($key, $value) = @_;
 782
 783     my $oldval = Net::Z3950::ZOOM::scanset_option_get($this->_ss(), $key);
 784     Net::Z3950::ZOOM::scanset_option_set($this->_ss(), $key, $value)
 785         if defined $value;
 786
 787     return $oldval;
 788 }
 789
 790 sub size {
 791     my $this = shift();
 792
 793     return Net::Z3950::ZOOM::scanset_size($this->_ss());
 794 }
 795
 796 sub term {
 797     my $this = shift();
 798     my($which) = @_;
 799
 800     my($occ, $len) = (0, 0);
 801     my $term = Net::Z3950::ZOOM::scanset_term($this->_ss(), $which,
 802                                               $occ, $len)
 803         or ZOOM::_oops(ZOOM::Error::SCANTERM);
 804
 805     die "length of term '$term' differs from returned len=$len"
 806         if length($term) != $len;
 807
 808     return ($term, $occ);
 809 }
 810
 811 sub display_term {
 812     my $this = shift();
 813     my($which) = @_;
 814
 815     my($occ, $len) = (0, 0);
 816     my $term = Net::Z3950::ZOOM::scanset_display_term($this->_ss(), $which,
 817                                                       $occ, $len)
 818         or ZOOM::_oops(ZOOM::Error::SCANTERM);
 819
 820     die "length of display term '$term' differs from returned len=$len"
 821         if length($term) != $len;
 822
 823     return ($term, $occ);
 824 }
 825
 826 sub destroy {
 827     my $this = shift();
 828
 829     Net::Z3950::ZOOM::scanset_destroy($this->_ss());
 830     $this->{_ss} = undef;
 831 }
 832
 833
 834 # ----------------------------------------------------------------------------
 835
 836 package ZOOM::Package;
 837
 838 sub new {
 839     my $class = shift();
 840     die "You can't create $class objects directly";
 841 }
 842
 843 # PRIVATE to ZOOM::Connection::package(),
 844 sub _new {
 845     my $class = shift();
 846     my($conn, $options, $_p) = @_;
 847
 848     return bless {
 849         conn => $conn,
 850         options => $options,
 851         _p => $_p,
 852     }, $class;
 853 }
 854
 855 # PRIVATE to this class
 856 sub _p {
 857     my $this = shift();
 858
 859     my $_p = $this->{_p};
 860     die "{_p} undefined: has this Package been destroy()ed?"
 861         if !defined $_p;
 862
 863     return $_p;
 864 }
 865
 866 sub option {
 867     my $this = shift();
 868     my($key, $value) = @_;
 869
 870     my $oldval = Net::Z3950::ZOOM::package_option_get($this->_p(), $key);
 871     Net::Z3950::ZOOM::package_option_set($this->_p(), $key, $value)
 872         if defined $value;
 873
 874     return $oldval;
 875 }
 876
 877 sub send {
 878     my $this = shift();
 879     my($type) = @_;
 880
 881     Net::Z3950::ZOOM::package_send($this->_p(), $type);
 882     $this->{conn}->_check();
 883 }
 884
 885 sub destroy {
 886     my $this = shift();
 887
 888     Net::Z3950::ZOOM::package_destroy($this->_p());
 889     $this->{_p} = undef;
 890 }
 891
 892
 893 # There follows trivial support for YAZ logging.  This is wired out
 894 # into the Net::Z3950::ZOOM package, and we here provide wrapper
 895 # functions -- nothing more than aliases, really -- in the ZOOM::Log
 896 # package.  There really is no point in inventing an OO interface.
 897 #
 898 # Passing @_ directly to the underlying Net::Z3950::ZOOM::* functions
 899 # doesn't work, for reasons that I can't begin to fathom, and that
 900 # don't particularly interest me.  Unpacking into scalars and passing
 901 # those _does_ work, so that's what we do.
 902
 903 package ZOOM::Log;
 904
 905 sub mask_str      { my($a) = @_; Net::Z3950::ZOOM::yaz_log_mask_str($a); }
 906 sub module_level  { my($a) = @_; Net::Z3950::ZOOM::yaz_log_module_level($a); }
 907 sub init          { my($a, $b, $c) = @_;
 908                     Net::Z3950::ZOOM::yaz_log_init($a, $b, $c) }
 909 sub init_file     { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_file($a) }
 910 sub init_level    { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_level($a) }
 911 sub init_prefix   { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_prefix($a) }
 912 sub time_format   { my($a) = @_; Net::Z3950::ZOOM::yaz_log_time_format($a) }
 913 sub init_max_size { my($a) = @_; Net::Z3950::ZOOM::yaz_log_init_max_size($a) }
 914
 915 sub log {
 916     my($level, @message) = @_;
 917
 918     if ($level !~ /^(0x)?\d+$/) {
 919         # Assuming its log-level name, we look it up.
 920         my $num = module_level($level);
 921         ZOOM::_oops(ZOOM::Error::LOGLEVEL, $level)
 922             if $num == 0;
 923         $level = $num;
 924     }
 925
 926     Net::Z3950::ZOOM::yaz_log($level, join("", @message));
 927 }
 928
 929
 930 1;