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 sub new {
  28     my $invocant = shift;
  29     my $class = ref $invocant || $invocant;
  30     my $self = bless {@_}, $class;
  31     return $self;
  32 }
  33
  34 # Methods required for SHAREit:
  35
  36 sub acceptitem {
  37     my $self = shift;
  38     my $request = shift;
  39
  40     return $self->unsupportedservice($request);
  41 }
  42
  43 sub cancelrequestitem {
  44     my $self = shift;
  45     my $request = shift;
  46
  47     return $self->unsupportedservice($request);
  48 }
  49
  50 sub checkinitem {
  51     my $self = shift;
  52     my $request = shift;
  53
  54     return $self->unsupportedservice($request);
  55 }
  56
  57 sub checkoutitem {
  58     my $self = shift;
  59     my $request = shift;
  60
  61     return $self->unsupportedservice($request);
  62 }
  63
  64 sub lookupuser {
  65     my $self = shift;
  66     my $request = shift;
  67
  68     return $self->unsupportedservice($request);
  69 }
  70
  71 sub renewitem {
  72     my $self = shift;
  73     my $request = shift;
  74
  75     return $self->unsupportedservice($request);
  76 }
  77
  78 sub requestitem {
  79     my $self = shift;
  80     my $request = shift;
  81
  82     return $self->unsupportedservice($request);
  83 }
  84
  85 # Other methods, just because.
  86
  87 # Handle a LookupVersion Request.  You probably want to just call this
  88 # one from your subclasses rather than reimplement it.
  89 sub lookupversion {
  90     my $self = shift;
  91     my $request = shift;
  92
  93     my $response = NCIP::Response->new({type => "LookupVersionResponse"});
  94     $response->header($self->make_header($request));
  95     my $payload = {
  96         versions => [ NCIP::Const::SUPPORTED_VERSIONS ]
  97     };
  98     $response->data($payload);
  99
 100     return $response;
 101 }
 102
 103 # A few helper methods:
 104
 105 # This is a handy method that subclasses should probably not override.
 106 # It returns a response containing an Unsupported Service problem.  It
 107 # is used by NCIP.pm when the ILS cannot handle a message, or your
 108 # implementation could return this in the case of a service/message
 109 # you don't actually handle, though you may have the proper function
 110 # defined.
 111 sub unsupportedservice {
 112     my $self = shift;
 113     my $request = shift;
 114
 115     my $service = $self->parse_request_type($request);
 116
 117     my $response = NCIP::Response->new({type => $service . 'Response'});
 118     my $problem = NCIP::Problem->new();
 119     $problem->ProblemType('Unsupported Service');
 120     $problem->ProblemDetail("$service service is not supported by this implementation.");
 121     $problem->ProblemElement("NULL");
 122     $problem->ProblemValue("Not Supported");
 123     $response->problem($problem);
 124
 125     return $response;
 126 }
 127
 128 # All subclasses will possibly want to create a ResponseHeader and the
 129 # code for that would be highly redundant.  We supply a default
 130 # implementation here that can retrieve the agency information from
 131 # the InitiationHeader of the message, swap their values, and return a
 132 # NCIP::Header.
 133 sub make_header {
 134     my $self = shift;
 135     my $request = shift;
 136
 137     my $initheader;
 138     my $header;
 139
 140     my $key = $self->parse_request_type($request);
 141     $initheader = $request->{$key}->{InitiationHeader}
 142         if ($key && $request->{$key}->{InitiationHeader});
 143
 144     if ($initheader && $initheader->{FromAgencyId}
 145             && $initheader->{ToAgencyId}) {
 146         $header = NCIP::Header->new({
 147             FromAgencyId => $initheader->{ToAgencyId},
 148             ToAgencyId => $initheader->{FromAgencyId}
 149         });
 150     }
 151
 152     return $header;
 153 }
 154
 155 sub parse_request_type {
 156     my $self = shift;
 157     my $request = shift;
 158     my $type;
 159
 160     for my $key (keys %$request) {
 161         if (ref $request->{$key} eq 'HASH') {
 162             $type = $key;
 163             last;
 164         }
 165     }
 166
 167     return $type;
 168 }
 169
 170 1;