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