"Fossies" - the Fresh Open Source Software Archive 
Member "koha-19.11.15/Koha/Z3950Responder.pm" (23 Feb 2021, 5318 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "Z3950Responder.pm" see the
Fossies "Dox" file reference documentation and the last
Fossies "Diffs" side-by-side code changes report:
20.11.01_vs_20.11.02.
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 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;