File Coverage

blib/lib/Data/FormValidator/Constraints/CreditCard.pm
Criterion Covered Total %
statement 66 66 100.0
branch 28 28 100.0
condition 3 6 50.0
subroutine 19 19 100.0
pod 5 5 100.0
total 121 124 97.5


line stmt bran cond sub pod time code
1             package Data::FormValidator::Constraints::CreditCard;
2              
3             ###############################################################################
4             # Required inclusions.
5             ###############################################################################
6 1     1   58113 use strict;
  1         2  
  1         28  
7 1     1   5 use warnings;
  1         2  
  1         30  
8 1     1   807 use Business::CreditCard qw();
  1         1536  
  1         39  
9              
10             ###############################################################################
11             # Version number.
12             ###############################################################################
13             our $VERSION = '0.02';
14              
15             ###############################################################################
16             # Allow our methods to be exported.
17             ###############################################################################
18 1     1   6 use Exporter;
  1         1  
  1         40  
19 1     1   4 use base qw( Exporter );
  1         2  
  1         97  
20 1     1   6 use vars qw( @EXPORT_OK %EXPORT_TAGS );
  1         2  
  1         800  
21             @EXPORT_OK = qw(
22             FV_cc_number
23             FV_cc_type
24             FV_cc_expiry
25             FV_cc_expiry_month
26             FV_cc_expiry_year
27             );
28             %EXPORT_TAGS = (
29             'all' => [@EXPORT_OK],
30             );
31              
32             ###############################################################################
33             # Subroutine: FV_cc_number()
34             ###############################################################################
35             # Creates a constraint closure that returns true if the constrained value
36             # appears to be a valid credit card number.
37             #
38             # NOTE: "appears to be a valid credit card number" ONLY means that the number
39             # appears to be valid and has passed the checksum test; -NO- tests have been
40             # performed to verify that this is actually a real/valid credit card number.
41             ###############################################################################
42             sub FV_cc_number {
43             return sub {
44 4     4   1061 my $dfv = shift;
45 4         11 my $val = $dfv->get_current_constraint_value();
46 4         20 return Business::CreditCard::validate($val);
47 4     4 1 48 };
48             }
49              
50             ###############################################################################
51             # Subroutine: FV_cc_type(@set)
52             ###############################################################################
53             # Creates a constraint closure that returns true if the constrained value
54             # appears to be a credit card of one of the types listed in the given '@set'.
55             # The '@set' can be provided as either a list of scalars (which are compared
56             # using the 'eq' operator), or as a list of regular expressions.
57             #
58             # For more information on the actual card types that can be checked for, please
59             # refer to the information for the 'cardtype()' method in
60             # 'Business::CreditCard'.
61             ###############################################################################
62             sub FV_cc_type {
63 5     5 1 1732 my (@set) = @_;
64             return sub {
65 5     5   817 my $dfv = shift;
66 5         11 my $val = $dfv->get_current_constraint_value();
67 5         25 my $type = Business::CreditCard::cardtype($val);
68 5         94 foreach my $elem (@set) {
69 7 100       29 if (ref($elem) eq 'Regexp') {
70 3 100       21 return 1 if ($type =~ $elem);
71             }
72             else {
73 4 100       11 return 1 if ($type eq $elem);
74             }
75             }
76 1         2 return;
77             }
78 5         33 }
79              
80             ###############################################################################
81             # Subroutine: FV_cc_expiry()
82             ###############################################################################
83             # Creates a constraint closure that returns true if the constrained value
84             # appears to be a valid credit card expiry date; correct integer values for
85             # year/month, with the date not being in the past.
86             #
87             # Accepted formats include "MM/YY" and "MM/YYYY".
88             #
89             # NOTE: use of this method requires that the full credit card expiry date be
90             # present in a single field; no facilities are provided for gathering the
91             # month/year data from two separate fields.
92             ###############################################################################
93             sub FV_cc_expiry {
94             return sub {
95 14     14   2107 my $dfv = shift;
96 14         32 my $val = $dfv->get_current_constraint_value();
97 14         63 my ($month, $year) = split('/', $val);
98 14 100 33     60 return if ((!defined $month) or (!defined $year));
99             # verify each field individually
100 13 100       21 return if (!_match_cc_expiry_month($month));
101 7 100       14 return if (!_match_cc_expiry_year($year));
102             # verify that date is not in the past
103 3         46 my @now = localtime();
104 3         6 $year = _windowize_year($year);
105 3 100 66     14 return if ($year == ($now[5]+1900) and $month <= ($now[4]+1));
106             # looks good!
107 2         14 return "$month/$year";
108             }
109 15     15 1 2259 }
110              
111             sub _windowize_year {
112 12     12   15 my $year = shift;
113 12 100       24 if ($year < 1900) {
114 5 100       16 $year += ($year < 70) ? 2000 : 1900;
115             }
116 12         28 return $year;
117             }
118              
119             sub _match_cc_expiry_month {
120 24     24   86 my $val = shift;
121 24 100       71 return if ($val =~ /\D/); # only contain numerics
122 21 100       45 return if ($val < 1); # can't be <1
123 17 100       35 return if ($val > 12); # can't be >12
124 13         35 return $val;
125             }
126              
127             sub _match_cc_expiry_year {
128 13     13   17 my $val = shift;
129 13         263 my $now = (localtime)[5] + 1900;
130 13 100       52 return if ($val =~ /\D/); # only contain numerics
131 9         17 $val = _windowize_year($val);
132 9 100       25 return if ($val < $now); # can't be before this year
133 5         13 return $val;
134             }
135              
136             ###############################################################################
137             # Subroutine: FV_cc_expiry_month()
138             ###############################################################################
139             # Creates a constraint closure that returns true if the constrained value
140             # appears to be a valid credit card expiry month; an integer in the range of
141             # "1-12".
142             ###############################################################################
143             sub FV_cc_expiry_month {
144             return sub {
145 11     11   1636 my $dfv = shift;
146 11         26 my $val = $dfv->get_current_constraint_value();
147 11         50 return _match_cc_expiry_month($val);
148             }
149 12     12 1 5791 }
150              
151             ###############################################################################
152             # Subroutine: FV_cc_expiry_year()
153             ###############################################################################
154             # Creates a constraint closure that returns true if the constrained value
155             # appears to be a valid credit card expiry year; an integer value for a year,
156             # not in the past.
157             #
158             # Expiry years can be provided as either "YY" or "YYYY". When using the
159             # two-digit "YY" format, the year is considered to be part of the sliding
160             # window 1970-2069.
161             ###############################################################################
162             sub FV_cc_expiry_year {
163             return sub {
164 6     6   1043 my $dfv = shift;
165 6         19 my $val = $dfv->get_current_constraint_value();
166 6         58 return _match_cc_expiry_year($val);
167             }
168 6     6 1 5748 }
169              
170             1;
171              
172             =head1 NAME
173              
174             Data::FormValidator::Constraints::CreditCard - Data constraints, using Business::CreditCard
175              
176             =head1 SYNOPSIS
177              
178             use Data::FormValidator::Constraints::CreditCard qw(:all);
179              
180             constraint_methods => {
181             cc_number => [
182             # number is syntactically valid
183             FV_cc_number(),
184              
185             # verify type, by value
186             FV_cc_type(qw(Visa MasterCard)),
187              
188             # verify type, by regex
189             FV_cc_type(qr/visa|mastercard/i),
190             ],
191              
192             # expiry month is within valid range
193             cc_exp_mon => FV_cc_expiry_month(),
194              
195             # expiry year is not in the past
196             cc_exp_year => FV_cc_expiry_year(),
197              
198             # full expiry date is not in the past
199             cc_expiry => FV_cc_expiry(),
200             },
201              
202             =head1 DESCRIPTION
203              
204             C provides several methods that
205             can be used to generate constraint closures for use with C
206             for the purpose of validating credit card numbers and expiry dates, using
207             C.
208              
209             =head1 METHODS
210              
211             =over
212              
213             =item FV_cc_number()
214              
215             Creates a constraint closure that returns true if the constrained value
216             appears to be a valid credit card number.
217              
218             NOTE: "appears to be a valid credit card number" ONLY means that the number
219             appears to be valid and has passed the checksum test; -NO- tests have been
220             performed to verify that this is actually a real/valid credit card number.
221              
222             =item FV_cc_type(@set)
223              
224             Creates a constraint closure that returns true if the constrained value
225             appears to be a credit card of one of the types listed in the given
226             C<@set>. The C<@set> can be provided as either a list of scalars (which are
227             compared using the C operator), or as a list of regular expressions.
228              
229             For more information on the actual card types that can be checked for,
230             please refer to the information for the C method in
231             C.
232              
233             =item FV_cc_expiry()
234              
235             Creates a constraint closure that returns true if the constrained value
236             appears to be a valid credit card expiry date; correct integer values for
237             year/month, with the date not being in the past.
238              
239             Accepted formats include "MM/YY" and "MM/YYYY".
240              
241             NOTE: use of this method requires that the full credit card expiry date be
242             present in a single field; no facilities are provided for gathering the
243             month/year data from two separate fields.
244              
245             =item FV_cc_expiry_month()
246              
247             Creates a constraint closure that returns true if the constrained value
248             appears to be a valid credit card expiry month; an integer in the range of
249             "1-12".
250              
251             =item FV_cc_expiry_year()
252              
253             Creates a constraint closure that returns true if the constrained value
254             appears to be a valid credit card expiry year; an integer value for a year,
255             not in the past.
256              
257             Expiry years can be provided as either "YY" or "YYYY". When using the
258             two-digit "YY" format, the year is considered to be part of the sliding
259             window 1970-2069.
260              
261             =back
262              
263             =head1 AUTHOR
264              
265             Graham TerMarsch (cpan@howlingfrog.com)
266              
267             =head1 COPYRIGHT
268              
269             Copyright (C) 2008, Graham TerMarsch. All Rights Reserved.
270              
271             This is free software; you can redistribute it and/or modify it under the same
272             license as Perl itself.
273              
274             =head1 SEE ALSO
275              
276             L,
277             L.
278              
279             =cut