1 package Business::CreditCard;
4 use vars qw( @ISA $VERSION $Country );
14 C<Business::CreditCard> - Validate/generate credit card checksums/names
18 use Business::CreditCard;
20 print validate("5276 4400 6542 1319");
21 print cardtype("5276 4400 6542 1319");
22 print generate_last_digit("5276 4400 6542 131");
24 Business::CreditCard is available at a CPAN site near you.
28 These subroutines tell you whether a credit card number is
29 self-consistent -- whether the last digit of the number is a valid
30 checksum for the preceding digits.
32 The validate() subroutine returns 1 if the card number provided passes
33 the checksum test, and 0 otherwise.
35 The cardtype() subroutine returns a string containing the type of
36 card. The list of possible return values is more comprehensive than it used
37 to be, but additions are still most welcome.
39 Possible return values are:
55 "Not a credit card" is returned on obviously invalid data values.
57 Versions before 0.31 may also have returned "Diner's Club/Carte Blanche" (these
58 cards are now recognized as "Discover card").
60 As of 0.30, cardtype() will accept a partial card masked with "x", "X', ".",
61 "*" or "_". Only the first 2-6 digits and the length are significant;
62 whitespace and dashes are removed. To recognize just Visa, MasterCard and
63 Amex, you only need the first two digits; to recognize almost all cards
64 except some Switch cards, you need the first four digits, and to recognize
65 all cards including the remaining Switch cards, you need the first six
68 The generate_last_digit() subroutine computes and returns the last
69 digit of the card given the preceding digits. With a 16-digit card,
70 you provide the first 15 digits; the subroutine returns the sixteenth.
72 This module does I<not> tell you whether the number is on an actual
73 card, only whether it might conceivably be on a real card. To verify
74 whether a card is real, or whether it's been stolen, or to actually process
75 charges, you need a Merchant account. See L<Business::OnlinePayment>.
77 These subroutines will also work if you provide the arguments
78 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
80 =head1 PROCESSING AGREEMENTS
82 Credit card issuers have recently been forming agreements to process cards on
83 other networks, in which one type of card is processed as another card type.
85 By default, Business::CreditCard returns the type the card should be treated as
86 in the US. You can change this to return the type the card should
87 be treated as in a different country by setting
88 C<$Business::CreditCard::Country> to your two-letter country code. This
89 is probably what you want to determine if you accept the card, or which
90 merchant agreement it is processed through.
92 You can also set C<$Business::CreditCard::Country> to a false value such
93 as the empty string to return the "base" card type. This is probably only
94 useful for informational purposes when used along with the default type.
96 Here are the currently known agreements:
100 =item Most Diner's club is now identified as Discover. (This supercedes the earlier identification of some Diner's club cards as MasterCard inside the US and Canada.)
102 =item JCB cards in the 3528-3589 range are identified as Discover inside the US and territories.
104 =item China Union Pay cards are identified as Discover cards in the US, Mexico and most Caribbean countries.
108 =head1 RECEIPT REQUIREMENTS
110 Discover requires some cards processed on its network to display "PayPal"
111 on receipts instead of "Discover". The receipt_cardtype() subroutine will
112 return "PayPal card" for these cards only, and otherwise the same output as
115 Use this for receipt display/printing only.
117 =head1 ORIGINAL AUTHOR
121 The Perl Journal and MIT Media Lab
125 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
127 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
128 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
129 types. Lee also contributed a working test.pl. Alexandr Ciornii
130 <alexchorny@gmail.com> contributed code cleanups. Jason Terry
131 <jterry@bluehost.com> contributed updates for Discover BIN ranges.
133 =head1 COPYRIGHT AND LICENSE
135 Copyright (C) 1995,1996,1997 Jon Orwant
136 Copyright (C) 2001-2006 Ivan Kohler
137 Copyright (C) 2007-2016 Freeside Internet Services, Inc.
139 This library is free software; you can redistribute it and/or modify
140 it under the same terms as Perl itself, either Perl version 5.8.8 or,
141 at your option, any later version of Perl 5 you may have available.
145 (paraphrasing Neil Bowers) We export all functions by default. It would be
146 better to let the user decide which functions to import. And validate() is
147 a bit of a generic name.
149 The question is, after almost 2 decades with this interface (inherited from
150 the original author, who probably never expected it to live half this long),
151 how to change things to behave in a more modern fashion without breaking
152 existing code? "use Business::CreditCard <some_minimum_version>" turns it off?
153 Explicitly ask to turn it off and list that in the SYNOPSIS?
157 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
158 providing an OO interface. Assistance integrating this into the base
159 Business::CreditCard distribution is welcome.
161 L<Business::OnlinePayment> is a framework for processing online payments
162 including modules for various payment gateways.
164 http://neilb.org/reviews/luhn.html is an excellent overview of similar modules
165 providing credit card number verification (LUHN checking).
169 @EXPORT = qw(cardtype validate generate_last_digit);
171 ## ref http://neilb.org/reviews/luhn.html#Comparison it looks like
172 ## Business::CCCheck is 2x faster than we are. looking at their implementation
173 ## not entirely a fair comparison, we also do the equivalent of their CC_clean,
174 ## they don't recognize certain cards at all (i.e. Switch) which require
175 ## an expensive check before VISA, Diners doesn't exist anymore, Discover is
176 ## a lot more than just 6011*, they don't handle processing agreements, etc.
179 # Allow use as a class method
180 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
184 $number =~ s/[\s\-]//go;
185 $number =~ s/[x\*\.\_]/x/gio;
187 return "Not a credit card" if $number =~ /[^\dx]/io;
191 local $^W=0; #no warning at next line
192 return "Not a credit card"
193 unless ( length($number) >= 13
194 || length($number) == 8 || length($number) == 9 #Isracard
199 return "VISA card" if $number =~ /^4[0-8][\dx]{11,17}$/o;
202 if $number =~ /^5[1-5][\dx]{14}$/o
203 || $number =~ /^2 ( 22[1-9] | 2[3-9][\dx] | [3-6][\dx]{2} | 7[0-1][\dx] | 720 ) [\dx]{12}$/xo
204 || $number =~ /^2[2-7]xx[\dx]{12}$/o;
206 return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
208 return "Discover card"
209 if $number =~ /^30[0-5][\dx]{13,16}$/o #diner's: 300-305
210 || $number =~ /^3095[\dx]{12}$/o #diner's: 3095
211 || $number =~ /^36[\dx]{12,17}$/o #diner's: 36
212 || $number =~ /^3[89][\dx]{14,17}$/o #diner's: 38 and 39
213 || $number =~ /^6011[\dx]{12,15}$/o
214 || $number =~ /^64[4-9][\dx]{13,16}$/o
215 || $number =~ /^65[\dx]{14,17}$/o
216 || ( $number =~ /^62[24-68][\dx]{13,16}$/o && $Country =~ /^(US|MX|AI|AG|AW|BS|BB|BM|BQ|VG|KY|CW|DM|DO|GD|GP|JM|MQ|MS|BL|KN|LC|VC|MF|SX|TT|TC)$/oi ) #China Union Pay identified as Discover in US, Mexico and Caribbean
217 || ( $number =~ /^35(2[89]|[3-8][\dx])[\dx]{12,15}$/o && $Country =~ /^(US|PR|VI|MP|PW|GU)$/oi ); #JCB cards in the 3528-3589 range are identified as Discover in US, Puerto Rico, US Virgin Islands, Northern Mariana Islands, Palau and Guam
220 if $number =~ /^49(03(0[2-9]|3[5-9])|11(0[1-2]|7[4-9]|8[1-2])|36[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o
221 || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
222 || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
223 #redunant with above, catch 49* that's not Switch
224 return "VISA card" if $number =~ /^4[\dx]{12,18}$/o;
226 #return "Diner's Club/Carte Blanche"
227 # if $number =~ /^3(0[0-59]|[68][\dx])[\dx]{11}$/o;
229 #"Diners Club enRoute"
230 return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
232 return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
234 return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
237 if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
239 return "China Union Pay"
240 if $number =~ /^62[24-68][\dx]{13}$/o;
243 if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
246 if $number =~ /^[\dx]{8,9}$/;
251 sub receipt_cardtype {
252 # Allow use as a class method
253 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
257 $number =~ s/[\s\-]//go;
258 $number =~ s/[x\*\.\_]/x/gio;
260 #ref Discover IIN Bulletin Feb 2015_021715
261 return "PayPal card" if $number =~ /^6(01104|506[01]0)[\dx]{10,13}$/o;
266 sub generate_last_digit {
267 # Allow use as a class method
268 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
272 die "invalid operation" if length($number) == 8 || length($number) == 9;
274 my ($i, $sum, $weight);
278 for ($i = 0; $i < length($number); $i++) {
279 $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
280 $sum += (($weight < 10) ? $weight : ($weight - 9));
283 return (10 - $sum % 10) % 10;
287 ## this (GPLed) code from Business::CCCheck is apparantly 4x faster than ours
288 ## ref http://neilb.org/reviews/luhn.html#Comparison
289 ## maybe see if we can speed ours up a bit
290 # my @ccn = split('',$ccn);
293 # for($i=$#ccn;$i >=0;--$i) {
294 # $ccn[$i] *= 2 if $even;
295 # $ccn -= 9 if $ccn[$i] > 9;
299 # $type = '' if $ccn % 10;
302 # Allow use as a class method
303 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
307 my ($i, $sum, $weight);
309 return 0 if $number =~ /[^\d\s]/;
313 if ( $number =~ /^[\dx]{8,9}$/ ) { # Isracard
314 $number = "0$number" if length($number) == 8;
315 for($i=1;$i<length($number);$i++){
316 $sum += substr($number,9-$i,1) * $i;
318 return 1 if $sum%11 == 0;
322 return 0 unless length($number) >= 13 && 0+$number;
324 for ($i = 0; $i < length($number) - 1; $i++) {
325 $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
326 $sum += (($weight < 10) ? $weight : ($weight - 9));
329 return 1 if substr($number, -1) == (10 - $sum % 10) % 10;