Koha/Z3950Responder.pm

   1 #!/usr/bin/perl
   2
   3 package Koha::Z3950Responder;
   4
   5 # Copyright ByWater Solutions 2016
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22 use Modern::Perl;
  23
  24 use C4::Biblio qw( GetMarcFromKohaField );
  25 use C4::Koha qw( GetAuthorisedValues );
  26
  27 use Net::Z3950::SimpleServer;
  28
  29 =head1 NAME
  30
  31 Koha::Z3950Responder - Main class for interfacing with Net::Z3950::SimpleServer
  32
  33 =head1 SYNOPSIS
  34
  35     use Koha::Z3950Responder;
  36
  37     my $z = Koha::Z3950Responder->new( {
  38         add_item_status_subfield => 1,
  39         add_status_multi_subfield => 1,
  40         debug => 0,
  41         num_to_prefetch => 20,
  42         config_dir => '/home/koha/etc',
  43         yaz_options => [ ],
  44     } );
  45
  46     $z->start();
  47
  48 =head1 DESCRIPTION
  49
  50 A daemon class that interfaces with Net::Z3950::SimpleServer to provider Z39.50/SRU
  51 service. Uses a Session class for the actual functionality.
  52
  53 =head1 METHODS
  54
  55 =head2 INSTANCE METHODS
  56
  57 =head3 new
  58
  59     $self->new({
  60         add_item_status_subfield => 1
  61     });
  62
  63 =cut
  64
  65 sub new {
  66     my ( $class, $config ) = @_;
  67
  68     my ($item_tag, $itemnumber_subfield) = GetMarcFromKohaField( "items.itemnumber" );
  69
  70     # We hardcode the strings for English so SOMETHING will work if the authorized value doesn't exist.
  71     my $status_strings = {
  72         AVAILABLE => 'Available',
  73         CHECKED_OUT => 'Checked Out',
  74         LOST => 'Lost',
  75         NOT_FOR_LOAN => 'Not for Loan',
  76         DAMAGED => 'Damaged',
  77         WITHDRAWN => 'Withdrawn',
  78         IN_TRANSIT => 'In Transit',
  79         ON_HOLD => 'On Hold',
  80     };
  81
  82     foreach my $val ( @{ GetAuthorisedValues( 'Z3950_STATUS' ) } ) {
  83         $status_strings->{ $val->{authorised_value} } = $val->{lib};
  84     }
  85
  86     my $self = {
  87         %$config,
  88         item_tag => $item_tag,
  89         itemnumber_subfield => $itemnumber_subfield,
  90         status_strings => $status_strings,
  91     };
  92
  93     # If requested, turn on debugging.
  94     if ( $self->{debug} ) {
  95         # Turn on single-process mode.
  96         unshift @{ $self->{yaz_options} }, '-S';
  97     } else {
  98         # Turn off Yaz's built-in logging apart from fatal errors (can be turned back on if desired).
  99         unshift @{ $self->{yaz_options} }, '-v', 'none,fatal';
 100     }
 101
 102     # Set main config for SRU support and working directory
 103     if ( $self->{config_dir} ) {
 104         unshift @{ $self->{yaz_options} }, '-f', $self->{config_dir} . 'config.xml';
 105         unshift @{ $self->{yaz_options} }, '-w', $self->{config_dir};
 106     }
 107
 108     # Set num to prefetch if not passed
 109     $self->{num_to_prefetch} //= 20;
 110
 111     $self->{server} = Net::Z3950::SimpleServer->new(
 112         INIT => sub { $self->init_handler(@_) },
 113         SEARCH => sub { $self->search_handler(@_) },
 114         FETCH => sub { $self->fetch_handler(@_) },
 115         CLOSE => sub { $self->close_handler(@_) },
 116     );
 117
 118     return bless( $self, $class );
 119 }
 120
 121 =head3 start
 122
 123     $z->start();
 124
 125 Start the daemon and begin serving requests. Does not return unless initialization fails or a
 126 fatal error occurs.
 127
 128 =cut
 129
 130 sub start {
 131     my ( $self ) = @_;
 132
 133     $self->{server}->launch_server( 'Koha::Z3950Responder', @{ $self->{yaz_options} } )
 134 }
 135
 136 =head2 CALLBACKS
 137
 138 These methods are SimpleServer callbacks bound to this Z3950Responder object.
 139 It's worth noting that these callbacks don't return anything; they both
 140 receive and return data in the $args hashref.
 141
 142 =head3 init_handler
 143
 144 Callback that is called when a new connection is initialized
 145
 146 =cut
 147
 148 sub init_handler {
 149     # Called when the client first connects.
 150     my ( $self, $args ) = @_;
 151
 152     # This holds all of the per-connection state.
 153     my $session;
 154     if (C4::Context->preference('SearchEngine') eq 'Zebra') {
 155         use Koha::Z3950Responder::ZebraSession;
 156         $session = Koha::Z3950Responder::ZebraSession->new({
 157             server => $self,
 158             peer => $args->{PEER_NAME},
 159         });
 160     } else {
 161         use Koha::Z3950Responder::GenericSession;
 162         $session = Koha::Z3950Responder::GenericSession->new({
 163             server => $self,
 164             peer => $args->{PEER_NAME}
 165         });
 166     }
 167
 168     $args->{HANDLE} = $session;
 169
 170     $args->{IMP_NAME} = "Koha";
 171     $args->{IMP_VER} = Koha::version;
 172 }
 173
 174 =head3 search_handler
 175
 176 Callback that is called when a new search is performed
 177
 178 =cut
 179
 180 sub search_handler {
 181     my ( $self, $args ) = @_;
 182
 183     $args->{HANDLE}->search_handler($args);
 184 }
 185
 186 =head3 fetch_handler
 187
 188 Callback that is called when records are requested
 189
 190 =cut
 191
 192 sub fetch_handler {
 193     my ( $self, $args ) = @_;
 194
 195     $args->{HANDLE}->fetch_handler( $args );
 196 }
 197
 198 =head3 close_handler
 199
 200 Callback that is called when a session is terminated
 201
 202 =cut
 203
 204 sub close_handler {
 205     my ( $self, $args ) = @_;
 206
 207     $args->{HANDLE}->close_handler( $args );
 208 }
 209
 210 1;