api_adapter.template

#!/usr/bin/perl 

#--------------------------------------------------------------
# 12-05-2014 Rich Wenger, MIT Libraries
# This script provides Aleph services to an external server. 
#--------------------------------------------------------------

use strict;
use warnings;
use HTTP::Request;
use LWP::UserAgent;
use Switch;
use POSIX;
use Time::Local;

my $rest_port = 'PORT';
my @whitelist = (WHITELIST);
#-----------------------------------------------------------------
#	Only accept connections from authorized IP addresses. 
#-----------------------------------------------------------------
if (!grep /$ENV{REMOTE_ADDR}/, @whitelist) {
	print STDERR "*** $0: Unauthorized access attempt from $ENV{REMOTE_ADDR} ***\n"; 
	print "Content-type: text/html\n\n";
	print "Unathorized access";
	exit;
	}

#--------------------------------------------------------------------------------------------
# $debug and $parameter_trace are for diagnostic purposes and will normally be set to 0.
# $id_translation will be set to 1 as a default. Setting it to 0 disables the translation
# of alternate identifiers to Aleph ids by the adapter. 
#--------------------------------------------------------------------------------------------
my $debug = 		0;
my $parameter_trace = 	0;
my $id_translation = 	1;
my $sql_lookup = 	0;

#------------------------------------------------------------------------
#	Local base URLs for the Aleph X-server and the RESTful API.
#------------------------------------------------------------------------
my $x_base_url 	= 'http://localhost/X?';
my $r_base_url 	= "http://localhost:$rest_port";

#-------------------------------------
#	Headers and XML constants.
#-------------------------------------
my $xml_header 	= "Content-type: text/xml\n\n";
my $html_header = "Content-type: text/html\n\n";
my $xml_prolog 	= '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>';

my $version_xml = join '', 
	'<version>',
    	'<ilsInstitutionName>INSTNAME</ilsInstitutionName>',
    	'<ilsVersion>ALEPHVER</ilsVersion>',
    	'<locale>en_US</locale>',
    	'<timeZone>TIMEZONE</timeZone>',
    	'<timeZoneCode>TZCODE</timeZoneCode>',
	'<timeZoneGMT>TZGMT</timeZoneGMT>',
    	'<currencyCode>CURRENCY</currencyCode>',
	'</version>';

my $printline = '';
my $putdata;
my $postdata;

#----------------------------------------------------
#	Valid parameters in Aleph RESTful URLs
#----------------------------------------------------
my @allowed_groups 	 = ('patron','ilsinstance','record');
my @allowed_categories 	 = ('patroninformation','circulationactions','record','patronstatus','items','holds');
my @patinfo_functions 	 = ('address','password');
my @circ_functions 	 = ('loans','requests','cash');
my @patstatus_functions  = ('blocks','registration');
my @allowed_subfunctions = ('holds','photocopies','acquisitionrequests','ill','bookings');

#--------------------------------
#	Valid HTTP methods 
#--------------------------------
my @allowed_methods	 = ('get','post','put','delete');

#----------------------------------------------------------------------------
#	Get the RESTful URL components. 
#	@parms will contain the RESTful nodes between slashes.
#	@args will contain any key=value pairs from the end of the URI.
#----------------------------------------------------------------------------
my @parms = split /\//, (split /\?parm1=/, lc $ENV{'REQUEST_URI'})[0];
splice @parms,0,2;
my @args = split /\&/, (split /\?/, $parms[$#parms])[1];
if (grep /\?/, $parms[$#parms]) {
	$parms[$#parms] =~ s/\?(.*)$//go;
	}

my ($group, $patron_id, $category, $function, $subfunction) = '';
($group, $patron_id, $category, $function, $subfunction) = @parms;
if (!grep /$group/, @allowed_groups) {
	print "$html_header invalid group $group";
	exit;
	}
if (!grep /$category/, @allowed_categories) {
	print "$html_header invalid category $category";
	exit;
	}

#----------------------------------------------------------------------------------------
#	$method will contain one of the HTTP commands: GET, POST, PUT, DELETE, etc.
#	They are stored here in lower case for later use as method calls to LWP.
#----------------------------------------------------------------------------------------
my $method = lc $ENV{'REQUEST_METHOD'};

#------------------------------------------------------------------------------
#       This paragraph is for diagnostic purposes only. It writes parameters 
#       and arguments to the Apache log (STDERR) and exits.
#------------------------------------------------------------------------------
if ($parameter_trace) {
	print "$html_header";
	foreach my $x (@parms) { print "parm: $x<br>"; }
	if (@args) {
		foreach my $x (@args) { print "args: $x<br>"; }
		}
	if ($debug) {
		my $printline = join '',
				"*** Group: $group ***\n",
				"*** Patron id: $patron_id ***\n",
				"*** Category: $category ***\n",
				"*** Function: $function ***\n",
				"*** Subfunction: $subfunction ***\n";
		print STDERR $printline;
		}
	exit;
	}

#----------------------------------------------------------------------------
#	This section handles the request for Aleph version information.
#	The Aleph REST API does not support this operation.
#----------------------------------------------------------------------------
if ($group eq 'ilsinstance') {
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);    
	my $timezone = $isdst ? 'Eastern Daylight Time' : 'Eastern Standard Time';
	my $tzcode = $isdst ? 'EDT' : 'EST';

	my @aleph_info = `./get_aleph_info.csh`;
	my $version = (split ',', $aleph_info[0])[2];
	my $aleph_version = (split ' ', $version)[1];
	my $currency = $aleph_info[3];
	chomp $currency;

	my @t = localtime(time);
        my $gmt_offset_in_hours = (timegm(@t) - timelocal(@t)) / 3600;

	my $version_string = $version_xml;
	$version_string =~ s/ALEPHVER/$aleph_version/;
	$version_string =~ s/TIMEZONE/$timezone/;
	$version_string =~ s/TZCODE/$tzcode/;
	$version_string =~ s/TZGMT/$gmt_offset_in_hours/;
	$version_string =~ s/CURRENCY/$currency/;

	$printline = join '', $xml_prolog, $version_string;
        } 

else {
	#----------------------------------------------------------------------
	#       Instantiate a user agent for use in calling the REST API.
	#----------------------------------------------------------------------
	my $ua  = LWP::UserAgent->new;

	my $request_uri = $ENV{'REQUEST_URI'};
	my $response = '';
	my $aleph_id = '';
	if ($group eq 'patron' && $id_translation) {
		if (!$sql_lookup) {
        		#---------------------------------------------------------------------
        		#       Incoming identifer requires translation. Since $sql_lookup
			#	is not set, convert it to an Aleph id via bor-by-key 
			#	x-server function,
        		#---------------------------------------------------------------------
        		my $info_prefix = "op=bor-by-key&bor_id=$patron_id";
        		my $rest_url    = join '', $x_base_url, $info_prefix;
        		print STDERR "*** Bor-by-key URL: $rest_url ***\n" if $debug;
        		$response       = $ua->get($rest_url);
        		$aleph_id       = &extract_alephid($response);
        		print STDERR "*** Aleph id: $aleph_id ***\n" if $debug;
        		print STDERR "*** Patron id: $patron_id ***\n" if $debug;
        		print STDERR "*** request_uri before: $request_uri ***\n" if $debug;
        		$request_uri =~ s/$patron_id/$aleph_id/ig;
        		print STDERR "*** request_uri after: $request_uri ***\n" if $debug;
        		}
		else {
        		#---------------------------------------------------------------------
        		#       Incoming identifer requires translation. Since $sql_lookup
			#	is on, convert it to an Aleph id via SQL lookup. 
        		#---------------------------------------------------------------------
			$aleph_id = `./sql_lookup.csh $patron_id`;
			print STDERR "*** Aleph id from SQL: $aleph_id ***\n" if $debug;
			$request_uri =~ s/$patron_id/$aleph_id/ig;
			}
		}

	if (grep /$method/, @allowed_methods) {
		#-----------------------------------
		# Optional local programming can be inserted here by uncommenting the 
		# switch structure below  
		#-----------------------------------
		#switch ($category) {
		#	case ('patroninformation') { 
		#		# local code here
		#		}
		#	case ('patronstatus') { 
		#		# local code here
		#		}
		#	case ('circulationactions') { 
		#		# local code here
		#		}
		#	case ('record') { 
		#		# local code here
		#		}
		#       case ('items') {
                #               # local code here
                #               }
		#	}
		#-----------------------------------
		#	Default passthrough.
		#-----------------------------------
                my $rest_url = join '', $r_base_url, $request_uri;
                print STDERR "*** $category: $rest_url ***\n" if $debug;
                print STDERR "*** Method: $method ***\n" if $debug;
                my $request;
                switch ($method) {
                        case ('get') {
                                $request = HTTP::Request->new(GET => $rest_url);
                                }
                        case ('post') {
                                read(STDIN, $putdata, $ENV{'CONTENT_LENGTH'});
                                my $h = HTTP::Headers->new(Content_Type => 'text/xml');
                                $request = HTTP::Request->new('POST', $rest_url, $h, $putdata);
                                }
                        case ('put') {
                                read(STDIN, $putdata, $ENV{'CONTENT_LENGTH'});
                                my $h = HTTP::Headers->new(Content_Type => 'text/xml');
                                $request = HTTP::Request->new('PUT', $rest_url, $h, $putdata);
                                }
                        case ('delete') {
                                $request = HTTP::Request->new(DELETE => $rest_url);
                                }
                        }
                $response = $ua->request($request);
                $printline = $response->content;
                #------------------------------------------------------------
                #       Remove the port number from any URLs in the XML.
                #------------------------------------------------------------
                $printline =~ s/localhost:$rest_port/$ENV{'HTTP_HOST'}/go;
                }
        else {
                #------------------------------------------------------------------
                #       HTTP method is not supported. Return failure message
                #------------------------------------------------------------------
                $printline = join '', $xml_prolog, "<note>HTTP command $method is restricted or invalid</note>";
                }
	}

#-----------------------------------------------------------------------------------------
#	Return the content to the caller.
#	The following 'if' statement is required to ameliorate the Aleph REST API's 
#	inexplicable practice of returning HTML in certain error conditions.
#-----------------------------------------------------------------------------------------
print STDERR "*** printline: $printline ***\n" if $debug;
if (grep /<html>/, $printline) { print "$html_header" }
else { print "$xml_header" }
print $printline;
exit;

#------------------------- subroutines --------------------------
sub extract_alephid {
        my $xml_ref = pop;
        my @temp = split '<\/internal\-id>', (split '<internal\-id>', $xml_ref->content)[1];
        return $temp[0];
        }