File Coverage

blib/lib/Finance/BankVal/UK.pm

Criterion	Covered	Total	%
statement	39	100	39.0
branch	4	32	12.5
condition	0	18	0.0
subroutine	9	14	64.2
pod	0	8	0.0
total	52	172	30.2

package Finance::BankVal::UK;

use 5.008000;
use strict;
use warnings;
use vars qw(@params $size $account $error $sortcode $uid $pin &responseString $ua);
use LWP::UserAgent;
use JSON;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(bankValUK new);
our $VERSION   = '0.9';

my $sortcode;          #sortcode to be validated
my $account;           #account number to be validated
my $uid;               #userID
my $pin;               #PIN
my $size;              #holds length of param array
my $url;               #the URL built for the REST call
my $responseString;    #the return to the calling method
my $error; #holds any error messages etc from the module, erors from the web servoce will be returned in $response string
my $json;    #holds the data to call the service with

#constructor
sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {};
	bless( $self, $class );
	return $self;
}

#
# Exportable sub can take parameter array of 4 or 2 elements
# these must be in the order detailed in the perldoc for this module
#
sub bankValUK {
	$error = "";
	my @params = @_;
	$size = @params;

	#the following block checks to see if the first param is a reference
	#if it is then the sub was called as an object ref so size is reduced
	#accordingly
	#my $refCheck = shift @_;    #remove the leftmost array element
	#if ( ref($refCheck) ) {     #check if its a reference
#		$size--;    #if it is reduce the size value to account for it
#	}
#	else {          #otherwise
#		unshift( @_, $refCheck );    #put it back
#	}
	$sortcode = $_[0];               #set the sortcode

	#strip sortcode of seperating - or spaces
	$sortcode =~ s/-| //g;
    print STDOUT $sortcode;
	#Switch to handle different amount of parameters
  SWITCH: {
		$size == 4 && do {
			$account = $_[1];
			$uid     = $_[2];
			$pin     = $_[3];
			last SWITCH;
		};
		$size == 3 && do {    #todo this is now an error with only sortcode
			$uid = $_[1];
			$pin = $_[2];
			last SWITCH;
		};
		$size == 2 && do {
			$account = $_[1];
			&loadUidPin;
			last SWITCH;
		};
		$size == 1 && do {    #todo this is now an error with only sortcode
			&loadUidPin;
			last SWITCH;
		};
	}

	#call validation sub now all elements are loaded
	&validateFormat;

	if ($error) {
		$responseString = "$error";
		&formatErrorMsg;
		return $responseString;
	}

	#call validation sub
	&goValidate;
	print STDOUT $responseString;
	return $responseString;
}

#call main servers REST services passing url with relevant parameters
sub goValidate {
    $responseString = "";
	#create user agent
	local $ua = LWP::UserAgent->new();

	#set the URL
	$url = 'https://www.unifiedservices.co.uk/services/enhanced/bankval';

	#call the service
	&loadContent;
	my $req = HTTP::Request->new( 'POST', $url );
	$req->header( 'Content-Type' => 'application/json' );
	$req->content($json);
	my $response = $ua->request($req);

#Check the response code anything under 200 or over 399 is an error with main server try backup
	if ( $response->code < 200 || $response->code > 399 ) {
		&goFallOver;
	}
	else {
		$responseString = $response->content();   #otherwise return the returned
	}
}

#sub to call backup servers
sub goFallOver {

	#set the URL
	$url = 'https://www.unifiedsoftware.co.uk/services/enhanced/bankval';

	#call the service
	my $req = HTTP::Request->new( 'POST', $url );
	$req->header( 'Content-Type' => 'application/json' );
	$req->content($json);
	my $response = $ua->request($req);

	#Check the response code
	if ( $response->code < 200 || $response->code > 399 ) {
		$responseString .=
		  $response->code;    #still a problem so return error code
	}
	else {
		$responseString =
		  $response->content();    #ok this time so return the returned
	}
}

#sub to validate the parameters input
sub validateFormat {

 #Validate sortcode all numeric 6 chars (-'s and ws stripped in calling routine)
	if ( $sortcode !~ /^\d\d\d\d\d\d$/ ) {
		$error .= "INVALID - Sortcode";
		return;
	}

	#Validate account all numeric between 6 and 12 digits
	if (   ( length($account) < 6 )
		|| ( length($account) > 12 )
		|| ( $account !~ /^\d+\d$/ ) )
	{
		$error .= "INVALID - Account";
		return;
	}

	#Validate PIN all numeric 5 characters
	if ( $pin !~ /^\d\d\d\d\d$/ ) {
		$error .= "ERROR - Invalid User ID/PIN";
		return;
	}

#Validate UID must end with 3 numerics exactly and start with 3 Alpha variable length otherwise
	if ( $uid !~ /^[a-zA-Z\-_][a-zA-Z][a-zA-Z]*\D\d\d\d$/ ) {
		$error .= "ERROR - Invalid User ID/PIN";
		return;
	}
}

#sub to load PIN and UserID from LoginConfig.txt file if they weren't passed in with the method call
#returns an error if unsuccessful
sub loadUidPin {
	my $fileOpened = open UIDCONF, "LoginConfig.txt";
	if ( !$fileOpened ) {
		$error .=
"No UserID / PIN supplied, please visit https://www.unifiedsoftware.co.uk/request-a-free-trial/: ";
	}
	else {
		while () {
			if ( $_ =~ /^UserID/ ) {
				chomp( my @line = split( / |\t/, $_ ) );
				$uid = $line[-1];
			}
			elsif ( $_ =~ /^PIN/ ) {
				chomp( my @line = split( / |\t/, $_ ) );
				$pin = $line[-1];
			}

		}

#check to see if conf file has empty params - if so return error message directing to free trial page
		if ( ( $uid !~ /\w/ ) || ( $pin !~ /\w/ ) ) {
			$error .=
"No UserID / PIN supplied, please visit https://www.unifiedsoftware.co.uk/request-a-free-trial/: ";
		}
		close UIDCONF;
	}
}

sub loadContent {
	$json =
"{'credentials':{'uname':'$uid','pin':'$pin'},'account':{'account':'$account','sortcode':'$sortcode'}}";
}

#sub to format the error message in the correct expected format with all nodes etc
sub formatErrorMsg {
	if ( substr( $responseString, 0, 7 ) eq 'INVALID' ) {
		$responseString =
		  "{\"validationID\": \"\",\"BankValUK\": {\"result\":\""
		  . $responseString . "\"}}";
	}
	else {
		$responseString = "{\"Error\": \"Invalid Credentials\"}";
	}

}

1;
__END__