line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Transpose::Validator::CreditCard; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
30248
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
4
|
1
|
|
|
1
|
|
8
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
52
|
|
5
|
1
|
|
|
1
|
|
874
|
use Business::CreditCard; |
|
1
|
|
|
|
|
2946
|
|
|
1
|
|
|
|
|
112
|
|
6
|
1
|
|
|
1
|
|
814
|
use Moo; |
|
1
|
|
|
|
|
18445
|
|
|
1
|
|
|
|
|
1024
|
|
7
|
|
|
|
|
|
|
extends 'Data::Transpose::Validator::Base'; |
8
|
1
|
|
|
1
|
|
3061
|
use MooX::Types::MooseLike::Base qw(:all); |
|
1
|
|
|
|
|
9665
|
|
|
1
|
|
|
|
|
578
|
|
9
|
1
|
|
|
1
|
|
888
|
use namespace::clean; |
|
1
|
|
|
|
|
13951
|
|
|
1
|
|
|
|
|
5
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Data::Transpose::Validator::CreditCard - Validator for CC numbers |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
From inside L |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$dtv->prepare( |
20
|
|
|
|
|
|
|
cc_number => { |
21
|
|
|
|
|
|
|
validator => { |
22
|
|
|
|
|
|
|
class => 'CreditCard', |
23
|
|
|
|
|
|
|
options => { |
24
|
|
|
|
|
|
|
types => [ "visa card", |
25
|
|
|
|
|
|
|
"mastercard", |
26
|
|
|
|
|
|
|
"American Express card", |
27
|
|
|
|
|
|
|
"Discover card" ], |
28
|
|
|
|
|
|
|
country => 'DE', |
29
|
|
|
|
|
|
|
}, |
30
|
|
|
|
|
|
|
}, |
31
|
|
|
|
|
|
|
required => 1, |
32
|
|
|
|
|
|
|
}, |
33
|
|
|
|
|
|
|
cc_month => { |
34
|
|
|
|
|
|
|
validator => { |
35
|
|
|
|
|
|
|
class => 'NumericRange', |
36
|
|
|
|
|
|
|
options => { |
37
|
|
|
|
|
|
|
min => 1, |
38
|
|
|
|
|
|
|
max => 12, |
39
|
|
|
|
|
|
|
}, |
40
|
|
|
|
|
|
|
}, |
41
|
|
|
|
|
|
|
required => 1, |
42
|
|
|
|
|
|
|
}, |
43
|
|
|
|
|
|
|
cc_year => { |
44
|
|
|
|
|
|
|
validator => { |
45
|
|
|
|
|
|
|
class => 'NumericRange', |
46
|
|
|
|
|
|
|
options => { |
47
|
|
|
|
|
|
|
min => 2013, |
48
|
|
|
|
|
|
|
max => 2023, |
49
|
|
|
|
|
|
|
}, |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
required => 1, |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
my $form = { |
55
|
|
|
|
|
|
|
cc_number => ' 4111111111111111 ', |
56
|
|
|
|
|
|
|
cc_month => '12', |
57
|
|
|
|
|
|
|
cc_year => '2014', |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $clean = $dtv->transpose($form); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
ok($clean, "validation ok"); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Or, as stand-alone module: |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
my $v = Data::Transpose::Validator::CreditCard->new(country => 'DE', |
67
|
|
|
|
|
|
|
types => ["visa card", |
68
|
|
|
|
|
|
|
"mastercard"]); |
69
|
|
|
|
|
|
|
ok($v->is_valid("4111111111111111")); |
70
|
|
|
|
|
|
|
ok(!$v->is_valid("4111111111111112")); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 DESCRIPTION |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
This module wraps L to validate a credit card |
76
|
|
|
|
|
|
|
number. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head2 new(country => 'de', types => ['VISA card', 'MasterCard', ... ]) |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Constructor. The options as the following: |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=over 4 |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item country |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Two letters country code (for card type detection purposes). Defaults |
87
|
|
|
|
|
|
|
to "US" (as per L defaults). |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item types |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
List of accepted CC type. The string is case insensitive, but must |
92
|
|
|
|
|
|
|
match the following recognized types. It's unclear how much reliable |
93
|
|
|
|
|
|
|
is this, so use with caution. Recognized types: |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
American Express card |
96
|
|
|
|
|
|
|
BankCard |
97
|
|
|
|
|
|
|
China Union Pay |
98
|
|
|
|
|
|
|
Discover card |
99
|
|
|
|
|
|
|
Isracard |
100
|
|
|
|
|
|
|
JCB |
101
|
|
|
|
|
|
|
Laser |
102
|
|
|
|
|
|
|
MasterCard |
103
|
|
|
|
|
|
|
Solo |
104
|
|
|
|
|
|
|
Switch |
105
|
|
|
|
|
|
|
VISA card |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=back |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=cut |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub _recognized_types { |
112
|
3
|
|
|
3
|
|
21
|
my @types = ( |
113
|
|
|
|
|
|
|
'American Express card', |
114
|
|
|
|
|
|
|
'BankCard', |
115
|
|
|
|
|
|
|
'China Union Pay', |
116
|
|
|
|
|
|
|
'Discover card', |
117
|
|
|
|
|
|
|
'Isracard', |
118
|
|
|
|
|
|
|
'JCB', |
119
|
|
|
|
|
|
|
'Laser', |
120
|
|
|
|
|
|
|
'MasterCard', |
121
|
|
|
|
|
|
|
'Solo', |
122
|
|
|
|
|
|
|
'Switch', |
123
|
|
|
|
|
|
|
'VISA card', |
124
|
|
|
|
|
|
|
); |
125
|
3
|
|
|
|
|
12
|
return @types; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
has country => (is => 'rw', |
129
|
|
|
|
|
|
|
isa => Str, |
130
|
|
|
|
|
|
|
default => sub { 'US' }, |
131
|
|
|
|
|
|
|
); |
132
|
|
|
|
|
|
|
has types => (is => 'rw', |
133
|
|
|
|
|
|
|
isa => sub { |
134
|
|
|
|
|
|
|
my $list = $_[0]; |
135
|
|
|
|
|
|
|
die "Not an arrayref" unless is_ArrayRef($list); |
136
|
|
|
|
|
|
|
my %types = map { lc($_) => 1 } __PACKAGE__->_recognized_types; |
137
|
|
|
|
|
|
|
foreach my $type (@$list) { |
138
|
|
|
|
|
|
|
die "$type is not recognized" unless $types{lc($type)} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
}, |
141
|
|
|
|
|
|
|
default => sub { [] }); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head2 is_valid |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
Check with C[ if the argument is a valid credit card and return it ] |
148
|
|
|
|
|
|
|
on success (without whitespace). |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=cut |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub is_valid { |
153
|
55
|
|
|
55
|
1
|
13602
|
my ($self, $string) = @_; |
154
|
55
|
|
|
|
|
163
|
$self->reset_errors; |
155
|
55
|
100
|
|
|
|
2848
|
if (validate($string)) { |
156
|
36
|
|
|
|
|
1702
|
$string =~ s/\s//g; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
else { |
159
|
19
|
|
|
|
|
855
|
$self->error(["invalid_cc", cardtype($string) . " (invalid)"]); |
160
|
|
|
|
|
|
|
} |
161
|
55
|
100
|
|
|
|
160
|
if (!$self->error) { |
162
|
36
|
100
|
|
|
|
32
|
if (my @types = @{$self->types}) { |
|
36
|
|
|
|
|
560
|
|
163
|
19
|
|
|
|
|
429
|
$Business::CreditCard::Country = uc($self->country); |
164
|
19
|
|
|
|
|
685
|
my $cardtype = cardtype($string); |
165
|
19
|
100
|
|
|
|
474
|
unless (grep { lc($_) eq lc($cardtype) } @types) { |
|
46
|
|
|
|
|
112
|
|
166
|
11
|
|
|
|
|
59
|
$self->error(["cc_not_accepted", |
167
|
|
|
|
|
|
|
"$cardtype not in " . join(", ", @types)]); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
} |
171
|
55
|
100
|
|
|
|
898
|
$self->error ? return 0 : return $string; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head2 test_cc_numbers |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
For testing (and validation) purposes, this method returns an hashref |
178
|
|
|
|
|
|
|
with the test credit card numbers for each provider (as listed by |
179
|
|
|
|
|
|
|
Business::CreditCard::cardtype()). |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=cut |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub test_cc_numbers { |
184
|
2
|
|
|
2
|
1
|
25
|
my $self = shift; |
185
|
2
|
|
|
|
|
29
|
my $nums = { |
186
|
|
|
|
|
|
|
"VISA card" => [ |
187
|
|
|
|
|
|
|
'4111111111111111', |
188
|
|
|
|
|
|
|
'4222222222222', |
189
|
|
|
|
|
|
|
'4012888888881881', |
190
|
|
|
|
|
|
|
], |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
"MasterCard" => [ |
193
|
|
|
|
|
|
|
'5555555555554444', |
194
|
|
|
|
|
|
|
'5105105105105100', |
195
|
|
|
|
|
|
|
], |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
"Discover card" => [ |
199
|
|
|
|
|
|
|
'6011111111111117', |
200
|
|
|
|
|
|
|
'6011000990139424', |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# these should be JCB but are reported as JCB |
203
|
|
|
|
|
|
|
'3530111333300000', |
204
|
|
|
|
|
|
|
'3566002020360505' |
205
|
|
|
|
|
|
|
], |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
"American Express card" => [ "378282246310005", |
208
|
|
|
|
|
|
|
"371449635398431", |
209
|
|
|
|
|
|
|
"378734493671000", |
210
|
|
|
|
|
|
|
], |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
"JCB" => [ ], |
213
|
|
|
|
|
|
|
"enRoute" => [ ], |
214
|
|
|
|
|
|
|
"BankCard" => ['5610591081018250'], |
215
|
|
|
|
|
|
|
"Switch" => [ ], |
216
|
|
|
|
|
|
|
"Solo" => [ ], |
217
|
|
|
|
|
|
|
"China Union Pay" => [ ], |
218
|
|
|
|
|
|
|
"Laser" => [ ], |
219
|
|
|
|
|
|
|
"Isracard" => [ ], |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
"Unknown" => [ |
222
|
|
|
|
|
|
|
'5019717010103742', |
223
|
|
|
|
|
|
|
'6331101999990016', # actually it's Switch/Solo |
224
|
|
|
|
|
|
|
], |
225
|
|
|
|
|
|
|
}; |
226
|
2
|
|
|
|
|
6
|
return $nums; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Local Variables: |
230
|
|
|
|
|
|
|
# tab-width: 4 |
231
|
|
|
|
|
|
|
# End: |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
1; |