File Coverage

blib/lib/Data/Transpose/Validator/CreditCard.pm
Criterion Covered Total %
statement 37 37 100.0
branch 10 10 100.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 58 58 100.0


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;