File Coverage

blib/lib/Business/CCCheck.pm
Criterion Covered Total %
statement 94 104 90.3
branch 71 86 82.5
condition 53 63 84.1
subroutine 18 20 90.0
pod 13 13 100.0
total 249 286 87.0


line stmt bran cond sub pod time code
1             package Business::CCCheck;
2              
3 3     3   2150 use 5.006;
  3         10  
4 3     3   17 use strict;
  3         4  
  3         68  
5 3     3   15 use warnings;
  3         8  
  3         146  
6              
7             our $VERSION = '0.10';
8              
9 3     3   2805 use Business::CCCheck::CardID;
  3         9  
  3         641  
10              
11 3     3   20 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS @CC_months);
  3         10  
  3         4805  
12             require Exporter;
13             our @ISA = qw(Exporter);
14              
15             our @EXPORT_OK = qw(
16             @CC_months
17             CC_clean
18             CC_digits
19             CC_format
20             CC_year
21             CC_gen_date
22             CC_is_name
23             CC_is_addr
24             CC_is_zip
25             CC_expired
26             CC_oldtype
27             CC_parity
28             CC_typGeneric
29             CC_typDetail
30             CC_luhn_valid
31             );
32              
33             our %EXPORT_TAGS = (
34             all => [@EXPORT_OK],
35             );
36              
37             @CC_months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
38              
39             my $n = 3; # minimum length for a text string or word list
40              
41             sub CC_expired {
42 9     9 1 112 my ($mon,$yr) = @_;
43 9 100 100     46 return 1 unless $mon && $yr;
44 6 50 33     35 return 1 if
45             $mon =~ /\D/ ||
46             $yr =~ /\D/;
47 6 100 66     30 return 1 if
48             $mon < 1 ||
49             $mon > 12;
50 5         13 my $curyr = &CC_year;
51 5 100       15 return 1 if $yr < $curyr;
52 4 100       9 if ( $yr == $curyr ) {
53 2         27 my $curmon = (localtime)[4];
54 2 100       10 return ($mon > $curmon) ? undef : 1;
55             }
56 2         5 return undef;
57             }
58              
59             sub CC_is_zip {
60 7     7 1 67 my ($zip) = @_;
61 7 50       18 return '' unless $zip;
62 7 100 66     55 $zip = sprintf ( "%05d", $zip )
      66        
63             if ( $zip &&
64             $zip =~ /^\d*\.*\d*$/ &&
65             $zip ne '.' );
66 7 100 66     42 return ( length($zip) < 5 || $zip =~ /[^0-9a-zA-Z\ \-\.]/o )
67             ? '' : $zip;
68             }
69              
70             sub CC_is_name {
71 5 50   5 1 46 return '' unless $_[0];
72 5 100       18 return ( length($_[0]) < $n ) ? '' : $_[0];
73             }
74              
75             sub CC_is_addr {
76 0     0 1 0 my ($addr) = @_;
77 0 0       0 return '' unless $addr;
78 0         0 my $i = 0;
79 0         0 while ( $addr =~ /\w+/g ) { ++$i; } # count words
  0         0  
80 0 0 0     0 return ( $i < $n || $addr !~ /\n/ )
81             ? '' : $addr;
82             }
83              
84             sub CC_format {
85 1     1 1 10 my ($ccn) = @_;
86 1 50       3 return '' unless $ccn;
87             # reformat cc number
88 1         3 $ccn =~ tr/0-9//cd;
89 1         7 my @cchars = split(//, $ccn);
90 1         2 my $i = 0;
91 1         2 $ccn = '';
92 1         3 foreach ( 0..$#cchars ) {
93 10         16 $ccn .= $cchars[$_];
94 10         12 ++$i;
95 10 100       22 if ( $i >= 4 ) {
96 2         25 $ccn .= ' ';
97 2         4 $i = 0;
98             }
99             }
100 1         4 return $ccn;
101             }
102              
103             sub CC_year {
104 6     6 1 300 return (1900 + (localtime)[5]);
105             }
106              
107             sub CC_clean {
108 156     156 1 11852 my ($ccn) = @_;
109 156 50       368 return '' unless $ccn;
110 156         344 $ccn =~ tr/\- //d; # remove blanks and dashes
111 156 100       627 return ( $ccn =~ /\D/ ) ? '' : $ccn;
112             }
113              
114             #sub CC_id {
115             # my ($ccn) = @_;
116              
117             sub CC_digits {
118 39     39 1 141 my ($ccn) = @_;
119 39         69 my $type = &CC_oldtype;
120 39 100       117 return $type unless $type;
121 30 100       56 return (CC_parity($ccn)) ? $type : '';
122             }
123              
124             sub _is_enRoute {
125 87     87   110 my ($ccn) = @_;
126 87 100       205 return ( grep { $ccn =~ /^$_/ } keys %enRoute ) ?
  174         1924  
127             'enRoute' : '';
128             }
129              
130             sub CC_oldtype {
131 78     78 1 205 my ($ccn) = @_;
132 78 50       139 return '' unless $ccn;
133 78         107 my $i = length($ccn);
134 78         100 my $type = '';
135             # determine the card type
136 78 100 100     1669 if ( $ccn =~ /^51/ ||
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    50 100        
      100        
      100        
      100        
      100        
      66        
137             $ccn =~ /^52/ ||
138             $ccn =~ /^53/ ||
139             $ccn =~ /^54/ ||
140             $ccn =~ /^55/ ) {
141 14 100       57 $type = 'MasterCard' if $i == 16;
142             } elsif
143             ( $ccn =~ /^4/ ) {
144 12 100 100     54 $type = 'VISA' if $i == 13 || $i == 16;
145             } elsif
146             ( $ccn =~ /^34/ ||
147             $ccn =~ /^37/ ) {
148 8 100       31 $type = 'AmericanExpress' if $i == 15;
149             } elsif
150             ( $ccn =~ /^300/ ||
151             $ccn =~ /^301/ ||
152             $ccn =~ /^302/ ||
153             $ccn =~ /^303/ ||
154             $ccn =~ /^304/ ||
155             $ccn =~ /^305/ ||
156             $ccn =~ /^36/ ||
157             $ccn =~ /^38/ ) {
158 20 100       60 $type = 'DinersClub/Carteblanche' if $i eq 14;
159             } elsif
160             ( $ccn =~ /^6011/ ) {
161 6 100       20 $type = 'Discover' if $i == 16;
162             } elsif
163             (_is_enRoute($ccn)) {
164 6         17 return 'enRoute'; # early exit, type = 'enRoute'
165             } elsif
166             ( $ccn =~ /^3/ ) {
167 4 100       13 $type = 'JCB' if $i == 16;
168             } elsif
169             ( $ccn =~ /^2131/ ||
170             $ccn =~ /^1800/ ) {
171 8 100       22 $type = 'JCB' if $i == 15;
172             }
173 72         158 return $type;
174             }
175              
176             sub CC_parity {
177 69     69 1 186 my ($ccn) = @_;
178 69 50       133 return '' unless $ccn;
179              
180             # no parity check for enRoute
181 69 100       143 return 1 if _is_enRoute($ccn);
182              
183 63         147 return CC_luhn_valid($ccn);
184             }
185              
186             sub CC_luhn_valid
187             {
188 63     63 1 77 my $ccn = shift;
189 63         288 my @ccn = split('', $ccn);
190 63         87 my $even = 0;
191              
192 63         85 $ccn = 0;
193 63         177 for (my $i=$#ccn; $i >=0; --$i) {
194 951 100       1900 $ccn[$i] *= 2 if $even;
195 951 100       1877 $ccn -= 9 if $ccn[$i] > 9;
196 951         1097 $ccn += $ccn[$i];
197 951         2068 $even = ! $even;
198             }
199 63         311 return ($ccn % 10) == 0;
200             }
201              
202             =head1 NAME
203              
204             Business::CCCheck - collection of functions for checking credit card numbers
205              
206             =head1 SYNOPSIS
207              
208             use Business::CCCheck qw(
209             @CC_months
210             CC_year
211             CC_expired
212             CC_is_zip
213             CC_is_name
214             CC_is_addr
215             CC_clean
216             CC_digits
217             CC_oldtype
218             CC_parity
219             CC_typGeneric
220             CC_typDetail
221             CC_format
222             );
223              
224             =head1 DESCRIPTION
225              
226             This module checks the validity of the numbers and dates for a credit card
227             entry, including the parity of the CC number itself.
228              
229             =over 2
230              
231             =item @CC_months
232              
233             An array of 3 character text months. i.e. Jan, Feb....
234              
235             =item $scalar = CC_year
236              
237             Returns the localtime calendar year.
238              
239             =item $scalar = CC_expired(numeric_month,20xx)
240              
241             Returns true if card is expired or
242             month year has bad fromat else false
243              
244             =item $scalar = CC_is_zip(zipcode);
245              
246             Check for valid zip code, returns B or the B.
247              
248             =item $scalar = CC_is_name(name);
249              
250             Check for a name string greater than three characters.
251             Return B if short, otherwise return the B.
252              
253             =item $scalar = CC_is_addr(address);
254              
255             Check for a string containing at least 3 words and one endline.
256             Return B if short, otherwise return the B
.
257              
258             =item $scalar = CC_clean(credit_card_number);
259              
260             Remove blanks and dashes, verify numeric content. Returns B if
261             invalid characters are present, otherwise the cleaned credit card number.
262              
263             =item $scalar = CC_digits(credit_card_number);
264              
265             Pre-process with CC_clean.
266              
267             Returns B if the card number fails the check digit match (except for
268             enRoute which does not require a check digit) otherwise returns exact text
269             identifying the card issuer that is one of:
270              
271             MasterCard
272             VISA
273             AmericanExpress
274             DinersClub/Carteblanche
275             Discover
276             enRoute
277             JCB
278              
279             Checks number of digits in card number.
280              
281             =item $scalar = CC_oldtype($credit_card_number);
282              
283             Performs the number -> name conversion for CC_digits and checks number of
284             digits in card number.
285              
286             returns false if it can not convert.
287              
288             =item $scalar = CC_parity($credit_card_number);
289              
290             Performs a credit card number parity check for CC_digits.
291             This is the same as C, apart from for 'enRoute' cards,
292             which do not have a check digit. For 'enRoute' cards C
293             always returns true.
294              
295             =item $scalar = CC_luhn_valid($credit_card_number);
296              
297             Performs a strict LUHN check on a credit card number,
298             and returns true if the number has a valid check digit,
299             false otherwise.
300              
301             =cut
302              
303             # generic id of credit card number
304             #
305             # input: credit card number,
306             # pointer to hash of card prefix's => description
307             # returns: description or 'false'
308             #
309             sub _typeCheck {
310 37     37   55 my ($ccn,$hp) = @_;
311             # return '' unless CC_parity($ccn);
312 37         60 foreach my $key ( sort { $b cmp $a } keys %{$hp} ) {
  975         1088  
  37         139  
313             #print "$key\t=> $hp->{$key}\n";
314 239 100       1834 if ($ccn =~ /^$key/) {
315 28         132 return $hp->{$key};
316             }
317             }
318 9         32 return '';
319             }
320              
321             sub CC_typGeneric {
322 37     37 1 114 my($ccn) = @_;
323 37 50       75 return '' unless $ccn;
324 37         238 my %generic = (%enRoute,%CCprimary);
325 37         93 return _typeCheck($ccn,\%generic);
326             }
327              
328             sub CC_typDetail {
329 0     0 1   my ($ccn) = @_;
330 0 0         return '' unless $ccn;
331 0           my %detail = (%enRoute,%CCprimary,%CCsecondary);
332 0           return _typeCheck($ccn,\%detail);
333             }
334              
335             =item $scalar = CC_typGeneric(credit_card_number);
336              
337             Returns a text string describing the type of credit card or 'false' if no
338             indentification can be made. Checks if type is in '%enRoute' or
339             '%CCprimary', similar to B below.
340              
341             Does NOT check the number of digits in the card number.
342              
343             =item $scalar = CC_typDetail(credit_card_number);
344              
345             Returns detailed description of card type as it appears in %CCsecondary,
346             %CCprimary, %enRoute... or 'false' if the card number can not be identified.
347              
348             =item $scalar = CC_format(credit_card_number);
349              
350             Pre-process with CC_clean, CC_digits.
351              
352             Returns the credit card number as a group of quadruples separated by spaces.
353             The trailing (right hand) group will contain any remaining non-quad number set.
354              
355             =back
356              
357             =head1 HOW IT WORKS
358              
359             MOD10 Check Digit calculation
360              
361             Credit Card Validation - Check Digits
362              
363             This document outlines procedures and algorithms for Verifying the
364             accuracy and validity of credit card numbers. Most credit card numbers
365             are encoded with a "Check Digit". A check digit is a digit added to a
366             number (either at the end or the beginning) that validates the
367             authenticity of the number. A simple algorithm is applied to the other
368             digits of the number which yields the check digit. By running the
369             algorithm, and comparing the check digit you get from the algorithm
370             with the check digit encoded with the credit card number, you can verify
371             that you have correctly read all of the digits and that they make a
372             valid combination.
373              
374             Possible uses for this information:
375              
376             When a user has keyed in a credit card number (or scanned it)
377             and you want to validate it before sending it our for debit
378             authorization. When issuing cards, say an affinity card, you
379             might want to add a check digit using the MOD 10 method.
380              
381             LUHN Formula (Mod 10) for Validation of Primary Account Number
382              
383             The following steps are required to validate the primary account number:
384              
385             =over 4
386              
387             =item Step 1:
388              
389             Double the value of alternate digits of the primary account
390             number beginning with the second digit from the right (the
391             first right--hand digit is the check digit.)
392              
393             =item Step 2:
394              
395             Add the individual digits comprising the products obtained in
396             Step 1 to each of the unaffected digits in the original number.
397              
398             =item Step 3:
399              
400             The total obtained in Step 2 must be a number ending in zero
401             (30, 40, 50, etc.) for the account number to be validated.
402              
403             For example, to validate the primary account number 49927398716:
404              
405             =over 2
406              
407             =item Step 1:
408              
409             4 9 9 2 7 3 9 8 7 1 6
410             x2 x2 x2 x2 x2
411             ------------------------------
412             18 4 6 16 2
413              
414              
415             =item Step 2:
416              
417             4 +(1+8)+ 9 + (4) + 7 + (6) + 9 +(1+6) + 7 + (2) + 6
418              
419             =item Step 3:
420              
421             Sum = 70 : Card number is validated
422              
423             =back
424              
425             =back
426              
427             Note: Card is valid because the 70/10 yields no remainder.
428              
429             The validation applied (last known date 3/96) is the so called
430             LUHN Formula (Mod 10) for Validation of Primary Account Number
431             Validation criteria are:
432              
433             1. number prefix
434             2. number of digits
435             3. mod10 (for all but enRoute which uses only 1 & 2)
436              
437             ... according to the following list of example criteria:
438              
439             Card Type Prefix Length Check-Digit Algoritm
440              
441             MC 51 - 55 16 mod 10
442              
443             VISA 4 13, 16 mod 10
444              
445             AMX 34, 37 15 mod 10
446              
447             Diners Club / 300-305, 36, 38 14 mod 10
448             Carte Blanche
449              
450             Discover 6011 16 mod 10
451              
452             enRoute 2014, 2149 16 - any -
453              
454             JCB 3 16 mod 10
455             JCB 2131, 1800 15 mod 10
456              
457             =head1 COPYRIGHT AND LICENSE
458              
459             Copyright 2001 - 2011, Michael Robinton Emichael@bizsystems.comE
460              
461             This program is free software; you can redistribute it and/or modify
462             it under the terms of the GNU General Public License as published by
463             the Free Software Foundation; either version 2 of the License, or
464             (at your option) any later version.
465              
466             This program is distributed in the hope that it will be useful,
467             but WITHOUT ANY WARRANTY; without even the implied warranty of
468             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
469             GNU General Public License for more details.
470              
471             You should have received a copy of the GNU General Public License along
472             with this program; if not, write to the Free Software Foundation, Inc.,
473             51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
474              
475             =head1 AUTHOR
476              
477             Michael Robinton, Emichael@bizsystems.comE
478              
479             =cut
480              
481             1;