File Coverage

blib/lib/Finance/BankVal/International/GetSWIFT.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


line stmt bran cond sub pod time code
1             package Finance::BankVal::International::GetSWIFT;
2            
3 1     1   529 use 5.008000;
  1         4  
  1         37  
4 1     1   4 use strict;
  1         1  
  1         24  
5 1     1   4 use warnings;
  1         3  
  1         32  
6 1     1   4 use vars qw($size $format $swiftbic $userid $pin $error $ua $url);
  1         1  
  1         122  
7 1     1   977 use LWP::UserAgent;
  1         58566  
  1         44  
8 1     1   1882 use XML::Simple;
  0            
  0            
9             use JSON;
10            
11             require Exporter;
12             our @ISA = qw(Exporter);
13             our @EXPORT_OK = qw(getSWIFT new);
14             our $VERSION = '0.04';
15            
16             my $format; #response return format i.e. xml json csv
17             my $swiftbic; #the SWIFT BIC to be validated
18             my $userid;
19             my $pin;
20             my $size; #the number of parameters passed only 2 and 4 are valid
21             my $error; #any error messages generated here, not from unifieds servers
22             my $responseString; #the return value of getSWIFT either $errors or web service response
23             my $ua;
24             my $url;
25            
26             #constructor
27             sub new {
28             my $proto = shift;
29             my $class = ref($proto) || $proto;
30             my $self = {};
31             bless ($self, $class);
32             return $self;
33             }
34            
35             # exportable sub takes parameter array of 2 or 4 elements
36             # see perldoc for this module for more details
37             # getSWIFT($format,$swiftbic,$userid,pin);
38             # or getSWIFT($format,$swiftbic);
39             sub getSWIFT{
40             $error="";
41             my @params = @_;
42             $size = @params;
43             #the following block checks to see if the first param is a reference
44             #if it is then the sub was called as an object ref so size is reduced
45             #accordingly
46             my $refCheck = shift @_; #remove the leftmost array element
47             if (ref($refCheck)){ #check if its a reference
48             $size--; #if it is reduce the size value to account for it
49             }else{ #otherwise
50             unshift(@_, $refCheck); #put it back
51             }
52             $format = lc($_[0]);
53             $swiftbic = $_[1];
54             if ($size > 2){
55             $userid = $_[2];
56             $pin = $_[3];
57             }else{
58             &loadUidPin;
59             }
60             #all params should now be present so call validate formats sub
61             &validateFormat;
62             #if invalid formats are found return error message
63             if ($error){
64             $responseString = "$error";
65             &formatErrorMsg;
66             return $responseString;
67             }
68             #if all formats are ok call web service sub then return response
69             &goValidate;
70             return $responseString;
71            
72             }
73            
74             sub goValidate{
75             #create user agent
76             $ua = LWP::UserAgent->new();
77            
78             #build the URL
79             my $baseUrl = 'https://www.unifiedsoftware.co.uk/services/bankvalint/bankdetails2';
80             $url = "$baseUrl/userid/$userid/pin/$pin/swiftbic/$swiftbic/$format/";
81            
82             #call the service
83             my $response = $ua->get($url);
84            
85             #Check the response code if its fail call backup server sub
86             if($response->code<200||$response->code>399){
87             &goFallOver;
88             } else {
89             $responseString = $response->content();
90             }
91             }
92            
93             sub goFallOver{
94             #build the URL
95             my $baseUrl = 'https://www.unifiedservices.co.uk/services/bankvalint/bankdetails2';
96             $url = "$baseUrl/userid/$userid/pin/$pin/swiftbic/$swiftbic/$format/";
97            
98             #call the service
99             my $response = $ua->get($url);
100            
101             #Check the response code
102             if($response->code<200||$response->code>399){
103             $responseString .= $response->code;
104             } else {
105             $responseString = $response->content();
106             }
107             }
108            
109             sub validateFormat{
110             #Validate response format must match json, xml, or, csv
111             if ($format !~ /^json$|^xml$|^csv$/){
112             $error .= "INVALID - Result Format";
113             return;
114             }
115             #Validate SWIFT BIC 8 chars
116             if (($swiftbic !~ /^[A-Z,0-9]{8}[\d]{3}$/)&&($swiftbic !~ /^[A-Z,0-9]{8}$/)) {
117             $error .= "INVALID";
118             return;
119             }
120             #Validate PIN all numeric 5 characters
121             if ($pin){
122             if ($pin !~ /^\d\d\d\d\d$/){
123             $error .= "ERROR - Invalid User ID/PIN";
124             return;
125             }
126             }
127             #Validate UID must end with 3 numerics exactly and start with 3 Alpha variable length otherwise
128             if ($userid){
129             if ($userid !~ /^[a-zA-Z\-_][a-zA-Z][a-zA-Z]*\D\d\d\d$/){
130             $error .= "ERROR - Invalid User ID/PIN";
131             return;
132             }
133             }
134             }
135            
136             sub loadUidPin {
137             my $fileOpened = open UIDCONF, "InternationalLoginConfig.txt";
138             if ( ! $fileOpened){
139             $error .= "No UserID / PIN supplied, please visit http://www.unifiedsoftware.co.uk/freetrial/free-trial-home.html: ";
140             }else{
141             while (){
142             if ($_ =~ /^UserID/){
143             chomp(my @line = split (/ |\t/,$_));
144             $userid = $line[-1];
145             }elsif($_ =~ /^PIN/){
146             chomp(my @line = split (/ |\t/,$_));
147             $pin = $line[-1];
148             }
149            
150             }
151             #check to see if conf file has empty params - if so return error message directing to free trial page
152             if (($userid !~ /\w/) || ($pin !~ /\w/)){
153             $error .= "No UserID / PIN supplied, please visit http://www.unifiedsoftware.co.uk/freetrial/free-trial-home.html: ";
154             }
155             close UIDCONF;
156             }
157             }
158            
159             sub formatErrorMsg{
160             if($format eq "xml"){
161             $responseString = "" . $responseString . ""
162             . ""
163             . "";
164             }elsif($format eq "json"){
165             $responseString = "{\"result\":\"" . $responseString . "\",\"bic\":\"\",\"name1\":\"\",\"name2\":\"\",\"name3\""
166             . ":\"\",\"address1\":\"\",\"address2\":\"\",\"address3\":\"\",\"address4\":\"\",\"location\":\"\",\"country\""
167             . ":\"\"}";
168             }
169             }
170            
171             1;
172             __END__