File Coverage

blib/lib/BankAccount/Validator/UK.pm
Criterion Covered Total %
statement 173 189 91.5
branch 109 138 78.9
condition 43 60 71.6
subroutine 14 14 100.0
pod 2 2 100.0
total 341 403 84.6


line stmt bran cond sub pod time code
1             package BankAccount::Validator::UK;
2              
3             $BankAccount::Validator::UK::VERSION = '0.56';
4             $BankAccount::Validator::UK::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             BankAccount::Validator::UK - Interface to validate UK bank account.
9              
10             =head1 VERSION
11              
12             Version 0.56
13              
14             =cut
15              
16 3     3   207854 use 5.006;
  3         27  
17 3     3   1961 use Data::Dumper;
  3         20649  
  3         188  
18 3     3   1362 use BankAccount::Validator::UK::Rule;
  3         9  
  3         125  
19              
20 3     3   1658 use Moo;
  3         34388  
  3         13  
21 3     3   5816 use namespace::autoclean;
  3         39464  
  3         15  
22              
23             has sc => (is => 'rw');
24             has an => (is => 'rw');
25             has mod => (is => 'rw');
26             has attempt => (is => 'rw');
27             has last_ex => (is => 'rw');
28             has trace => (is => 'rw');
29             has debug => (is => 'ro', default => sub { 0 });
30             has last_check => (is => 'rw', default => sub { 0 });
31             has multi_rule => (is => 'ro', default => sub { 0 });
32             has sort_code => (is => 'ro', default => sub { BankAccount::Validator::UK::Rule::get_sort_codes() });
33              
34             =head1 DESCRIPTION
35              
36             The module uses the algorithm provided by VOCALINK to validate the bank sort code
37             and account number. It is done by modulus checking method as specified in the
38             document which is available on their website L
39             It currently supports the document L drafted 22nd Sep 2020.
40              
41             Institutions covered by this document are below:
42              
43             =over 4
44              
45             =item * Allied Irish
46              
47             =item * Bank of England
48              
49             =item * Bank of Ireland
50              
51             =item * Bank of Scotland
52              
53             =item * Barclays
54              
55             =item * Bradford and Bingley Building Society
56              
57             =item * Charity Bank
58              
59             =item * Citibank
60              
61             =item * Clear Bank
62              
63             =item * Clydesdale
64              
65             =item * Contis Financial Services
66              
67             =item * Co-Operative Bank
68              
69             =item * Coutts
70              
71             =item * First Trust
72              
73             =item * Halifax
74              
75             =item * Hoares Bank
76              
77             =item * HSBC
78              
79             =item * Lloyds
80              
81             =item * Metro Bank
82              
83             =item * NatWest
84              
85             =item * Nationwide Building Society
86              
87             =item * Northern
88              
89             =item * Orwell Union Ltd.
90              
91             =item * Royal Bank of Scotland
92              
93             =item * Santander
94              
95             =item * Secure Trust
96              
97             =item * Starling Bank
98              
99             =item * Tesco Bank
100              
101             =item * TSB
102              
103             =item * Ulster Bank
104              
105             =item * Unity Trust Bank
106              
107             =item * Virgin Bank
108              
109             =item * Williams & Glyn
110              
111             =item * Woolwich
112              
113             =item * Yorkshire Bank
114              
115             =back
116              
117             =head2 NOTE
118              
119             If the modulus check shows the account number as valid this means that the account
120             number is a possible account number for the sorting code but does'nt necessarily
121             mean that it's an account number being used at that sorting code. Any account
122             details found as invalid should be checked with the account holder where possible.
123              
124             =head1 CONSTRUCTOR
125              
126             The constructor simply expects debug flag, which is optional. By the default the
127             debug flag is off.
128              
129             use strict; use warnings;
130             use BankAccount::Validator::UK;
131              
132             # Debug is turned off.
133             my $account1 = BankAccount::Validator::UK->new;
134              
135             # Debug is turned on.
136             my $account2 = BankAccount::Validator::UK->new(debug => 1);
137              
138             =head1 METHODS
139              
140             =head2 is_valid($sort_code, $account_number)
141              
142             It expects two parameters i.e. the sort code and the account number.The sort code
143             can be either nn-nn-nn or nnnnnn format. If the account number starts with 0 then
144             its advisable to pass in as string i.e. '0nnnnnnn'.
145              
146             use strict; use warnings;
147             use BankAccount::Validator::UK;
148              
149             my $account = BankAccount::Validator::UK->new;
150             print "[10-79-99][88837491] is valid.\n"
151             if $account->is_valid(107999, 88837491);
152              
153             print "[18-00-02][00000190] is valid.\n"
154             if $account->is_valid('18-00-02', '00000190');
155              
156             =cut
157              
158             sub is_valid {
159 39     39 1 2684 my ($self, $sc, $an) = @_;
160              
161 39 100       161 die("ERROR: Missing bank sort code.\n") unless defined $sc;
162 38 100       133 die("ERROR: Missing bank account number.\n") unless defined $an;
163              
164 37         165 ($sc, $an) = _prepare($sc, $an);
165 35 50       116 die("ERROR: Invalid sort code.\n") unless (length($sc) == 6);
166 35 50       115 die("ERROR: Invalid account number.\n") unless (length($an) == 8);
167              
168 35         161 my $_sort_code = _init('u', $sc);
169 35         81 my $_account_number = _init('a', $an);
170 35         156 my $_rules = _get_rules($sc);
171              
172 35 50       152 next if (scalar(@{$_rules}) == 0);
  35         180  
173              
174 35         172 $self->{sc} = $sc;
175 35         125 $self->{an} = $an;
176 35 100       74 $self->{multi_rule} = (scalar(@{$_rules}) > 1)?(1):(0);
  35         189  
177 35         81 foreach my $_rule (@{$_rules}) {
  35         115  
178 45         130 $self->{attempt}++;
179             _init('u', '090126', $_sort_code)
180 45 100       157 if ($_rule->{ex} == 8);
181              
182 45 100 66     233 if (($_rule->{ex} == 6)
      100        
183             &&
184             ($_account_number->{a} =~ /^[4|5|6|7|8]$/)
185             &&
186             ($_account_number->{g} == $_account_number->{h})) {
187              
188 2         18 $self->{last_ex} = $_rule->{ex};
189 2         5 $self->{last_check} = 1;
190 2         11 push @{$self->{trace}}, {'ex' => $_rule->{ex},
191             'mod' => $_rule->{mod},
192 2         4 'res' => 'VALID'};
193 2         10 next;
194             }
195              
196 43 100 66     516 if (($_rule->{ex} == 7) && ($_account_number->{g} == 9)) {
    100          
    100          
    100          
    50          
    100          
197 1         85 _init('u','000000', $_rule);
198 1         3 _init('a','00', $_rule);
199             }
200             elsif ($_rule->{ex} == 8) {
201 1         6 _init('u', '090126', $_sort_code);
202             }
203             elsif ($_rule->{ex} =~ /^[2|9]$/) {
204 5 100       44 if ($_rule->{ex} == 9) {
    100          
205 1         4 _init('u', '309634', $_sort_code);
206             }
207             elsif ($_account_number->{a} != 0) {
208 3 100       24 if ($_account_number->{g} != 9) {
    50          
209 2         52 _init('u','001253', $_rule);
210 2         7 _init('a','6,4,8,7,10,9,3,1', $_rule);
211             }
212             elsif ($_account_number->{g} == 9) {
213 1         9 _init('u','000000', $_rule);
214 1         5 _init('a','0,0,8,7,10,9,3,1', $_rule);
215             }
216             }
217             }
218             elsif ($_rule->{ex} == 10) {
219 5         57 my $_ab = sprintf("%s%s", $_account_number->{a}, $_account_number->{b});
220 5 100 100     83 if ((($_ab eq "09") or ($_ab eq "99")) && ($_account_number->{g} == 9)) {
      66        
221 3         24 _init('u', '000000', $_rule);
222 3         12 _init('a', '00', $_rule);
223             }
224             }
225             elsif ($_rule->{ex} == 3) {
226 0         0 $self->{last_ex} = 3;
227 0 0       0 next if ($_account_number->{c} =~ /^[6|9]$/);
228             }
229             elsif ($_rule->{ex} == 5) {
230             _init('u', $self->{sort_code}->{$sc}, $_sort_code)
231 10 100       58 if (exists $self->{sort_code}->{$sc});
232             }
233              
234 43         107 my $_status;
235 43 100       285 if ($_rule->{mod} =~ /MOD(\d+)/i) {
    50          
236 35         284 $_status = $self->_standard_check($_sort_code, $_account_number, $_rule);
237             }
238             elsif ($_rule->{mod} =~ /DBLAL/i) {
239 8         42 $_status = $self->_double_alternate_check($_sort_code, $_account_number, $_rule);
240             }
241              
242 43 50       157 if (defined $_status) {
243 43         156 $self->{last_ex} = $_status->{ex};
244 43 100       152 $self->{last_check} = ($_status->{res} eq 'PASS')?(1):(0);;
245 43         72 push @{$self->{trace}}, $_status;
  43         162  
246             }
247              
248 43         201 my $_result = $self->_check_result();
249 43 100       446 return $_result if defined $_result;
250             }
251              
252             return $self->{last_check}
253 1 50 33     27 if ((defined $self->{last_ex}) && ($self->{last_ex} =~ /^6$/) && ($self->{multi_rule}));
      33        
254              
255 0         0 return;
256             }
257              
258             =head2 get_trace()
259              
260             Returns the trace information about each rule that applied to the given sort code
261             and account number.
262              
263             use strict; use warnings;
264             use Data::Dumper;
265             use BankAccount::Validator::UK;
266              
267             my $account = BankAccount::Validator::UK->new;
268             print "[87-14-27][09123496] is valid.\n"
269             if $account->is_valid('871427', '09123496');
270              
271             print "Trace information:\n" . Dumper($account->get_trace);
272              
273             =cut
274              
275             sub get_trace {
276 1     1 1 41 my ($self) = @_;
277              
278 1 50       15 return $self->{trace} if scalar(@{$self->{trace}});
  1         7  
279             }
280              
281             #
282             #
283             # PRIVATE METHODS
284              
285             sub _standard_check {
286 35     35   143 my ($self, $_sort_code, $_account_number, $_rule) = @_;
287              
288 35         75 my $total = 0;
289 35 50       131 $total += 27 if ($_rule->{ex} == 1);
290              
291 35 50       196 if ($_rule->{mod} =~ /MOD(\d+)/i) {
292 35         69 foreach (keys %{$_sort_code}) {
  35         311  
293             print "KEY: [$_] SC: [$_sort_code->{$_}] WEIGHTING: [$_rule->{$_}]\n"
294 210 50       418 if $self->{debug};
295 210         488 $total += $_sort_code->{$_} * $_rule->{$_};
296             }
297              
298 35         132 foreach (keys %{$_account_number}) {
  35         402  
299             print "KEY: [$_] AN: [$_account_number->{$_}] WEIGHTING: [$_rule->{$_}]\n"
300 280 50       588 if $self->{debug};
301 280         542 $total += $_account_number->{$_} * $_rule->{$_};
302             }
303              
304 35         420 my $remainder = $total % $1;
305 35 100 66     249 if ($_rule->{ex} == 4) {
    100          
    100          
306 1         11 my $_gh = sprintf("%d%d", $_account_number->{g}, $_account_number->{h});
307 1 50       6 if ($remainder == $_gh) {
308             return {'ex' => $_rule->{ex},
309             'mod' => $_rule->{mod},
310 1         10 'rem' => $remainder,
311             'tot' => $total,
312             'res' => 'PASS'};
313             }
314             }
315             elsif (($_rule->{ex} == 5) && ($1 == 11)) {
316 6 100       35 if ($remainder == 0) {
    100          
317 2 50       10 if ($_account_number->{g} == 0) {
318             return {'ex' => $_rule->{ex},
319             'mod' => $_rule->{mod},
320 2         21 'rem' => $remainder,
321             'tot' => $total,
322             'res' => 'PASS'};
323             }
324             else {
325             return {'ex' => $_rule->{ex},
326             'mod' => $_rule->{mod},
327 0         0 'rem' => $remainder,
328             'tot' => $total,
329             'res' => 'FAIL'};
330             }
331             }
332             elsif ($remainder == 1) {
333             return {'ex' => $_rule->{ex},
334             'mod' => $_rule->{mod},
335 1         16 'rem' => $remainder,
336             'tot' => $total,
337             'res' => 'FAIL'};
338             }
339             else {
340 3         7 $remainder = 11 - $remainder;
341 3 100       13 if ($_account_number->{g} == $remainder) {
342             return {'ex' => $_rule->{ex},
343             'mod' => $_rule->{mod},
344 2         21 'rem' => $remainder,
345             'tot' => $total,
346             'res' => 'PASS'};
347             }
348             else {
349             return {'ex' => $_rule->{ex},
350             'mod' => $_rule->{mod},
351 1         10 'rem' => $remainder,
352             'tot' => $total,
353             'res' => 'FAIL'};
354             }
355             }
356             }
357             elsif ($remainder == 0) {
358             return {'ex' => $_rule->{ex},
359             'mod' => $_rule->{mod},
360 21         223 'rem' => $remainder,
361             'tot' => $total,
362             'res' => 'PASS'};
363             }
364             else {
365 7 100       28 if ($_rule->{ex} == 14) {
366 1 50       8 if ($_account_number->{h} =~ /^[0|1|9]$/) {
367 1         6 my $an = substr($self->{an}, 0, 7);
368 1         9 $an = sprintf("%s%s", '0', $an);
369 1         8 _init('a', $an, $_account_number);
370              
371 1         2 $total = 0;
372 1         3 foreach (keys %{$_sort_code}) {
  1         6  
373             print "KEY: [$_] SC: [$_sort_code->{$_}] WEIGHTING: [$_rule->{$_}]\n"
374 6 50       13 if $self->{debug};
375 6         14 $total += $_sort_code->{$_} * $_rule->{$_};
376             }
377              
378 1         2 foreach (keys %{$_account_number}) {
  1         4  
379             print "KEY: [$_] AN: [$_account_number->{$_}] WEIGHTING: [$_rule->{$_}]\n"
380 8 50       82 if $self->{debug};
381 8         18 $total += $_account_number->{$_} * $_rule->{$_};
382             }
383              
384 1         9 $remainder = $total % 11;
385 1 50       7 if ($remainder == 0) {
386             return {'ex' => $_rule->{ex},
387             'mod' => $_rule->{mod},
388 1         10 'rem' => $remainder,
389             'tot' => $total,
390             'res' => 'PASS'};
391             }
392             else {
393             return {'ex' => $_rule->{ex},
394             'mod' => $_rule->{mod},
395 0         0 'rem' => $remainder,
396             'tot' => $total,
397             'res' => 'FAIL'};
398             }
399             }
400             else {
401             return {'ex' => $_rule->{ex},
402             'mod' => $_rule->{mod},
403 0         0 'rem' => $remainder,
404             'tot' => $total,
405             'res' => 'FAIL'};
406             }
407             }
408             else {
409             return {'ex' => $_rule->{ex},
410             'mod' => $_rule->{mod},
411 6         62 'rem' => $remainder,
412             'tot' => $total,
413             'res' => 'FAIL'};
414             }
415             }
416             }
417              
418 0         0 return;
419             }
420              
421             sub _double_alternate_check {
422 8     8   34 my ($self, $_sort_code, $_account_number, $_rule) = @_;
423              
424 8         19 my $total = 0;
425 8 100       71 $total += 27 if ($_rule->{ex} == 1);
426              
427 8         29 foreach (keys %{$_sort_code}) {
  8         59  
428 48         146 $total += _dbal_total($_sort_code->{$_} * $_rule->{$_});
429             }
430              
431 8         28 foreach (keys %{$_account_number}) {
  8         28  
432 64         122 $total += _dbal_total($_account_number->{$_} * $_rule->{$_});
433             }
434              
435 8         25 my $remainder = $total % 10;
436 8 100       43 if ($_rule->{ex} == 1) {
    100          
    100          
437 2 100       8 if ($remainder == 0) {
438             return {'ex' => $_rule->{ex},
439             'mod' => $_rule->{mod},
440 1         8 'rem' => $remainder,
441             'tot' => $total,
442             'res' => 'PASS'};
443             }
444             else {
445             return {'ex' => $_rule->{ex},
446             'mod' => $_rule->{mod},
447 1         11 'rem' => $remainder,
448             'tot' => $total,
449             'res' => 'FAIL'};
450             }
451             }
452             elsif ($_rule->{ex} == 5) {
453 4 100       16 if ($remainder == 0) {
454 1 50       7 if ($_account_number->{h} == 0) {
455             return {'ex' => $_rule->{ex},
456             'mod' => $_rule->{mod},
457 1         7 'rem' => $remainder,
458             'tot' => $total,
459             'res' => 'PASS'};
460             }
461             }
462             else {
463 3         7 $remainder = 10 - $remainder;
464 3 100       12 if ($_account_number->{h} == $remainder) {
465             return {'ex' => $_rule->{ex},
466             'mod' => $_rule->{mod},
467 2         16 'rem' => $remainder,
468             'tot' => $total,
469             'res' => 'PASS'};
470             }
471             else {
472             return {'ex' => $_rule->{ex},
473             'mod' => $_rule->{mod},
474 1         7 'rem' => $remainder,
475             'tot' => $total,
476             'res' => 'FAIL'};
477             }
478             }
479             }
480             elsif ($remainder == 0) {
481             return {'ex' => $_rule->{ex},
482             'mod' => $_rule->{mod},
483 1         7 'rem' => $remainder,
484             'tot' => $total,
485             'res' => 'PASS'};
486             }
487             else {
488             return {'ex' => $_rule->{ex},
489             'mod' => $_rule->{mod},
490 1         7 'rem' => $remainder,
491             'tot' => $total,
492             'res' => 'FAIL'};
493             }
494             }
495              
496             sub _init {
497 90     90   227 my ($index, $data, $init) = @_;
498              
499 90 100       297 if ($data =~ /\,/) {
500 3         14 map { $init->{$index++} = $_; } split /\,/,$data;
  24         55  
501             }
502             else {
503 87         345 map { $init->{$index++} = $_; } split //,$data;
  578         1600  
504             }
505              
506 90         274 return $init;
507             }
508              
509             sub _check_result {
510 43     43   132 my ($self) = @_;
511              
512 43 100       138 if ($self->{multi_rule}) {
513 33 100 66     693 if (((defined $self->{last_ex})
    100 100        
    100 66        
    100 66        
      66        
      100        
      66        
      100        
      66        
      66        
514             && ($self->{last_ex} =~ /^2|10|12$/)
515             && ($self->{last_check} == 1))
516             ||
517             ((defined $self->{last_ex})
518             && ($self->{last_ex} =~ /^9|11|13$/)
519             && ($self->{last_check} == 1)
520             && ($self->{attempt} == 2))) {
521 12         34 return 1;
522             }
523             elsif ((defined $self->{last_ex})
524             && ($self->{last_ex} =~ /^5|6$/)
525             && ($self->{last_check} == 0)) {
526 5         15 return 0;
527             }
528             elsif ((defined $self->{last_ex})
529             && ($self->{last_ex} == 0)
530             && ($self->{last_check} == 1)) {
531 3         9 return 1;
532             }
533             elsif ($self->{attempt} == 2) {
534 4         13 return $self->{last_check};
535             }
536             }
537             else {
538 10         30 return $self->{last_check};
539             }
540              
541 9         27 return;
542             }
543              
544             sub _get_rules {
545 35     35   88 my ($sc) = @_;
546              
547 35 50 33     294 return unless (defined($sc) && ($sc =~ /^\d+$/));
548              
549 35         69 my $rules;
550 35         68 foreach (@{BankAccount::Validator::UK::Rule::get_rules()}) {
  35         151  
551 39025 100 100     107038 push @{$rules}, $_ if ($sc >= $_->{start} && $sc <= $_->{end});
  60         206  
552             }
553              
554 35         32436 return $rules;
555             }
556              
557             sub _dbal_total {
558 112     112   175 my ($_total) = @_;
559              
560 112 100       193 if ($_total > 9) {
561 33         110 my ($left, $right) = split //, $_total;
562 33         86 return ($left + $right);
563             }
564             else {
565 79         154 return $_total;
566             }
567             }
568              
569             sub _prepare {
570 37     37   115 my ($sc, $an) = @_;
571              
572 37         148 $sc =~ s/[\-\s]+//g;
573 37         94 $an =~ s/\s+//g;
574              
575 37 100       193 die("ERROR: Invalid bank sort code [$sc].\n") unless ($sc =~ /^\d+$/);
576 36 100       183 die("ERROR: Invalid bank account number [$an].\n") unless ($an =~ /^\d+$/);
577              
578 35 50       303 if (length($an) == 10) {
    50          
    50          
    50          
579 0 0       0 if ($an =~ /^(\d+)\-(\d+)/) {
580 0         0 $an = $2;
581             }
582             else {
583 0         0 $an = substr($an, 0, 8);
584             }
585             }
586             elsif (length($an) == 9) {
587 0         0 my $_a = substr($an, 0, 1);
588 0         0 $an = substr($an, 1, 8);
589 0         0 $sc = substr($sc, 0, 5);
590 0         0 $sc .= $_a;
591             }
592             elsif (length($an) == 7) {
593 0         0 $an = '0'.$an;
594             }
595             elsif (length($an) == 6) {
596 0         0 $an = '00'.$an;
597             }
598              
599 35         110 return ($sc, $an);
600             }
601              
602             =head1 AUTHOR
603              
604             Mohammad S Anwar, C<< >>
605              
606             =head1 REPOSITORY
607              
608             L
609              
610             =head1 BUGS
611              
612             Please report any bugs or feature requests to C
613             rt.cpan.org>, or through the web interface at L.
614             I will be notified, and then you'll automatically be notified of progress on your
615             bug as I make changes.
616              
617             =head1 SUPPORT
618              
619             You can find documentation for this module with the perldoc command.
620              
621             perldoc BankAccount::Validator::UK
622              
623             You can also look for information at:
624              
625             =over 4
626              
627             =item * RT: CPAN's request tracker (report bugs here)
628              
629             L
630              
631             =item * AnnoCPAN: Annotated CPAN documentation
632              
633             L
634              
635             =item * CPAN Ratings
636              
637             L
638              
639             =item * Search CPAN
640              
641             L
642              
643             =back
644              
645             =head1 LICENSE AND COPYRIGHT
646              
647             Copyright (C) 2012 - 2017 Mohammad S Anwar.
648              
649             This program is free software; you can redistribute it and / or modify it under
650             the terms of the the Artistic License (2.0). You may obtain a copy of the full
651             license at:
652              
653             L
654              
655             Any use, modification, and distribution of the Standard or Modified Versions is
656             governed by this Artistic License.By using, modifying or distributing the Package,
657             you accept this license. Do not use, modify, or distribute the Package, if you do
658             not accept this license.
659              
660             If your Modified Version has been derived from a Modified Version made by someone
661             other than you,you are nevertheless required to ensure that your Modified Version
662             complies with the requirements of this license.
663              
664             This license does not grant you the right to use any trademark, service mark,
665             tradename, or logo of the Copyright Holder.
666              
667             This license includes the non-exclusive, worldwide, free-of-charge patent license
668             to make, have made, use, offer to sell, sell, import and otherwise transfer the
669             Package with respect to any patent claims licensable by the Copyright Holder that
670             are necessarily infringed by the Package. If you institute patent litigation
671             (including a cross-claim or counterclaim) against any party alleging that the
672             Package constitutes direct or contributory patent infringement,then this Artistic
673             License to you shall terminate on the date that such litigation is filed.
674              
675             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
676             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
677             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
678             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
679             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
680             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
681             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
682              
683             =cut
684              
685             1; # End of BankAccount::Validator::UK