File Coverage

blib/lib/Finance/BankVal/International/IBANValidate.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Finance::BankVal::International::IBANValidate;

use 5.008000;
use strict;
use warnings;

use vars qw($size $format $iban $userid $pin $error $ua $url);
use LWP::UserAgent;
use XML::Simple;
use JSON;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(ibanValidate new);
our $VERSION = '0.05';

my $format;		#response return format i.e. xml json csv
my $iban;          	#the IBAN to be validated
my $userid;
my $pin;
my $size;               #the number of parameters passed only 2 and 4 are valid
my $error;              #any error messages generated here, not from unifieds servers
my $responseString;     #the return value of ibanValidate either $errors or web service response
my $ua;
my $url;

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

# exportable sub takes parameter array of 2 or 4 elements
# see perldoc for this module for more details
# ibanValidate($format,$iban,$userid,pin);
# or ibanValidate($format,$iban);
sub ibanValidate{
	$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
    	}
        $format = lc($_[0]);
        $iban = $_[1];
        if ($size > 2){
        	$userid = $_[2];
                $pin = $_[3];
        }else{
                &loadUidPin;
        }
        #all params should now be present so call validate formats sub
        &validateFormat;
        #if invalid formats are found return error message
        if ($error){
           	$responseString = "$error";
                &formatErrorMsg;
                return $responseString;
        }
        #if all formats are ok call web service sub then return response
        &goValidate;
        return $responseString;

}

sub goValidate{
        #create user agent
	$ua = LWP::UserAgent->new();

	#build the URL
        my $baseUrl = 'https://www.unifiedsoftware.co.uk/services/bankvalint/ibanvalidator';
    	$url = "$baseUrl/userid/$userid/pin/$pin/iban/$iban/$format/";

	#call the service
	my $response = $ua->get($url);

	#Check the response code if its fail call backup server sub
	if($response->code<200||$response->code>399){
                &goFallOver;
	} else {
	        $responseString = $response->content();
	}
}

sub goFallOver{
	#build the URL
        my $baseUrl = 'https://www.unifiedservices.co.uk/services/bankvalint/ibanvalidator';
    	$url = "$baseUrl/userid/$userid/pin/$pin/iban/$iban/$format/";

	#call the service
	my $response = $ua->get($url);

	#Check the response code
	if($response->code<200||$response->code>399){
                $responseString .= $response->code;
	} else {
	        $responseString = $response->content();
	}
}

sub validateFormat{
        #Validate response format must match json, xml, or, csv
        if ($format !~ /^json$|^xml$|^csv$/){
                $error .= "INVALID - Result Format";
                return;
        }
        #Validate IBAN up to 34 chars A-Z 0-9
        if ($iban !~ /^[A-Z,0-9]{1,34}$/) {
          	$error .= "INVALID - FORMAT";
                return;
        }
        #Validate PIN all numeric 5 characters
        if ($pin){
                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 ($userid){
                 if ($userid !~ /^[a-zA-Z\-_][a-zA-Z][a-zA-Z]*\D\d\d\d$/){
                    	$error .= "ERROR -Invalid User ID/PIN";
                        return;
                 }
        }
}

sub loadUidPin {
	my $fileOpened = open UIDCONF, "InternationalLoginConfig.txt";
        if ( ! $fileOpened){
                $error .= "No UserID / PIN supplied, please visit http://www.unifiedsoftware.co.uk/freetrial/free-trial-home.html: ";
        }else{
         	while (){
        		if ($_ =~ /^UserID/){
                        	chomp(my @line = split (/ |\t/,$_));
                                $userid = $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 (($userid !~ /\w/) || ($pin !~ /\w/)){
                        $error .= "No User ID / PIN supplied, please visit http://www.unifiedsoftware.co.uk/freetrial/free-trial-home.html: ";
                }
        close UIDCONF;
        }
}

sub formatErrorMsg{
 	if($format eq "xml"){
        	$responseString = "" . $responseString . "";
        }elsif($format eq "json"){
         	$responseString = "{\"result\":\"" . $responseString . "\"}";
        }
}

1;
__END__