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 under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 3 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along
  19 # with Koha; if not, write to the Free Software Foundation, Inc.,
  20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  21
  22 use Modern::Perl;
  23
  24 use C4::Biblio qw( GetMarcFromKohaField );
  25 use C4::Koha qw( GetAuthorisedValues );
  26
  27 use Koha;
  28 use Koha::Z3950Responder::Session;
  29
  30 use Net::Z3950::SimpleServer;
  31
  32 sub new {
  33     my ( $class, $config ) = @_;
  34
  35     my ($item_tag, $itemnumber_subfield) = GetMarcFromKohaField( "items.itemnumber", '' );
  36
  37     # We hardcode the strings for English so SOMETHING will work if the authorized value doesn't exist.
  38     my $status_strings = {
  39         AVAILABLE => 'Available',
  40         CHECKED_OUT => 'Checked Out',
  41         LOST => 'Lost',
  42         NOT_FOR_LOAN => 'Not for Loan',
  43         DAMAGED => 'Damaged',
  44         WITHDRAWN => 'Withdrawn',
  45         IN_TRANSIT => 'In Transit',
  46         ON_HOLD => 'On Hold',
  47     };
  48
  49     foreach my $val ( @{ GetAuthorisedValues( 'Z3950_STATUS' ) } ) {
  50         $status_strings->{ $val->{authorised_value} } = $val->{lib};
  51     }
  52
  53     my $self = {
  54         %$config,
  55         item_tag => $item_tag,
  56         itemnumber_subfield => $itemnumber_subfield,
  57         status_strings => $status_strings,
  58     };
  59
  60     # Turn off Yaz's built-in logging (can be turned back on if desired).
  61     unshift @{ $self->{yaz_options} }, '-v', 'none';
  62
  63     # If requested, turn on debugging.
  64     if ( $self->{debug} ) {
  65         # Turn on single-process mode.
  66         unshift @{ $self->{yaz_options} }, '-S';
  67     }
  68
  69     $self->{server} = Net::Z3950::SimpleServer->new(
  70         INIT => sub { $self->init_handler(@_) },
  71         SEARCH => sub { $self->search_handler(@_) },
  72         PRESENT => sub { $self->present_handler(@_) },
  73         FETCH => sub { $self->fetch_handler(@_) },
  74         CLOSE => sub { $self->close_handler(@_) },
  75     );
  76
  77     return bless( $self, $class );
  78 }
  79
  80 sub start {
  81     my ( $self ) = @_;
  82
  83     $self->{server}->launch_server( 'Koha::Z3950Responder', @{ $self->{yaz_options} } )
  84 }
  85
  86 # The rest of these methods are SimpleServer callbacks bound to this Z3950Responder object. It's
  87 # worth noting that these callbacks don't return anything; they both receive and return data in the
  88 # $args hashref.
  89
  90 sub init_handler {
  91     # Called when the client first connects.
  92     my ( $self, $args ) = @_;
  93
  94     # This holds all of the per-connection state.
  95     my $session = Koha::Z3950Responder::Session->new({
  96         server => $self,
  97         peer => $args->{PEER_NAME},
  98     });
  99
 100     $args->{HANDLE} = $session;
 101
 102     $args->{IMP_NAME} = "Koha";
 103     $args->{IMP_VER} = Koha::version;
 104 }
 105
 106 sub search_handler {
 107     # Called when search is first sent.
 108     my ( $self, $args ) = @_;
 109
 110     $args->{HANDLE}->search_handler($args);
 111 }
 112
 113 sub present_handler {
 114     # Called when a set of records is requested.
 115     my ( $self, $args ) = @_;
 116
 117     $args->{HANDLE}->present_handler($args);
 118 }
 119
 120 sub fetch_handler {
 121     # Called when a given record is requested.
 122     my ( $self, $args ) = @_;
 123
 124     $args->{HANDLE}->fetch_handler( $args );
 125 }
 126
 127 sub close_handler {
 128     my ( $self, $args ) = @_;
 129
 130     $args->{HANDLE}->close_handler( $args );
 131 }
 132
 133 1;