File Coverage

blib/lib/Business/BankAccount/NZ.pm
Criterion Covered Total %
statement 12 192 6.2
branch 0 54 0.0
condition 0 30 0.0
subroutine 4 16 25.0
pod 4 12 33.3
total 20 304 6.5


line stmt bran cond sub pod time code
1             package Business::BankAccount::NZ;
2              
3             # name: $RCSfile: NZ.pm,v $
4             # process: Validates bank account numbers (See below)
5             # author: John Bolland, Becky Alcorn, Simon Taylor
6             # revision: $Id: NZ.pm,v 1.4 2003/01/07 00:29:49 simon Exp $
7              
8             =head1 NAME
9              
10             B - validates New Zealand bank account numbers
11              
12             =head1 SYNOPSIS
13              
14             use Business::BankAccount::NZ;
15            
16             # Returns a hash table with bank data in it (if specified)
17             my $nz = Business::BankAccount::NZ->new(
18             bank_no => '030510',
19             account_no => '072049700'
20             );
21            
22             # Or set the bank and account numbers independantly of new()
23             my $nz = Business::BankAccount::NZ->new();
24             $nz->set_bank_no('086523');
25             $nz->set_account_no('1954512001');
26            
27             # Either way, you'd validate the account number with...
28             $nz->validate() or die "$nz->{error_string}";
29            
30             print $nz->{error_string} if ($nz->{error});
31            
32             print "The bank name is " . $nz->{bank_name} . "\n";
33              
34             =head1 DESCRIPTION
35              
36             This module provides validation on New Zealand bank account numbers.
37              
38             The extent of the validation is simply that the account number is checked
39             to ensure that it conforms with the notion of an account number laid out
40             in the 'Bank Account Number Check Digit Validation Routines' brochure prepared
41             by the Bank of New Zealand, dated 27 October, 1999.
42              
43             Thus the module does not tell you whether or not a given bank account number
44             is an B account known to the bank, just that it is a B number
45             according to their rules.
46              
47             The module uses validation code developed by John Bolland.
48              
49             =head1 METHODS
50              
51             =cut
52              
53             require 5;
54 1     1   1138 use Carp;
  1         2  
  1         108  
55 1     1   6 use strict;
  1         168  
  1         45  
56 1     1   6 use warnings;
  1         4  
  1         47  
57 1     1   5 use vars qw($VERSION);
  1         1  
  1         2984  
58             $VERSION = "0.02";
59             my $module = "NZ.pm";
60              
61             =head2 new
62              
63             The minimum invocation is:
64              
65             use Business::BankAccount::NZ;
66             $nz = Business::BankAccount::NZ->new(
67             bank_no => '033565',
68             account_no => '384642737'
69             );
70             $nz->validate();
71              
72             =cut
73              
74             sub new
75             {
76 0     0 1   my ($class, %arg) = @_;
77              
78             #
79             # Bless an anonymous hash for this class and new() will return a
80             # reference to it
81             #
82              
83 0           my $self = {};
84 0 0         $self->{bank_no} = $arg{bank_no} if ($arg{bank_no});
85 0 0         $self->{account_no} = $arg{account_no} if ($arg{account_no});
86 0           $self->{bank_name} = "";
87 0           $self->{res} = '';
88              
89 0           bless($self, $class);
90              
91 0           return $self;
92             }
93              
94             =head2 set_bank_no
95              
96             Sets the bank number against whose rules we wish to validate an account number.
97              
98             $nz->set_bank_no('168392');
99              
100             =cut
101              
102             sub set_bank_no {
103 0     0 1   my ($self, $bank_no) = @_;
104 0           $self->{bank_name} = "";
105 0           $self->{bank_no} = $bank_no;
106             }
107              
108             =head2 set_account_no
109              
110             Sets the account number we wish to validate.
111              
112             $nz->set_account_no('02836723000');
113              
114             =cut
115              
116             sub set_account_no {
117 0     0 1   my ($self, $account_no) = @_;
118 0           $self->{res} = 0;
119 0           $self->{account_no} = $account_no;
120             }
121              
122             =head2 validate
123              
124             $nz->validate();
125              
126             This method checks the bank number and validates the account number.
127              
128             The validation is based rules set out in the 'Bank Account Number Check Digit
129             Validation Routines' brochure prepared by the Bank of New Zealand,
130             dated 27 October, 1999.
131              
132             The "error" and "error_string" attributes are set if validate() fails. The
133             "bank_name" attribute contains the bank name identified by the bank number.
134              
135             $nz->validate() or die "$nz->{error_string}";
136             print $nz->{error_string} if ($nz->{error});
137            
138             print "The bank name is " . $nz->{bank_name} . "\n";
139              
140             =cut
141              
142             #
143             # Returns 0 and an error message if failed, or 1 and '' if success
144             #
145             sub validate {
146 0     0 1   my ($self, $account_no) = @_;
147              
148 0           $self->{error} = 0;
149 0           $self->{error_string} = "";
150 0           $self->{res} = '';
151              
152             # Check for an account number
153 0 0 0       if (!$account_no && !$self->{account_no}) {
154 0           $self->{error} = 1;
155 0           $self->{error_string} = "No account number specified";
156 0           return 0;
157             }
158              
159             # Check the length of the account number
160 0           my $len = length($self->{account_no});
161 0 0 0       if ($len < 8 || $len > 10) {
162 0           $self->{error} = 1;
163 0           $self->{error_string} =
164             "Account number must be from 8 to 10 characters long: $self->{account_no}";
165 0           return 0;
166             }
167              
168             # Check for a bank number
169 0 0         if (!$self->{bank_no}) {
170 0           $self->{error} = 1;
171 0           $self->{error_string} = "No bank number specified";
172 0           return 0;
173             }
174              
175             # Check length of bank number
176 0 0         if (length ($self->{bank_no}) != 6) {
177 0           $self->{error} = 1;
178 0           $self->{error_string} =
179             "Bank number must be six characters long: $self->{bank_no}";
180 0           return 0;
181             }
182              
183              
184             # $self->{bank} is bk
185             # $self->{branch} is br
186             # $self->{account} is ac
187             # $self->{suffix} is as
188              
189             # Determine the bank and do initial validation
190 0           $self->{bank} = substr($self->{bank_no}, 0, 2);
191             # Minor validation of bank number
192 0 0 0       if (($self->{bank} < 0) || ($self->{bank} > 32 && $self->{bank} != 38)) {
      0        
193 0           $self->{error} = 1;
194 0           $self->{error_string} = "The bank must be a valid bank number: $self->{bank}";
195 0           return 0;
196             }
197             # Determine the branch and do initial validation
198 0           ($self->{branch} = $self->{bank_no}) =~ s/^.{2}//;
199             # Determine the account (minus suffix) and do initial validation
200 0           $self->{account} = substr($self->{account_no},0, 7);
201             # Determine the suffix and do initial validation
202 0           ($self->{suffix} = $self->{account_no}) =~ s/^.{7}//;
203              
204             # Choose the bank and validate accordingly
205 0 0 0       if ($self->{bank} eq '08') {
    0 0        
    0 0        
    0 0        
    0 0        
      0        
206 0           $self->{bank_name} = "National Australia Bank";
207 0           nab_account($self);
208 0 0         return 0 if ($self->{error});
209             } elsif ($self->{bank} eq '09') {
210 0           $self->{bank_name} = "Reserve Bank";
211 0           rb_account($self);
212 0 0         return 0 if $self->{error};
213             } elsif ($self->{bank} eq '29') {
214 0           $self->{bank_name} = "United Bank";
215 0           ub_account($self);
216 0 0         return 0 if ($self->{error});
217             } elsif ($self->{bank} eq '25') {
218 0           $self->{bank_name} = "CountryWide and Rural Banks";
219 0           cwrb_account($self);
220 0 0         return 0 if ($self->{error});
221             } elsif ($self->{bank} eq '04' || $self->{bank} eq '05' ||
222             $self->{bank} eq '07' || $self->{bank} eq '10' ||
223             $self->{bank} eq '26' || $self->{bank} eq '28' ||
224             $self->{bank} eq '33') {
225             # Not supported banks
226 0           $self->{error} = 2;
227 0           $self->{error_string} = "This bank not supported: $self->{bank}";
228 0           return 0;
229             } else {
230             # Anything else (including Bank of NZ)
231 0           $self->{bank_name} = "Other Banks";
232 0           other_account($self);
233 0 0         return 0 if ($self->{error});
234             }
235            
236 0           return 1;
237             }
238              
239             #-------------------------------------------------------------------------
240             # Subroutines for validating the various account numbers
241             #
242              
243             # National Australia Bank
244             #
245             # Each digit is multiplied by a corresponding value in the @vals array
246             # and added to the total. The total is then divided by 11. If there
247             # is a remainer then the account number is invalid.
248             #
249             sub nab_account($) {
250 0     0 0   my ($self) = @_;
251             # Get account digits in an array
252 0           my @acc = get_acc_array($self->{account_no});
253             # Values by which to multiply the digits
254 0           my @vals = (7, 6, 5, 4, 3, 2, 1);
255 0           my $res = 0;
256             # The suffix
257 0           my $suff = $self->{suffix};
258              
259             # We only deal with suffixes 3 digits long
260 0 0         if (length($suff) == 3) {
261             # Multiply each values and add to result
262 0           for (my $i = 0; $i < scalar(@vals); $i++) {
263 0           $res += ($acc[$i] * $vals[$i]);
264             }
265              
266             # For debugging purposes
267 0           $self->{res} = $res;
268              
269             # Mod the result by 11
270             #$res = ($res / 11) - int($res / 11);
271 0           $res = $res % 11;
272             } else {
273             # Suffix not 3 digits long
274 0           $self->{error} = 3;
275 0           $self->{error_string} = "Invalid suffix: $suff";
276 0           return 0;
277             }
278              
279             # If the result is 0 the its a valid account number
280 0 0         if ($res == 0) {
281 0           return 1;
282             } else {
283             # Result was not 0 so return an error
284 0           $self->{error} = 1;
285 0           $self->{error_string} = "Invalid account number: $self->{account_no}";
286 0           return 0;
287             }
288             }
289              
290             # Reserve Bank
291             #
292             # Each digit is multiplied by a corresponding value in the @vals array.
293             # If the result is more than 1 digit long then the digits are added together
294             # and that result is added to the total. The total is then divided by 11. If there
295             # is a remainer then the account number is invalid.
296             #
297             sub rb_account($) {
298 0     0 0   my ($self) = @_;
299             # Get the account number digits
300 0           my @acc = get_acc_array($self->{account_no});
301             # The suffix
302 0           my $suff = $self->{suffix};
303             # The values by which the account number digits are multiplied
304 0           my @vals = (0, 0, 0, 5, 4, 3, 2);
305 0           my $res = 0;
306             # We only deal with suffixes of one digit
307 0 0         if (length($suff) == 1) {
308             # Do the multiplications and if a number is larger than one digit
309             # then add the digits together.
310 0           for (my $i = 0; $i < scalar(@vals); $i++) {
311 0           $res += multi_add($acc[$i], $vals[$i]);
312             }
313              
314             # Add the suffix to the result
315 0           $res += $suff;
316              
317             # For debugging
318 0           $self->{res} = $res;
319              
320             # Modules the result by 11
321             #$res = ($res / 11) - int($res / 11);
322 0           $res = $res % 11;
323             } else {
324             # Suffix was not 1 digit
325 0           $self->{error} = 5;
326 0           $self->{error_string} = "Invalid suffix: $suff";
327 0           return 0;
328             }
329              
330             # If the result is 0 then its a valid account number
331 0 0         if ($res == 0) {
332 0           return 1;
333             } else {
334             # Result was not 0 so return an error
335 0           $self->{error} = 1;
336 0           $self->{error_string} = "Invalid account number: $self->{account_no}";
337 0           return 0;
338             }
339             }
340              
341             # United Bank
342             # NOTE: uses multi_add2 not multi_add
343             #
344             # Each digit of the account number and the suffix is multiplied by a corresponding
345             # value in the @vals or @vals2 arrays. If the result is more than 1 digit long then
346             # the digits are added together until the result is only 1 digit long, and that result
347             # is added to the total. The total is then divided by 10. If there is a remainer
348             # then the account number is invalid.
349             #
350             sub ub_account($) {
351 0     0 0   my ($self) = @_;
352             # Get the digits of the account number
353 0           my @acc = get_acc_array($self->{account_no});
354             # The suffix
355 0           my $suff = $self->{suffix};
356             # Get the digits of the suffix
357 0           my @suffs = get_acc_array($suff);
358             # Values to multiply the account number digits by
359 0           my @vals = (1, 3, 7, 1, 3, 7, 1);
360             # Values to multiply the suffix digits by
361 0           my @vals2 = (3, 7, 1);
362 0           my $res = 0;
363              
364             # Validate the suffix
365 0 0         if (length($suff) == 3) {
366             # Do the multiplications and if a number is larger than one digit
367             # then add the digits together until there is only one digit.
368            
369             # Account number digits
370 0           for (my $i = 0; $i < scalar(@vals); $i++) {
371 0           $res += multi_add2($acc[$i], $vals[$i]);
372             }
373             # Suffix digits
374 0           for (my $i = 0; $i < scalar(@vals2); $i++) {
375 0           $res += multi_add2($suffs[$i], $vals2[$i]);
376             }
377              
378             # For debugging
379 0           $self->{res} = $res;
380              
381             # Modules the result by 10
382             #$res = ($res / 10) - int($res / 10);
383 0           $res = $res % 10;
384            
385             } else {
386             # Suffix wasn't 3 digits, so error
387 0           $self->{error} = 3;
388 0           $self->{error_string} = "Invalid suffix: $suff";
389 0           return 0;
390             }
391              
392             # If the result was zero then the account number is good
393 0 0         if ($res == 0) {
394 0           return 1;
395             } else {
396             # Result was not zero so error
397 0           $self->{error} = 1;
398 0           $self->{error_string} = "Invalid account number: $self->{account_no}";
399 0           return 0;
400             }
401              
402             }
403              
404             # CountryWide and Rural banks
405             #
406             # Each digit is multiplied by a corresponding value in the @vals array
407             # and the result is added to the total. The total is then divided by 10. If there
408             # is a remainer then the account number is invalid.
409             #
410             sub cwrb_account($) {
411 0     0 0   my ($self) = @_;
412             # The account number digits
413 0           my @acc = get_acc_array($self->{account_no});
414             # The suffix
415 0           my $suff = $self->{suffix};
416             # The values to multiply with
417 0           my @vals = (1, 7, 3, 1, 7, 3, 1);
418 0           my $res = 0;
419            
420             # Validate the suffix
421 0 0         if (length($suff) == 3) {
422             # Do the multiplications
423 0           for (my $i = 0; $i < scalar(@vals); $i++) {
424 0           $res += ($acc[$i] * $vals[$i]);
425             }
426              
427             # Debugging
428             #self->{res} = $res;
429              
430             # Mod the result
431             #$res = ($res / 10) - int($res / 10);
432 0           $res = $res % 10;
433             } else {
434             # Suffix wasn't 3 digits, so error
435 0           $self->{error} = 3;
436 0           $self->{error_string} = "Invalid suffix: $suff";
437 0           return 0;
438             }
439              
440             # If the result is 0 then the account number is good
441 0 0         if ($res == 0) {
442 0           return 1;
443             } else {
444             # The result wasn't 0, so error
445 0           $self->{error} = 1;
446 0           $self->{error_string} = "Invalid account number: $self->{account_no}";
447 0           return 0;
448             }
449              
450             }
451              
452             # The normal case (21 banks)
453             #
454             # Each digit of the account number and the branch is multiplied by a corresponding
455             # value in the @vals or @vals2 arrays and the result is added to the total. The
456             # total is then divided by 11. If there is a remainer then the account number
457             # is invalid.
458             #
459             # Banks include:
460             # 01, 02, 03, 06, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 27, 30 and 31
461             sub other_account($) {
462 0     0 0   my ($self) = @_;
463             # Get the account number digits
464 0           my @acc = get_acc_array($self->{account_no});
465             # Get the branch number digits
466 0           my @branch = get_acc_array($self->{branch});
467             # Get the suffix
468 0           my $suff = $self->{suffix};
469             # Values to multiply the branch digits with
470 0           my @vals = (6, 3, 7, 9);
471             # Values to multiply the account digits with
472 0           my @vals2 = (0, 10, 5, 8, 4, 2, 1);
473 0           my $res = 0;
474            
475             # Validate the suffix
476 0 0         if (length($suff) == 2) {
477             # Do the multiplications
478             # Branch
479 0           for (my $i = 0; $i < scalar(@vals); $i++) {
480 0           $res += ($branch[$i] * $vals[$i]);
481             }
482             # Account
483 0           for (my $i = 0; $i < scalar(@vals2); $i++) {
484 0           $res += ($acc[$i] * $vals2[$i]);
485             }
486              
487             # Debugging
488 0           $self->{res} = $res;
489              
490             # Mod the result with 11
491             #$res = ($res / 11) - int($res / 11);
492 0           $res = $res % 11;
493             } else {
494             # The suffix was not 2 digits, so error
495 0           $self->{error} = 4;
496 0           $self->{error_string} = "Invalid suffix: $suff";
497 0           return 0;
498             }
499              
500             # If the result was 0 the the account number is valid
501 0 0         if ($res == 0) {
502 0           return 1;
503             } else {
504             # Result was not zero so error
505 0           $self->{error} = 1;
506 0           $self->{error_string} = "Invalid account number: $self->{account_no}";
507 0           return 0;
508             }
509             }
510              
511             # Return the account number as an array
512             sub get_acc_array($) {
513 0     0 0   my ($acc_no) = @_;
514 0           return split('', $acc_no);
515             }
516              
517             # Multiply the two numbers together and add up any extra digits once.
518             sub multi_add($$) {
519 0     0 0   my ($a, $b) = @_;
520 0           my $prod = $a * $b;
521 0           my $res = 0;
522 0           my @nums = split('', $prod);
523              
524 0           foreach my $c (@nums) {
525 0           $res += $c;
526             }
527 0           return $res;
528             }
529              
530             # Multiply the two numbers together and add up any extra digits
531             # until you have only one digit.
532             sub multi_add2($$) {
533 0     0 0   my ($a, $b) = @_;
534 0           my $prod = $a * $b;
535 0           my $res = $prod;
536 0           my @nums = split('', $prod);
537 0           while($#nums >= 1) {
538 0           $res = 0;
539 0           foreach my $c (@nums) {
540 0           $res += $c;
541             }
542 0           @nums = split('', $res);
543             }
544 0           return $res;
545             }
546             1;
547              
548             =head1 DISCLAIMER
549              
550             This program is distributed in the hope that it will be useful,
551             but B; without even the implied warranty of
552             B or B.
553              
554             But do let us know if it gives you any problems.
555              
556             =head1 AUTHORS
557              
558             Becky Alcorn, Unisolve Pty Ltd
559             Simon Taylor, Unisolve Pty Ltd
560             John Bolland, Mainzeal Property and Construction Ltd
561              
562             Copyright 2002, Unisolve Pty Ltd All rights reserved
563              
564             This library is free software; you can redistribute it and/or modify it under
565             the same terms as Perl itself.
566              
567             Address bug reports and comments to: simon@unisolve.com.au
568              
569             =head1 SEE ALSO
570              
571             Business::CreditCard
572              
573             =cut
574              
575             __END__