Open-ILS/src/perlmods/lib/OpenILS/Utils/ZClient.pm

   1 package OpenILS::Utils::ZClient;
   2 use UNIVERSAL::require;
   3
   4 sub DESTROY {};
   5
   6 use overload 'bool' => sub { return $_[0]->{connection} ? 1 : 0 };
   7
   8 sub EVENT_NONE { 0 }
   9 sub EVENT_CONNECT { 1 }
  10 sub EVENT_SEND_DATA { 2 }
  11 sub EVENT_RECV_DATA { 3 }
  12 sub EVENT_TIMEOUT { 4 }
  13 sub EVENT_UNKNOWN { 5 }
  14 sub EVENT_SEND_APDU { 6 }
  15 sub EVENT_RECV_APDU { 7 }
  16 sub EVENT_RECV_RECORD { 8 }
  17 sub EVENT_RECV_SEARCH { 9 }
  18 sub EVENT_END { 10 }
  19
  20 our $conn_class = 'ZOOM::Connection';
  21 our $imp_class = 'ZOOM';
  22 our $AUTOLOAD;
  23
  24 # Detect the installed z client, prefering ZOOM.
  25 if (!$imp_class->use()) {
  26
  27         $imp_class = 'Net::Z3950';  # Try Net::Z3950
  28         if ($imp_class->use()) {
  29
  30                 # Tell 'new' how to build the connection
  31                 $conn_class = 'Net::Z3950::Connection';
  32
  33         } else {
  34                 die "Cannot load a z39.50 client implementation!  Please install either ZOOM or Net::Z3950.\n";
  35         }
  36 }
  37
  38 # 'new' is called thusly:
  39 #  my $conn = OpenILS::Utils::ZClient->new( $host, $port, databaseName => $db, user => $username )
  40
  41 sub new {
  42         my $class = shift();
  43         my @args = @_;
  44
  45         if ($class ne __PACKAGE__) { # NOT called OO-ishly
  46                 # put the first param back if called like OpenILS::Utils::ZClient::new()
  47                 unshift @args, $class;
  48         }
  49
  50         return bless { connection => $conn_class->new(@_) } => __PACKAGE__;
  51 }
  52
  53 sub search {
  54         my $self = shift;
  55         my $r =  $imp_class eq 'Net::Z3950' ?
  56                 $self->{connection}->search( @_ ) :
  57                 $self->{connection}->search_pqf( @_ );
  58
  59         return OpenILS::Utils::ZClient::ResultSet->new( $r );
  60 }
  61
  62 sub event {
  63         my $list = shift;
  64         if ($imp_class eq 'Net::Z3950') {
  65                 if (defined $$list[0]{_async_index}) {
  66                         return 0 if ($$list[0]{_async_index} == @$list);
  67                         return ++$$list[0]{_async_index};
  68                 } else {
  69                         return $$list[0]{_async_index} = 1;
  70                 }
  71         }
  72
  73         return ZOOM::event([map { ($_->{connection}) } @$list]);
  74 }
  75
  76 *{__PACKAGE__ . '::search_pqf'} = \&search;
  77
  78 sub AUTOLOAD {
  79         my $self = shift;
  80
  81         my $method = $AUTOLOAD;
  82         $method =~ s/.*://;   # strip fully-qualified portion
  83
  84         return $self->{connection}->$method( @_ );
  85 }
  86
  87 #-------------------------------------------------------------------------------
  88 package OpenILS::Utils::ZClient::ResultSet;
  89
  90 sub DESTROY {};
  91 our $AUTOLOAD;
  92
  93 sub new {
  94         my $class = shift;
  95         my @args = @_;
  96
  97         if ($class ne __PACKAGE__) { # NOT called OO-ishly
  98                 # put the first param back if called like OpenILS::Utils::ZClient::ResultSet::new()
  99                 unshift @args, $class;
 100         }
 101
 102
 103         return bless { result => $args[0] } => __PACKAGE__;
 104 }
 105
 106 sub record {
 107         my $self = shift;
 108         my $offset = shift;
 109         my $r = $imp_class eq 'Net::Z3950' ?
 110                 $self->{result}->record( ++$offset ) :
 111                 $self->{result}->record( $offset );
 112
 113         return  OpenILS::Utils::ZClient::Record->new( $r );
 114 }
 115
 116 sub last_event {
 117         my $self = shift;
 118         return OpenILS::Utils::ZClient::EVENT_END() if ($imp_class eq 'Net::Z3950');
 119         $self->{result}->last_event();
 120 }
 121
 122 sub AUTOLOAD {
 123         my $self = shift;
 124
 125         my $method = $AUTOLOAD;
 126         $method =~ s/.*://;   # strip fully-qualified portion
 127
 128         return $self->{result}->$method( @_ );
 129 }
 130
 131 #-------------------------------------------------------------------------------
 132 package OpenILS::Utils::ZClient::Record;
 133
 134 sub DESTROY {};
 135 our $AUTOLOAD;
 136
 137 sub new {
 138         my $class = shift;
 139         my @args = @_;
 140
 141         if ($class ne __PACKAGE__) { # NOT called OO-ishly
 142                 # put the first param back if called like OpenILS::Utils::ZClient::ResultSet::new()
 143                 unshift @args, $class;
 144         }
 145
 146
 147         return bless { record => shift() } => __PACKAGE__;
 148 }
 149
 150 sub rawdata {
 151         my $self = shift;
 152         return $OpenILS::Utils::ZClient::imp_class eq 'Net::Z3950' ?
 153                 $self->{record}->rawdata( @_ ) :
 154                 $self->{record}->raw( @_ );
 155 }
 156
 157 *{__PACKAGE__ . '::raw'} = \&rawdata;
 158
 159 sub AUTOLOAD {
 160         my $self = shift;
 161
 162         my $method = $AUTOLOAD;
 163         $method =~ s/.*://;   # strip fully-qualified portion
 164
 165         return $self->{record}->$method( @_ );
 166 }
 167
 168 1;
 169