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
  27 =head1 NAME
  28
  29 NCIP::ILS - A base class for NIPServer ILS drivers.
  30
  31 =head1 SYNOPSIS
  32
  33 C<use NCIP::ILS;>
  34
  35 C<my $ils = NCIP::ILS-E<gt>new(name =E<gt> $config-E<gt>{NCIP.ils.value});>
  36
  37 =head1 DESCRIPTION
  38
  39 NCIP::ILS is meant as a base class and test implementation of the ILS
  40 specific drivers of NCIPServer.  If you wish to implement a driver for
  41 your specific ILS, then it is recommended you subclass this module and
  42 reimplement the methods as necessary.
  43
  44 =cut
  45
  46 sub new {
  47     my $invocant = shift;
  48     my $class = ref $invocant || $invocant;
  49     my $self = bless {@_}, $class;
  50     return $self;
  51 }
  52
  53 =head1 HANDLER METHODS
  54
  55 When NCIPServer receives an incoming message, it translates the
  56 requested service into lower case and then checks if the ILS has a
  57 method by that name.  If it does that method is called with a single
  58 argument consisting of the XML request converted to a hash ref via
  59 XML::LibXML::Simple.  If the ILS does not support that service, then
  60 the unsupportedservice method of the ILS is called and the resulting
  61 problem response returned to the client.
  62
  63 All handler methods must return a NCIP::Response object.
  64
  65 The handler methods provided in this base class implementation are
  66 those that were required for the initial implemenation of NCIPServer
  67 to be used with a particular initiator software.  You may add any
  68 additional handlers to your implementation as required without needing
  69 to alter this base class.
  70
  71 =cut
  72
  73 # Methods required for SHAREit:
  74
  75 =head2 acceptitem
  76
  77 Called to handle the AcceptItem service request.  The inherited
  78 implementation returns the Unsupported Service problem response.
  79
  80 =cut
  81
  82 sub acceptitem {
  83     my $self = shift;
  84     my $request = shift;
  85
  86     return $self->unsupportedservice($request);
  87 }
  88
  89 =head2 cancelrequestitem
  90
  91 Called to handle the CancelRequestItem service request.  The inherited
  92 implementation returns the Unsupported Service problem response.
  93
  94 =cut
  95
  96 sub cancelrequestitem {
  97     my $self = shift;
  98     my $request = shift;
  99
 100     return $self->unsupportedservice($request);
 101 }
 102
 103 =head2 checkinitem
 104
 105 Called to handle the CheckInItem service request.  The inherited
 106 implementation returns the Unsupported Service problem response.
 107
 108 =cut
 109
 110 sub checkinitem {
 111     my $self = shift;
 112     my $request = shift;
 113
 114     return $self->unsupportedservice($request);
 115 }
 116
 117 =head2 checkoutitem
 118
 119 Called to handle the CheckOutItem service request.  The inherited
 120 implementation returns the Unsupported Service problem response.
 121
 122 =cut
 123
 124 sub checkoutitem {
 125     my $self = shift;
 126     my $request = shift;
 127
 128     return $self->unsupportedservice($request);
 129 }
 130
 131 =head2 lookupuser
 132
 133 Called to handle the LookupUser service request.  The inherited
 134 implementation returns the Unsupported Service problem response.
 135
 136 =cut
 137
 138 sub lookupuser {
 139     my $self = shift;
 140     my $request = shift;
 141
 142     return $self->unsupportedservice($request);
 143 }
 144
 145 =head2 renewitem
 146
 147 Called to handle the RenewItem service request.  The inherited
 148 implementation returns the Unsupported Service problem response.
 149
 150 =cut
 151
 152 sub renewitem {
 153     my $self = shift;
 154     my $request = shift;
 155
 156     return $self->unsupportedservice($request);
 157 }
 158
 159 =head2 requestitem
 160
 161 Called to handle the RequestItem service request.  The inherited
 162 implementation returns the Unsupported Service problem response.
 163
 164 =cut
 165
 166 sub requestitem {
 167     my $self = shift;
 168     my $request = shift;
 169
 170     return $self->unsupportedservice($request);
 171 }
 172
 173 # Other methods, just because.
 174
 175 =head2 lookupversion
 176
 177 Called to handle the LookupVersion service request.  The inherited
 178 implementation returns the list of supported versions from
 179 NCIP::Const.  You probably do not want to reimplement this method in
 180 your subclass.
 181
 182 =cut
 183
 184 sub lookupversion {
 185     my $self = shift;
 186     my $request = shift;
 187
 188     my $response = NCIP::Response->new({type => "LookupVersionResponse"});
 189     $response->header($self->make_header($request));
 190     my $payload = {
 191         versions => [ NCIP::Const::SUPPORTED_VERSIONS ]
 192     };
 193     $response->data($payload);
 194
 195     return $response;
 196 }
 197
 198 =head1 USEFUL METHODS
 199
 200 These are methods of the base class that you may want to use in your
 201 subclass or that are used by NCIPserver or other methods of this base
 202 class.  You very likely do not want to override these in your
 203 subclass.
 204
 205 =cut
 206
 207 =head2 unsupportedservice
 208
 209 C<my $response = $ils-E<gt>unsupportedservice($request);>
 210
 211 This method has the same signature as a regular service handler
 212 method.  It returns a response containing an Unsupported Service
 213 problem.  It is used by NCIP.pm when the ILS cannot handle a message,
 214 or your implementation could return this in the case of a
 215 service/message you don't actually handle, though you may have the
 216 proper function defined.
 217
 218 =cut
 219
 220 sub unsupportedservice {
 221     my $self = shift;
 222     my $request = shift;
 223
 224     my $service = $self->parse_request_type($request);
 225
 226     my $response = NCIP::Response->new({type => $service . 'Response'});
 227     my $problem = NCIP::Problem->new();
 228     $problem->ProblemType('Unsupported Service');
 229     $problem->ProblemDetail("$service service is not supported by this implementation.");
 230     $problem->ProblemElement("NULL");
 231     $problem->ProblemValue("Not Supported");
 232     $response->problem($problem);
 233
 234     return $response;
 235 }
 236
 237 =head2 make_header
 238
 239 C<$response-E<gt>header($ils-E<gt>make_header($request));>
 240
 241 All subclasses will possibly want to create a ResponseHeader for the
 242 response message.  Since the code for that could be highly redundant
 243 if reimplemented by each subclass, the base class supplies an
 244 implementation that retrieves the agency information from the
 245 InitiationHeader of the request message, swaps the FromAgencyId with
 246 the ToAgencyId, and vice versa.  It then returns a NCIP::Header to be
 247 used in the NCIP::Response object's header field.
 248
 249 =cut
 250
 251 sub make_header {
 252     my $self = shift;
 253     my $request = shift;
 254
 255     my $initheader;
 256     my $header;
 257
 258     my $key = $self->parse_request_type($request);
 259     $initheader = $request->{$key}->{InitiationHeader}
 260         if ($key && $request->{$key}->{InitiationHeader});
 261
 262     if ($initheader && $initheader->{FromAgencyId}
 263             && $initheader->{ToAgencyId}) {
 264         $header = NCIP::Header->new({
 265             FromAgencyId => $initheader->{ToAgencyId},
 266             ToAgencyId => $initheader->{FromAgencyId}
 267         });
 268     }
 269
 270     return $header;
 271 }
 272
 273 =head2 parse_request_type
 274
 275 C<my $type = $ils-E<gt>parse_request_type($request);>
 276
 277 Given the request hashref object, parse_request_type will return the
 278 service being requested in the message.  This method is called by
 279 NCIP.pm in order to determine which handler of the ILS object to call.
 280 You may find it convenient to use this method in your own handler
 281 implementations.  You should not need to override this method in your
 282 subclass.
 283
 284 =cut
 285
 286 sub parse_request_type {
 287     my $self = shift;
 288     my $request = shift;
 289     my $type;
 290
 291     for my $key (keys %$request) {
 292         if (ref $request->{$key} eq 'HASH') {
 293             $type = $key;
 294             last;
 295         }
 296     }
 297
 298     return $type;
 299 }
 300
 301 =head2 find_barcode
 302
 303 C<my $barcode = $ils-E<gt>find_barcode($request);>
 304
 305 If you have a requrest type that includes a barcode identifier value,
 306 this routine will find it. It presently works only on LookupUser
 307 requests.
 308
 309 =cut
 310
 311 sub find_barcode {
 312     my $self = shift;
 313     my $request = shift;
 314
 315     my $barcode;
 316     my $message = $self->parse_request_type($request);
 317     return unless($message);
 318     if ($message eq 'LookupUser') {
 319         my $authinput = $request->{$message}->{AuthenticationInput};
 320         return unless ($authinput);
 321         # Convert to array ref if it isn't already.
 322         if (ref $authinput ne 'ARRAY') {
 323             $authinput = [$authinput];
 324         }
 325         foreach my $input (@$authinput) {
 326             if ($input->{AuthenticationInputType} =~ /barcode/i) {
 327                 $barcode = $input->{AuthenticationInputData};
 328                 last;
 329             }
 330         }
 331     }
 332
 333     return $barcode;
 334 }
 335
 336 1;