-
Notifications
You must be signed in to change notification settings - Fork 8
/
Copy pathFOLIO.pm
345 lines (252 loc) · 9.43 KB
/
FOLIO.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
package Net::Z3950::FOLIO;
use 5.008000;
use strict;
use warnings;
use Cpanel::JSON::XS qw(decode_json encode_json);
use Net::Z3950::SimpleServer;
use ZOOM; # For ZOOM::Exception
use LWP::UserAgent;
use HTTP::Cookies;
use MARC::Record;
use MARC::File::XML (BinaryEncoding => 'utf8', RecordFormat => 'USMARC');
use Data::Dumper; $Data::Dumper::Indent = 1;
use Net::Z3950::FOLIO::Session;
use Net::Z3950::FOLIO::OPACXMLRecord qw(makeOPACXMLRecord);
use Net::Z3950::FOLIO::RPN;
use Net::Z3950::FOLIO::SurrogateDiagnostic;
our $VERSION = 'v4.0.1';
sub FORMAT_USMARC { '1.2.840.10003.5.10' }
sub FORMAT_XML { '1.2.840.10003.5.109.10' }
sub FORMAT_JSON { '1.2.840.10003.5.1000.81.3' }
sub ATTRSET_BIB1 { '1.2.840.10003.3.1' }
=head1 NAME
Net::Z3950::FOLIO - Z39.50 server for FOLIO bibliographic data
=head1 SYNOPSIS
use Net::Z3950::FOLIO;
$service = new Net::Z3950::FOLIO('config');
$service->launch_server("someServer", @ARGV);
=head1 DESCRIPTION
The C<Net::Z3950::FOLIO> module provides all the application logic of
a Z39.50 server that allows searching in and retrieval from the
inventory module of FOLIO. It is used by the C<z2folio> program, and
there is probably no good reason to make any other program to use it.
The library has only two public entry points: the C<new()> constructor
and the C<launch_server()> method. The synopsis above shows how they
are used: a Net::Z3950::FOLIO object is created using C<new()>, then
the C<launch_server()> method is invoked on it to start the server.
(In fact, this synopsis is essentially the whole of the code of the
C<simple2zoom> program. All the work happens inside the library.)
=head1 METHODS
=head2 new($configBase)
$s2z = new Net::Z3950::FOLIO('config');
Creates and returns a new Net::Z3950::FOLIO object, configured according to
the JSON file C<$configFile.json> specified by the only argument. The format of
this file is described in C<Net::Z3950::FOLIO::Config>.
=cut
sub new {
my $class = shift();
my($cfgbase) = @_;
my $this = bless {
cfgbase => $cfgbase || 'config',
sessions => {}, # Maps database name to session object
}, $class;
$this->{server} = Net::Z3950::SimpleServer->new(
GHANDLE => $this,
INIT => \&_init_handler_wrapper,
SEARCH => \&_search_handler_wrapper,
FETCH => \&_fetch_handler_wrapper,
DELETE => \&_delete_handler_wrapper,
SORT => \&_sort_handler_wrapper,
);
return $this;
}
sub getSession {
my $this = shift();
my($name) = @_;
if (!$this->{sessions}->{$name}) {
my $session = new Net::Z3950::FOLIO::Session($this, $name);
$this->{sessions}->{$name} = $session;
$session->reloadConfigFile();
$session->login($this->{user}, $this->{pass}) if !$session->{cfg}->{nologin};
}
return $this->{sessions}->{$name};
}
sub _init_handler_wrapper { _eval_wrapper(\&_init_handler, @_) }
sub _search_handler_wrapper { _eval_wrapper(\&_search_handler, @_) }
sub _fetch_handler_wrapper { _eval_wrapper(\&_fetch_handler, @_) }
sub _delete_handler_wrapper { _eval_wrapper(\&_delete_handler, @_) }
sub _sort_handler_wrapper { _eval_wrapper(\&_sort_handler, @_) }
sub _eval_wrapper {
my $coderef = shift();
my $args = shift();
eval {
&$coderef($args, @_);
}; if (ref $@ && $@->isa('ZOOM::Exception')) {
if ($@->diagset() eq 'Bib-1') {
$args->{ERR_CODE} = $@->code();
$args->{ERR_STR} = $@->addinfo();
} else {
$args->{ERR_CODE} = 100;
$args->{ERR_STR} = $@->message() || $@->addinfo();
}
if ($@->isa('Net::Z3950::FOLIO::SurrogateDiagnostic')) {
$args->{SUR_FLAG} = 1;
$args->{RECORD} = ""; # To avoid an uninitialized value warning in SimpleServer.pm
}
} elsif ($@) {
# Non-ZOOM exceptions may be generated by the Perl
# interpreter, for example if we try to call a method that
# does not exist in the relevant class. These should be
# considered fatal and not reported to the client.
die $@;
}
}
sub _init_handler {
my($args) = @_;
my $ghandle = $args->{GHANDLE};
$args->{IMP_ID} = '81';
$args->{IMP_VER} = $Net::Z3950::FOLIO::VERSION;
$args->{IMP_NAME} = 'z2folio gateway';
# Stash these for subsequent use in getSession when it invokes $session->login()
$ghandle->{user} = $args->{USER};
$ghandle->{pass} = $args->{PASS};
# That's all we can do until we know the database name at search time
}
sub _search_handler {
my($args) = @_;
my $ghandle = $args->{GHANDLE};
my $bases = $args->{DATABASES};
_throw(111, 1) if @$bases != 1; # Too many databases specified
my $base = $bases->[0];
my $session = $ghandle->getSession($base);
$args->{HANDLE} = $session;
$session->maybeRefreshToken();
if ($args->{CQL}) {
$session->{cql} = $args->{CQL};
} else {
my $type1 = $args->{RPN}->{query};
$session->{cql} = $type1->toCQL($session, $args->{RPN}->{attributeSet});
warn "search: translated '" . $args->{QUERY} . "' to '" . $session->{cql} . "'\n";
}
$session->{sortspec} = undef;
$args->{HITS} = $session->rerunSearch($args->{SETNAME});
}
sub _fetch_handler {
my($args) = @_;
my $session = $args->{HANDLE};
_throw(30, $args->{SETNAME}) if !$session;
$session->maybeRefreshToken();
my $rs = $session->{resultsets}->{$args->{SETNAME}};
_throw(30, $args->{SETNAME}) if !$rs; # Result set does not exist
my $index1 = $args->{OFFSET};
_throw(13, $index1) if $index1 < 1 || $index1 > $rs->totalCount();
my $rec = $rs->record($index1-1);
if (!defined $rec) {
# We need to fetch a chunk of records that contains the
# requested one. We'll do this by splitting the whole set into
# chunks of the specified size, and fetching the one that
# contains the requested record.
# XXX Perhaps this should happen inside $rs->record
my $index0 = $index1 - 1;
my $chunkSize = $session->{cfg}->{chunkSize} || 10;
my $chunk = int($index0 / $chunkSize);
$session->doSearch($rs, $chunk * $chunkSize, $chunkSize);
$rec = $rs->record($index1-1);
_throw(1, "missing record") if !defined $rec;
}
my $comp = lc($args->{COMP} || '');
my $format = $args->{REQ_FORM};
# warn "REQ_FORM=$format, COMP=$comp\n";
my $res;
if ($format eq FORMAT_JSON) {
$res = $rec->prettyJSON();
} elsif ($format eq FORMAT_XML && $comp eq 'raw') {
# Mechanical XML translitation of the JSON response
$res = $rec->prettyXML();
} elsif ($format eq FORMAT_XML && $comp eq 'usmarc') {
# MARCXML made from SRS Marc record
my $marc = $rec->marcRecord();
$res = $marc->as_xml_record();
} elsif ($format eq FORMAT_XML && $comp eq 'opac') {
# OPAC-format XML
$res = makeOPACXMLRecord($rec);
} elsif ($format eq FORMAT_XML) {
_throw(25, "XML records available in element-sets: raw, usmarc, opac");
} elsif ($format eq FORMAT_USMARC && (!$comp || $comp eq 'f' || $comp eq 'b')) {
# Static USMARC from SRS
my $marc = $rec->marcRecord();
$res = $marc->as_usmarc();
} elsif ($format eq FORMAT_USMARC) {
_throw(25, "USMARC records available in element-sets: f, b");
} else {
_throw(239, $format); # 239 = Record syntax not supported
}
$args->{RECORD} = $res;
return;
}
sub _delete_handler {
my($args) = @_;
my $session = $args->{HANDLE};
$session->maybeRefreshToken();
my $setname = $args->{SETNAME};
if ($session->{resultsets}->{$setname}) {
$session->{resultsets}->{$setname} = undef;
} else {
$args->{STATUS} = 1; # failure-1: Result set did not exist
}
return;
}
sub _sort_handler {
my($args) = @_;
my $session = $args->{HANDLE};
$session->maybeRefreshToken();
my $setnames = $args->{INPUT};
_throw(230, '1') if @$setnames > 1; # Sort: too many input results
my $setname = $setnames->[0];
my $rs = $session->{resultsets}->{$setname};
_throw(30, $args->{SETNAME}) if !$rs; # Result set does not exist
my $cqlSort = $session->sortSpecs2CQL($args->{SEQUENCE});
_throw(207, Dumper($args->{SEQUENCE})) if !$cqlSort; # Cannot sort according to sequence
$session->{sortspec} = $cqlSort;
$session->rerunSearch($args->{OUTPUT});
}
=head2 launch_server($label, @ARGV)
$s2z->launch_server("someServer", @ARGV);
Launches the Net::Z3950::FOLIO server: this method never returns. The
C<$label> string is used in logging, and the C<@ARGV> vector of
command-line arguments is interpreted by the YAZ backend server as
described at
https://software.indexdata.com/yaz/doc/server.invocation.html
=cut
sub launch_server {
my $this = shift();
my($label, @argv) = @_;
return $this->{server}->launch_server($label, @argv);
}
sub _throw {
my($code, $addinfo, $diagset, $isSurrogate) = @_;
$diagset ||= "Bib-1";
# HTTP body for errors is sometimes a plain string, sometimes a JSON structure
if ($addinfo =~ /^{/) {
my $obj = decode_json($addinfo);
$addinfo = $obj->{errors} ? $obj->{errors}->[0]->{message} : $obj->{errorMessage};
}
if ($isSurrogate) {
die new Net::Z3950::FOLIO::SurrogateDiagnostic($code, undef, $addinfo, $diagset);
} else {
die new ZOOM::Exception($code, undef, $addinfo, $diagset);
}
}
=head1 SEE ALSO
=over 4
=item The C<z2folio> script conveniently launches the server.
=item C<Net::Z3950::FOLIO::Config> describes the configuration-file format.
=item The C<Net::Z3950::SimpleServer> handles the Z39.50 service.
=back
=head1 AUTHOR
Mike Taylor, E<lt>mike@indexdata.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2018 The Open Library Foundation
This software is distributed under the terms of the Apache License,
Version 2.0. See the file "LICENSE" for more information.
=cut