1 package Business::CreditCard;
4 use vars qw( @ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS $Country );
10 @EXPORT = qw( cardtype validate generate_last_digit );
11 @EXPORT_OK = qw( receipt_cardtype validate_card );
12 $EXPORT_TAGS{NEW} = qw( validate_card cardtype receipt_cardtype );
18 C<Business::CreditCard> - Validate/generate credit card checksums/names
22 use Business::CreditCard;
24 print validate("5276 4400 6542 1319");
25 print cardtype("5276 4400 6542 1319");
26 print generate_last_digit("5276 4400 6542 131");
28 Business::CreditCard is available at a CPAN site near you.
32 These subroutines tell you whether a credit card number is
33 self-consistent -- whether the last digit of the number is a valid
34 checksum for the preceding digits.
36 The validate() subroutine returns 1 if the card number provided passes
37 the checksum test, and 0 otherwise.
39 The cardtype() subroutine returns a string containing the type of
40 card. The list of possible return values is more comprehensive than it used
41 to be, but additions are still most welcome.
43 Possible return values are:
59 "Not a credit card" is returned on obviously invalid data values.
61 Versions before 0.31 may also have returned "Diner's Club/Carte Blanche" (these
62 cards are now recognized as "Discover card").
64 As of 0.30, cardtype() will accept a partial card masked with "x", "X', ".",
65 "*" or "_". Only the first 2-6 digits and the length are significant;
66 whitespace and dashes are removed. To recognize just Visa, MasterCard and
67 Amex, you only need the first two digits; to recognize almost all cards
68 except some Switch cards, you need the first four digits, and to recognize
69 all cards including the remaining Switch cards, you need the first six
72 The generate_last_digit() subroutine computes and returns the last
73 digit of the card given the preceding digits. With a 16-digit card,
74 you provide the first 15 digits; the subroutine returns the sixteenth.
76 This module does I<not> tell you whether the number is on an actual
77 card, only whether it might conceivably be on a real card. To verify
78 whether a card is real, or whether it's been stolen, or to actually process
79 charges, you need a Merchant account. See L<Business::OnlinePayment>.
81 These subroutines will also work if you provide the arguments
82 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
84 =head1 PROCESSING AGREEMENTS
86 Credit card issuers have recently been forming agreements to process cards on
87 other networks, in which one type of card is processed as another card type.
89 By default, Business::CreditCard returns the type the card should be treated as
90 in the US. You can change this to return the type the card should
91 be treated as in a different country by setting
92 C<$Business::CreditCard::Country> to your two-letter country code. This
93 is probably what you want to determine if you accept the card, or which
94 merchant agreement it is processed through.
96 You can also set C<$Business::CreditCard::Country> to a false value such
97 as the empty string to return the "base" card type. This is probably only
98 useful for informational purposes when used along with the default type.
100 Here are the currently known agreements:
104 =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.)
106 =item JCB cards in the 3528-3589 range are identified as Discover inside the US and territories.
108 =item China Union Pay cards are identified as Discover cards in the US, Mexico and most Caribbean countries.
112 =head1 RECEIPT REQUIREMENTS
114 Discover requires some cards processed on its network to display "PayPal"
115 on receipts instead of "Discover". The receipt_cardtype() subroutine will
116 return "PayPal card" for these cards only, and otherwise the same output as
119 Use this for receipt display/printing only.
121 Note: this subroutine is not exported by default like the others.
122 Before 0.36, you needed to call this subroutine fully-qualified, as
123 Business::CreditCard::receipt_cardtype()
125 In 0.36 and later, you can import it into your namespace:
127 use Business::CreditCard qw( :DEFAULT receipt_cardtype );
130 =head1 ORIGINAL AUTHOR
134 The Perl Journal and MIT Media Lab
138 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
140 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
141 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
142 types. Lee also contributed a working test.pl. Alexandr Ciornii
143 <alexchorny@gmail.com> contributed code cleanups. Jason Terry
144 <jterry@bluehost.com> contributed updates for Discover BIN ranges.
146 =head1 COPYRIGHT AND LICENSE
148 Copyright (C) 1995,1996,1997 Jon Orwant
149 Copyright (C) 2001-2006 Ivan Kohler
150 Copyright (C) 2007-2016 Freeside Internet Services, Inc.
152 This library is free software; you can redistribute it and/or modify
153 it under the same terms as Perl itself, either Perl version 5.8.8 or,
154 at your option, any later version of Perl 5 you may have available.
158 (paraphrasing Neil Bowers) We export all functions by default. It would be
159 better to let the user decide which functions to import. And validate() is
160 a bit of a generic name.
162 The question is, after almost 2 decades with this interface (inherited from
163 the original author, who probably never expected it to live half this long),
164 how to change things to behave in a more modern fashion without breaking
165 existing code? "use Business::CreditCard <some_minimum_version>" turns it off?
166 Explicitly ask to turn it off and list that in the SYNOPSIS?
168 =head2 validate() and @EXPORT transition plan
170 First (done in 0.36):
172 validate_card() is the new name for validate(). Both work for now.
174 New-style usage (not recommended for code that needs to support B:CC before 0.36):
176 use Business::CreditCard qw( :NEW );
178 You get validate_card(), cardtype() and receipt_cardtype(). You can also ask
179 for them explicitly / individually:
181 use Business::CreditCard qw( validate_card cardtype receipt_cardtype );
184 Second (we're at now now):
186 Waiting for 0.36+ to become more prevalent.
191 Recommend new-style usage.
195 (this is the incompatible part):
197 Don't export validate() (or anything else [separately?]) by default.
199 This is the part that will break things and we probably won't do for a long
200 time, until new-style usage is the norm and the tradeoff of breaking old code
201 is worth it to stop or namespace pollution.
205 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
206 providing an OO interface. Assistance integrating this into the base
207 Business::CreditCard distribution is welcome.
209 L<Business::OnlinePayment> is a framework for processing online payments
210 including modules for various payment gateways.
212 http://neilb.org/reviews/luhn.html is an excellent overview of similar modules
213 providing credit card number verification (LUHN checking).
217 ## ref http://neilb.org/reviews/luhn.html#Comparison it looks like
218 ## Business::CCCheck is 2x faster than we are. looking at their implementation
219 ## not entirely a fair comparison, we also do the equivalent of their CC_clean,
220 ## they don't recognize certain cards at all (i.e. Switch) which require
221 ## an expensive check before VISA, Diners doesn't exist anymore, Discover is
222 ## a lot more than just 6011*, they don't handle processing agreements, etc.
225 # Allow use as a class method
226 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
230 $number =~ s/[\s\-]//go;
231 $number =~ s/[x\*\.\_]/x/gio;
233 return "Not a credit card" if $number =~ /[^\dx]/io;
237 local $^W=0; #no warning at next line
238 return "Not a credit card"
239 unless ( length($number) >= 13
240 || length($number) == 8 || length($number) == 9 #Isracard
245 return "VISA card" if $number =~ /^4[0-8][\dx]{11,17}$/o;
248 if $number =~ /^5[1-5][\dx]{14}$/o
249 || $number =~ /^2 ( 22[1-9] | 2[3-9][\dx] | [3-6][\dx]{2} | 7[0-1][\dx] | 720 ) [\dx]{12}$/xo
250 || $number =~ /^2[2-7]xx[\dx]{12}$/o;
252 return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
254 return "Discover card"
255 if $number =~ /^30[0-5][\dx]{13,16}$/o #diner's: 300-305
256 || $number =~ /^3095[\dx]{12}$/o #diner's: 3095
257 || $number =~ /^36[\dx]{12,17}$/o #diner's: 36
258 || $number =~ /^3[89][\dx]{14,17}$/o #diner's: 38 and 39
259 || $number =~ /^6011[\dx]{12,15}$/o
260 || $number =~ /^64[4-9][\dx]{13,16}$/o
261 || $number =~ /^65[\dx]{14,17}$/o
262 || ( $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
263 || ( $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
266 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
267 || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
268 || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
269 #redunant with above, catch 49* that's not Switch
270 return "VISA card" if $number =~ /^4[\dx]{12,18}$/o;
272 #return "Diner's Club/Carte Blanche"
273 # if $number =~ /^3(0[0-59]|[68][\dx])[\dx]{11}$/o;
275 #"Diners Club enRoute"
276 return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
278 return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
280 return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
283 if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
285 return "China Union Pay"
286 if $number =~ /^62[24-68][\dx]{13}$/o;
289 if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
292 if $number =~ /^[\dx]{8,9}$/;
297 sub receipt_cardtype {
298 # Allow use as a class method
299 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
303 $number =~ s/[\s\-]//go;
304 $number =~ s/[x\*\.\_]/x/gio;
306 #ref Discover IIN Bulletin Feb 2015_021715
307 return "PayPal card" if $number =~ /^6(01104|506[01]0)[\dx]{10,13}$/o;
312 sub generate_last_digit {
313 # Allow use as a class method
314 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
318 die "invalid operation" if length($number) == 8 || length($number) == 9;
320 my ($i, $sum, $weight);
324 for ($i = 0; $i < length($number); $i++) {
325 $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
326 $sum += (($weight < 10) ? $weight : ($weight - 9));
329 return (10 - $sum % 10) % 10;
333 ## this (GPLed) code from Business::CCCheck is apparantly 4x faster than ours
334 ## ref http://neilb.org/reviews/luhn.html#Comparison
335 ## maybe see if we can speed ours up a bit
336 # my @ccn = split('',$ccn);
339 # for($i=$#ccn;$i >=0;--$i) {
340 # $ccn[$i] *= 2 if $even;
341 # $ccn -= 9 if $ccn[$i] > 9;
345 # $type = '' if $ccn % 10;
348 sub validate { validate_card(@_); }
351 # Allow use as a class method
352 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
356 my ($i, $sum, $weight);
358 return 0 if $number =~ /[^\d\s]/;
362 if ( $number =~ /^[\dx]{8,9}$/ ) { # Isracard
363 $number = "0$number" if length($number) == 8;
364 for($i=1;$i<length($number);$i++){
365 $sum += substr($number,9-$i,1) * $i;
367 return 1 if $sum%11 == 0;
371 return 0 unless length($number) >= 13 && 0+$number;
373 for ($i = 0; $i < length($number) - 1; $i++) {
374 $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
375 $sum += (($weight < 10) ? $weight : ($weight - 9));
378 return 1 if substr($number, -1) == (10 - $sum % 10) % 10;