Fix a little something caught by perl -c.
[working/NCIPServer.git] / lib / NCIP / ILS.pm
1 # ---------------------------------------------------------------
2 # Copyright © 2014 Jason J.A. Stephenson <jason@sigio.com>
3 #
4 # This file is part of NCIPServer.
5 #
6 # NCIPServer is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # NCIPServer is distributed in the hope that it will be useful, but
12 # WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 # General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with NCIPServer.  If not, see <http://www.gnu.org/licenses/>.
18 # ---------------------------------------------------------------
19 package NCIP::ILS;
20
21 use Modern::Perl;
22 use NCIP::Const;
23 use NCIP::Header;
24 use NCIP::Problem;
25 use NCIP::Response;
26 # For find_bibliographic_ids:
27 use NCIP::Item::BibliographicItemId;
28 use NCIP::Item::BibliographicRecordId;
29
30 =head1 NAME
31
32 NCIP::ILS - A base class for NIPServer ILS drivers.
33
34 =head1 SYNOPSIS
35
36     use NCIP::ILS;
37
38     $ils = NCIP::ILS->new(name => $config->{NCIP.ils.value});
39
40 =head1 DESCRIPTION
41
42 NCIP::ILS is meant as a base class and test implementation of the ILS
43 specific drivers of NCIPServer.  If you wish to implement a driver for
44 your specific ILS, then it is recommended you subclass this module and
45 reimplement the methods as necessary.
46
47 =cut
48
49 sub new {
50     my $invocant = shift;
51     my $class = ref $invocant || $invocant;
52     my $self = bless {@_}, $class;
53     return $self;
54 }
55
56 =head1 HANDLER METHODS
57
58 When NCIPServer receives an incoming message, it translates the
59 requested service into lower case and then checks if the ILS has a
60 method by that name.  If it does that method is called with a single
61 argument consisting of the XML request converted to a hash ref via
62 XML::LibXML::Simple.  If the ILS does not support that service, then
63 the unsupportedservice method of the ILS is called and the resulting
64 problem response returned to the client.
65
66 All handler methods must return a NCIP::Response object.
67
68 The handler methods provided in this base class implementation are
69 those that were required for the initial implemenation of NCIPServer
70 to be used with a particular initiator software.  You may add any
71 additional handlers to your implementation as required without needing
72 to alter this base class.
73
74 =cut
75
76 # Methods required for SHAREit:
77
78 =head2 acceptitem
79
80 Called to handle the AcceptItem service request.  The inherited
81 implementation returns the Unsupported Service problem response.
82
83 =cut
84
85 sub acceptitem {
86     my $self = shift;
87     my $request = shift;
88
89     return $self->unsupportedservice($request);
90 }
91
92 =head2 cancelrequestitem
93
94 Called to handle the CancelRequestItem service request.  The inherited
95 implementation returns the Unsupported Service problem response.
96
97 =cut
98
99 sub cancelrequestitem {
100     my $self = shift;
101     my $request = shift;
102
103     return $self->unsupportedservice($request);
104 }
105
106 =head2 checkinitem
107
108 Called to handle the CheckInItem service request.  The inherited
109 implementation returns the Unsupported Service problem response.
110
111 =cut
112
113 sub checkinitem {
114     my $self = shift;
115     my $request = shift;
116
117     return $self->unsupportedservice($request);
118 }
119
120 =head2 checkoutitem
121
122 Called to handle the CheckOutItem service request.  The inherited
123 implementation returns the Unsupported Service problem response.
124
125 =cut
126
127 sub checkoutitem {
128     my $self = shift;
129     my $request = shift;
130
131     return $self->unsupportedservice($request);
132 }
133
134 =head2 lookupuser
135
136 Called to handle the LookupUser service request.  The inherited
137 implementation returns the Unsupported Service problem response.
138
139 =cut
140
141 sub lookupuser {
142     my $self = shift;
143     my $request = shift;
144
145     return $self->unsupportedservice($request);
146 }
147
148 =head2 renewitem
149
150 Called to handle the RenewItem service request.  The inherited
151 implementation returns the Unsupported Service problem response.
152
153 =cut
154
155 sub renewitem {
156     my $self = shift;
157     my $request = shift;
158
159     return $self->unsupportedservice($request);
160 }
161
162 =head2 requestitem
163
164 Called to handle the RequestItem service request.  The inherited
165 implementation returns the Unsupported Service problem response.
166
167 =cut
168
169 sub requestitem {
170     my $self = shift;
171     my $request = shift;
172
173     return $self->unsupportedservice($request);
174 }
175
176 # Other methods, just because.
177
178 =head2 lookupversion
179
180 Called to handle the LookupVersion service request.  The inherited
181 implementation returns the list of supported versions from
182 NCIP::Const.  You probably do not want to reimplement this method in
183 your subclass.
184
185 =cut
186
187 sub lookupversion {
188     my $self = shift;
189     my $request = shift;
190
191     my $response = NCIP::Response->new({type => "LookupVersionResponse"});
192     my $payload = {
193         fromagencyid => $request->{LookupVersion}->{ToAgencyId}->{AgencyId},
194         toagencyid => $request->{LookupVersion}->{FromAgencyId}->{AgencyId},
195         versions => [ NCIP::Const::SUPPORTED_VERSIONS ]
196     };
197     $response->data($payload);
198
199     return $response;
200 }
201
202 =head1 USEFUL METHODS
203
204 These are methods of the base class that you may want to use in your
205 subclass or that are used by NCIPserver or other methods of this base
206 class.  You very likely do not want to override these in your
207 subclass.
208
209 =cut
210
211 =head2 unsupportedservice
212
213     $response = $ils->unsupportedservice($request);
214
215 This method has the same signature as a regular service handler
216 method.  It returns a response containing an Unsupported Service
217 problem.  It is used by NCIP.pm when the ILS cannot handle a message,
218 or your implementation could return this in the case of a
219 service/message you don't actually handle, though you may have the
220 proper function defined.
221
222 =cut
223
224 sub unsupportedservice {
225     my $self = shift;
226     my $request = shift;
227
228     my $service = $self->parse_request_type($request);
229
230     my $response = NCIP::Response->new({type => $service . 'Response'});
231     my $problem = NCIP::Problem->new();
232     $problem->ProblemType('Unsupported Service');
233     $problem->ProblemDetail("$service service is not supported by this implementation.");
234     $problem->ProblemElement("NULL");
235     $problem->ProblemValue("Not Supported");
236     $response->problem($problem);
237
238     return $response;
239 }
240
241 =head2 make_header
242
243     $response->header($ils->make_header($request));
244
245 All subclasses will possibly want to create a ResponseHeader for the
246 response message.  Since the code for that could be highly redundant
247 if reimplemented by each subclass, the base class supplies an
248 implementation that retrieves the agency information from the
249 InitiationHeader of the request message, swaps the FromAgencyId with
250 the ToAgencyId, and vice versa.  It then returns a NCIP::Header to be
251 used in the NCIP::Response object's header field.
252
253 =cut
254
255 sub make_header {
256     my $self = shift;
257     my $request = shift;
258
259     my $initheader;
260     my $header;
261
262     my $key = $self->parse_request_type($request);
263     $initheader = $request->{$key}->{InitiationHeader}
264         if ($key && $request->{$key}->{InitiationHeader});
265
266     if ($initheader && $initheader->{FromAgencyId}
267             && $initheader->{ToAgencyId}) {
268         $header = NCIP::Header->new({
269             FromAgencyId => $initheader->{ToAgencyId},
270             ToAgencyId => $initheader->{FromAgencyId}
271         });
272     }
273
274     return $header;
275 }
276
277 =head2 parse_request_type
278
279     $type = $ils->parse_request_type($request);
280
281 Given the request hashref object, parse_request_type will return the
282 service being requested in the message.  This method is called by
283 NCIP.pm in order to determine which handler of the ILS object to call.
284 You may find it convenient to use this method in your own handler
285 implementations.  You should not need to override this method in your
286 subclass.
287
288 =cut
289
290 sub parse_request_type {
291     my $self = shift;
292     my $request = shift;
293     my $type;
294
295     for my $key (keys %$request) {
296         if (ref $request->{$key} eq 'HASH') {
297             $type = $key;
298             last;
299         }
300     }
301
302     return $type;
303 }
304
305 =head2 find_user_barcode
306
307     $barcode = $ils->find_user_barcode($request);
308     ($barcode, $field) = $ils->find_user_barcode($request);
309
310 If you have a request type that includes a user barcode identifier
311 value, this routine will find it.
312
313 It will return the barcode in scalar context, or the barcode and the
314 tag of the field where the barcode was found in list context.
315
316 If multiple barcode fields are provided, it returns the first one that
317 it finds. This is not necessarily the first one given in the request
318 message. Maybe we should add a plural form of this method to find all
319 of the user barcodes provided?
320
321 =cut
322
323 sub find_user_barcode {
324     my $self = shift;
325     my $request = shift;
326
327     my $barcode;
328     my $field;
329     my $message = $self->parse_request_type($request);
330
331     # Check for UserId first because it is valid in all messages.
332     my $authinput = $request->{$message}->{UserId};
333     if ($authinput) {
334         $field = 'UserIdentifierValue';
335         $barcode = $authinput->{$field};
336     } elsif (grep {$_ eq $message} NCIP::Const::AUTHENTICATIONINPUT_MESSAGES) {
337         $field = 'AuthenticationInputData';
338         $authinput = $request->{$message}->{AuthenticationInput};
339         # Convert to array ref if it isn't already.
340         if (ref $authinput ne 'ARRAY') {
341             $authinput = [$authinput];
342         }
343         foreach my $input (@$authinput) {
344             if ($input->{AuthenticationInputType} =~ /barcode/i) {
345                 $barcode = $input->{$field};
346                 last;
347             }
348         }
349     }
350
351     return (wantarray) ? ($barcode, $field) : $barcode;
352 }
353
354 =head2 find_item_barcode
355
356     $barcode = $ils->find_item_barcode($request);
357     ($barcode, $field) = $ils->find_item_barcode($request);
358
359 If you have a request type that includes an item barcode identifier
360 value, this routine will find it.
361
362 It will return the barcode in scalar context, or the barcode and the
363 tag of the field where the barcode was found in list context.
364
365 If multiple barcode fields are provided, it returns the first one that
366 it finds. This is not necessarily the first one given in the request
367 message. Maybe we should add a plural form of this method to find all
368 of the item barcodes provided?
369
370 =cut
371
372 sub find_item_barcode {
373     my $self = shift;
374     my $request = shift;
375
376     my $barcode;
377     my $field;
378     my $message = $self->parse_request_type($request);
379
380     my $idinput = $request->{$message}->{ItemId};
381     if ($idinput) {
382         $field = 'ItemIdentifierValue';
383         $idinput = [$idinput] unless (ref($idinput) eq 'ARRAY');
384         foreach my $input (@$idinput) {
385             if ($input->{ItemIdentifierType}) {
386                 next unless ($input->{ItemIdentifierType} =~ /barcode/i);
387             }
388             $barcode = $input->{ItemIdentifierValue};
389             last if ($barcode);
390         }
391     }
392
393     return (wantarray) ? ($barcode, $field) : $barcode;
394 }
395
396 =head2 find_bibliographic_ids
397
398     $biblio_ids = $ils->find_bibliographic_ids($request);
399     @biblio_ids = $ils->find_bibliographic_ids($request);
400
401 Finds the BibliograpicId tags in the request message and returns a
402 list of NCIP::Item::BibliographicItemId or
403 NCIP::Item::BibliographicRecordId depending upon which are found in
404 the request, either or both could be present. If no BibliographicId is
405 found, then it returns an empty list.
406
407 In array context, it returns an array, in scalar context, an array
408 ref.
409
410 =cut
411
412 sub find_bibliographic_ids {
413     my $self = shift;
414     my $request = shift;
415     my $idcode = shift;
416
417     # Our return variable, so set this if we find any ids.
418     my @ids = ();
419
420     my $message = $self->parse_request_type($request);
421
422     # Find the BibliographicId in the xml.
423     my $idxml;
424     if ($request->{$message}->{ItemOptionalFields}->{BibligraphicDescription}) {
425         $idxml = $request->{$message}->{ItemOptionalFields}->{BibligraphicDescription}->{BibliographicId};
426     } elsif ($request->{$message}->{BibliographicDescription}) {
427         $idxml = $request->{$message}->{BibliographicDescription}->{BibliographicId};
428     } else {
429         $idxml = $request->{$message}->{BibliographicId};
430     }
431     if ($idxml) {
432         $idxml = [$idxml] unless (ref($idxml) eq 'ARRAY');
433         foreach my $entry (@$idxml) {
434             my $id;
435             if ($entry->{BibliographicRecordId}) {
436                 my ($identifier, $agencyid, $code);
437                 $identifier = $entry->{BibliographicRecordId}->{BibliographicRecordIdentifier};
438                 $code = $entry->{BibliographicRecordId}->{BibliographicRecordIdentifierCode};
439                 $agencyid = $entry->{BibliographicRecordId}->{AgencyId};
440                 $id = NCIP::Item::BibliographicRecordId->new(
441                     {
442                         BibliographicRecordIdentifier => $identifier,
443                         BibliographicRecordIdentifierCode => $code,
444                         AgencyId => $agencyid
445                     }
446                 );
447             } else {
448                 my ($identifier, $code);
449                 $identifier = $entry->{BibliographicItemId}->{BibliographicItemIdentifier};
450                 $code = $entry->{BibliographicItemId}->{BibliographicItemIdentifierCode};
451                 $id = NCIP::Item::BibliographicItemId->new(
452                     {
453                         BibliographicItemIdentifier => $identifier,
454                         BibliographicItemIdentifierCode => $code
455                     }
456                 );
457             }
458             push(@ids, $id);
459         }
460     }
461
462     return (wantarray) ? @ids : [@ids];
463 }
464
465 1;