File Coverage

blib/lib/Business/IBAN/Validator.pm
Criterion Covered Total %
statement 44 46 95.6
branch 11 12 91.6
condition n/a
subroutine 8 9 88.8
pod 3 3 100.0
total 66 70 94.2


line stmt bran cond sub pod time code
1             package Business::IBAN::Validator;
2 3     3   91402 use warnings;
  3         7  
  3         124  
3 3     3   17 use strict;
  3         7  
  3         176  
4              
5             our $VERSION = 0.05;
6              
7 3     3   3844 use Hash::Util qw/unlock_hash lock_hash/;
  3         9198  
  3         19  
8 3     3   2725 use Business::IBAN::Database;
  3         8  
  3         2066  
9              
10             sub new {
11 2     2 1 29 my $class = shift;
12              
13 2         13 my $db = iban_db();
14 2         13 unlock_hash(%$db);
15 2         131 my $self = bless $db, $class;
16 2         19 lock_hash(%$self);
17 2         130 return $self;
18             }
19              
20             sub validate {
21 140     140 1 49214 my $self = shift;
22 140         165 my ($iban) = @_;
23              
24 140         590 (my $to_check = $iban) =~ s/\s+//g;
25 140         254 my $iso3166a2 = uc(substr($to_check, 0, 2));
26              
27 140 100       345 if (not exists($self->{$iso3166a2})) {
28 1         13 die "'$iso3166a2' is not an IBAN country code.\n";
29             }
30              
31 139         186 my $iban_info = $self->{$iso3166a2};
32 139 100       401 if (length($to_check) != $iban_info->{iban_length}) {
33 1         19 die(
34             sprintf(
35             "'%s' has incorrect length %d (expected %d for %s).\n",
36             $iban,
37             length($to_check),
38             $iban_info->{iban_length},
39             $iban_info->{country}
40             )
41             );
42             }
43              
44 138 100       1969 if ($to_check !~ $iban_info->{iban_structure}) {
45 1         14 die(
46             sprintf(
47             "'%s' does not match the pattern '%s'for %s.\n",
48             $iban,
49             $iban_info->{pattern},
50             $iban_info->{country}
51             )
52             );
53             }
54              
55 137 100       411 if ( mod97(numify_iban($to_check)) != 1) {
56 1         9 die "'$iban' does not comply with the 97-check.\n";
57             }
58              
59 136         586 return 1;
60             }
61              
62             sub is_sepa {
63 136     136 1 37918 my $self = shift;
64 136         166 my ($iban) = @_;
65 136         523 (my $to_check = $iban) =~ s/\s+//g;
66 136         229 my $iso3166a2 = uc(substr($to_check, 0, 2));
67              
68 136 50       292 if (not exists($self->{$iso3166a2})) {
69 0         0 die "'$iso3166a2' is not an IBAN country code.\n";
70             }
71              
72 136         605 return $self->{$iso3166a2}{is_sepa};
73             }
74              
75 0     0   0 sub DESTROY { }
76              
77             sub AUTOLOAD {
78 2     2   1024 my $self = shift;
79 2         13 (my $cc = our $AUTOLOAD) =~ s/.*:://;
80 2 100       10 if (!exists $self->{uc $cc}) {
81 1         13 require Carp;
82 1         39 Carp::croak("'$cc' is not a valid IBAN country code.");
83             }
84 1         7 return $self->{uc $cc};
85             }
86              
87             1;
88              
89             =head1 NAME
90              
91             Business::IBAN::Validator - A validator for the structure of IBANs.
92              
93             =head1 SYNOPSIS
94              
95             use Business::IBAN::Validator;
96             my $v = Business::IBAN::Validator->new;
97             while (1) {
98             print 'Enter IBAN: ';
99             chomp(my $input = <>);
100             last if !$input;
101             eval { $v->validate($input) };
102             if ($@) {
103             print "Not ok: $@";
104             }
105             else {
106             print "OK\n";
107             }
108             }
109              
110             =head1 DESCRIPTION
111              
112             This module does a series of checks on an IBAN:
113              
114             =over
115              
116             =item Country code
117              
118             =item Length
119              
120             =item Pattern
121              
122             =item 97-Check
123              
124             =back
125              
126             =head2 $v = Business::IBAN::Validator->new()
127              
128             Return an IBAN validator object.
129              
130             =head2 $v->validate($iban)
131              
132             Perform a series of checks, and die() as soon as one fails.
133              
134             Return 1 on success.
135              
136             =head2 $v->is_sepa($iban)
137              
138             Return the SEPA status of the country (as denoted by the first two letters).
139              
140             =head1 STUFF
141              
142             (c) MMXIII - Abe Timmerman
143              
144             =cut