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;
 116     for my $key (keys %$request) {
 117         if (ref $request->{$key} eq 'HASH') {
 118             $service = $key;
 119             last;
 120         }
 121     }
 122
 123     my $response = NCIP::Response->new({type => $service . 'Response'});
 124     my $problem = NCIP::Problem->new();
 125     $problem->ProblemType('Unsupported Service');
 126     $problem->ProblemDetail("$service service is not supported by this implementation.");
 127     $problem->ProblemElement("NULL");
 128     $problem->ProblemValue("Not Supported");
 129     $response->problem($problem);
 130
 131     return $response;
 132 }
 133
 134 # All subclasses will possibly want to create a ResponseHeader and the
 135 # code for that would be highly redundant.  We supply a default
 136 # implementation here that can retrieve the agency information from
 137 # the InitiationHeader of the message, swap their values, and return a
 138 # NCIP::Header.
 139 sub make_header {
 140     my $self = shift;
 141     my $request = shift;
 142
 143     my $initheader;
 144     my $header;
 145
 146     for my $key (keys %$request) {
 147         if (ref $request->{$key} eq 'HASH'
 148                 && $request->{$key}->{InitiationHeader}) {
 149             $initheader = $request->{$key}->{InitiationHeader};
 150             last;
 151         }
 152     }
 153
 154     if ($initheader && $initheader->{FromAgencyId}
 155             && $initheader->{ToAgencyId}) {
 156         $header = NCIP::Header->new({
 157             FromAgencyId => $initheader->{ToAgencyId},
 158             ToAgencyId => $initheader->{FromAgencyId}
 159         });
 160     }
 161
 162     return $header;
 163 }
 164
 165 1;