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
23 # new-style, supported since 0.36 released Jun 14 2016
26 use Business::CreditCard qw( 0.36 :NEW );
28 print validate_card("5276 4400 6542 1319");
29 print cardtype("5276 4400 6542 1319");
33 # old interface, deprecated but still supported for backwards compatibility
36 use Business::CreditCard;
38 print validate("5276 4400 6542 1319");
39 print cardtype("5276 4400 6542 1319");
42 Business::CreditCard is available at a CPAN site near you.
46 These subroutines tell you whether a credit card number is
47 self-consistent -- whether the last digit of the number is a valid
48 checksum for the preceding digits.
50 The validate_card() subroutine returns 1 if the card number provided passes
51 the checksum test, and 0 otherwise.
53 The cardtype() subroutine returns a string containing the type of
54 card. The list of possible return values is more comprehensive than it used
55 to be, but additions are still most welcome.
57 Possible return values are:
73 "Not a credit card" is returned on obviously invalid data values.
75 Versions before 0.31 may also have returned "Diner's Club/Carte Blanche" (these
76 cards are now recognized as "Discover card").
78 cardtype() will accept a partial card masked with "x", "X", ".",
79 "*" or "_". Only the first 2-6 digits and the length are significant;
80 whitespace and dashes are removed. With two digits, Visa, MasterCard, Discover
81 and Amex are recognized (versions before 0.36 needed four digits to recognize
82 all Discover cards). With four digits, almost all cards except some
83 Switch cards are recognized. With six digits (the full "BIN" or "IIN"), all
84 cards are recognized. Six digits are also required for receipt_cardtype().
86 The generate_last_digit() subroutine computes and returns the last
87 digit of the card given the preceding digits. With a 16-digit card,
88 you provide the first 15 digits; the subroutine returns the sixteenth.
90 This module does I<not> tell you whether the number is on an actual
91 card, only whether it might conceivably be on a real card. To verify
92 whether a card is real, or whether it's been stolen, or to actually process
93 charges, you need a Merchant account. See L<Business::OnlinePayment>.
95 These subroutines will also work if you provide the arguments
96 as numbers instead of strings, e.g. C<validate_card(5276440065421319)>.
98 =head1 PROCESSING AGREEMENTS
100 Credit card issuers have recently been forming agreements to process cards on
101 other networks, in which one type of card is processed as another card type.
103 By default, Business::CreditCard returns the type the card should be treated as
104 in the US. You can change this to return the type the card should
105 be treated as in a different country by setting
106 C<$Business::CreditCard::Country> to your two-letter country code. This
107 is probably what you want to determine if you accept the card, or which
108 merchant agreement it is processed through.
110 You can also set C<$Business::CreditCard::Country> to a false value such
111 as the empty string to return the "base" card type. This is probably only
112 useful for informational purposes when used along with the default type.
114 Here are the currently known agreements:
118 =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.)
120 =item JCB cards in the 3528-3589 range are identified as Discover inside the US and territories.
122 =item China Union Pay cards are identified as Discover cards in the US, Mexico and most Caribbean countries.
126 =head1 RECEIPT REQUIREMENTS
128 Discover requires some cards processed on its network to display "PayPal"
129 on receipts instead of "Discover". The receipt_cardtype() subroutine will
130 return "PayPal card" for these cards only, and otherwise the same output as
133 Use this for receipt display/printing only.
135 Note: this subroutine is not exported by default like the others.
136 Before 0.36, you needed to call this subroutine fully-qualified, as
137 Business::CreditCard::receipt_cardtype()
139 In 0.36 and later, you can import it into your namespace:
141 use Business::CreditCard qw( :DEFAULT receipt_cardtype );
144 =head1 ORIGINAL AUTHOR
148 The Perl Journal and MIT Media Lab
152 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
154 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
155 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
156 types. Lee also contributed a working test.pl. Alexandr Ciornii
157 <alexchorny@gmail.com> contributed code cleanups. Jason Terry
158 <jterry@bluehost.com> contributed updates for Discover BIN ranges.
160 =head1 COPYRIGHT AND LICENSE
162 Copyright (C) 1995,1996,1997 Jon Orwant
163 Copyright (C) 2001-2006 Ivan Kohler
164 Copyright (C) 2007-2021 Freeside Internet Services, Inc.
166 This library is free software; you can redistribute it and/or modify
167 it under the same terms as Perl itself, either Perl version 5.8.8 or,
168 at your option, any later version of Perl 5 you may have available.
172 Homepage: http://perl.business/creditcard
176 The code is available from our public git repository:
178 git clone git://git.freeside.biz/Business-CreditCard.git
182 http://freeside.biz/gitweb/?p=Business-CreditCard.git
184 http://freeside.biz/gitlist/Business-CreditCard.git
188 (paraphrasing Neil Bowers) We export all functions by default. It would be
189 better to let the user decide which functions to import. And validate() is
190 a bit of a generic name.
192 The question is, after almost 2 decades with this interface (inherited from
193 the original author, who probably never expected it to live half this long),
194 how to change things to behave in a more modern fashion without breaking
195 existing code? "use Business::CreditCard <some_minimum_version>" turns it off?
196 Explicitly ask to turn it off and list that in the SYNOPSIS?
198 =head2 validate() and @EXPORT transition plan
200 First (done in 0.36):
202 validate_card() is the new name for validate(). Both work for now.
204 New-style usage (not recommended for code that needs to support B:CC before 0.36):
206 use Business::CreditCard qw( :NEW );
208 You get validate_card(), cardtype() and receipt_cardtype(). You can also ask
209 for them explicitly / individually:
211 use Business::CreditCard qw( validate_card cardtype receipt_cardtype );
216 Waiting for 0.36+ to become more prevalent.
219 Third (we're at now now):
221 Recommend new-style usage. Maybe asking for a specific minimum version turns
226 (this is the incompatible part):
228 Don't export validate() (or anything else [separately?]) by default.
230 This is the part that will break things and we probably won't do for a long
231 time, until new-style usage is the norm and the tradeoff of breaking old code
232 is worth it to stop our namespace pollution. Maybe do a 1.00 release with the
233 current API and 2.00 is when this happens (with a 1.99_01 pre-release)?
237 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
238 providing an OO interface. Assistance integrating this into the base
239 Business::CreditCard distribution is welcome.
241 L<Business::OnlinePayment> is a framework for processing online payments
242 including modules for various payment gateways.
244 http://neilb.org/reviews/luhn.html is an excellent overview of similar modules
245 providing credit card number verification (LUHN checking).
249 ## ref http://neilb.org/reviews/luhn.html#Comparison it looks like
250 ## Business::CCCheck is 2x faster than we are. looking at their implementation
251 ## not entirely a fair comparison, we also do the equivalent of their CC_clean,
252 ## they don't recognize certain cards at all (i.e. Switch) which require
253 ## an expensive check before VISA, Diners doesn't exist anymore, Discover is
254 ## a lot more than just 6011*, they don't handle processing agreements, etc.
257 # Allow use as a class method
258 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
262 $number =~ s/[\s\-]//go;
263 $number =~ s/[x\*\.\_]/x/gio;
265 return "Not a credit card" if $number =~ /[^\dx]/io;
269 local $^W=0; #no warning at next line
270 return "Not a credit card"
271 unless ( length($number) >= 13
272 || length($number) == 8 || length($number) == 9 #Isracard
277 return "VISA card" if $number =~ /^4[0-8][\dx]{11,17}$/o;
280 if $number =~ /^5[1-5][\dx]{14}$/o
281 || $number =~ /^2 ( 22[1-9] | 2[3-9][\dx] | [3-6][\dx]{2} | 7[0-1][\dx] | 720 ) [\dx]{12}$/xo
282 || $number =~ /^2[2-7]xx[\dx]{12}$/o;
284 return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
286 return "Discover card"
287 if $number =~ /^30[0-5x][\dx]{13,16}$/o #diner's: 300-305, 30x
288 || $number =~ /^309[5x][\dx]{12}$/o # 3095, 309x
289 || $number =~ /^36[\dx]{12,17}$/o # 36
290 || $number =~ /^3[89][\dx]{14,17}$/o # 38 and 39
291 || $number =~ /^60[1x]{2}[\dx]{12,15}$/o #discover: 6011 601x 60xx
292 || $number =~ /^64[4-9x][\dx]{13,16}$/o # 644-649, 64x
293 || $number =~ /^65[\dx]{14,17}$/o # 65
294 || ( $number =~ /^62[24-68x][\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
295 || ( $number =~ /^35(2[89x]|[3-8][\dx]|xx)[\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
298 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
299 || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
300 || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
301 #redunant with above, catch 49* that's not Switch
302 return "VISA card" if $number =~ /^4[\dx]{12,18}$/o;
304 #"Diners Club enRoute"
305 return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
307 return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
309 return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
312 if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
314 return "China Union Pay"
315 if $number =~ /^62[24-68][\dx]{13}$/o;
318 if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
321 if $number =~ /^[\dx]{8,9}$/;
326 sub receipt_cardtype {
327 # Allow use as a class method
328 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
332 $number =~ s/[\s\-]//go;
333 $number =~ s/[x\*\.\_]/x/gio;
335 #ref Discover IIN Bulletin Feb 2015_021715
336 return "PayPal card" if $number =~ /^6(01104|506[01]0)[\dx]{10,13}$/o;
341 sub generate_last_digit {
342 # Allow use as a class method
343 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
347 die "invalid operation" if length($number) == 8 || length($number) == 9;
349 my ($i, $sum, $weight);
353 for ($i = 0; $i < length($number); $i++) {
354 $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
355 $sum += (($weight < 10) ? $weight : ($weight - 9));
358 return (10 - $sum % 10) % 10;
362 ## this (GPLed) code from Business::CCCheck is apparantly 4x faster than ours
363 ## ref http://neilb.org/reviews/luhn.html#Comparison
364 ## maybe see if we can speed ours up a bit
365 # my @ccn = split('',$ccn);
368 # for($i=$#ccn;$i >=0;--$i) {
369 # $ccn[$i] *= 2 if $even;
370 # $ccn -= 9 if $ccn[$i] > 9;
374 # $type = '' if $ccn % 10;
377 sub validate { validate_card(@_); }
380 # Allow use as a class method
381 shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
385 my ($i, $sum, $weight);
387 return 0 if $number =~ /[^\d\s]/;
391 if ( $number =~ /^[\dx]{8,9}$/ ) { # Isracard
392 $number = "0$number" if length($number) == 8;
393 for($i=1;$i<length($number);$i++){
394 $sum += substr($number,9-$i,1) * $i;
396 return 1 if $sum%11 == 0;
400 return 0 unless length($number) >= 13 && 0+$number;
402 for ($i = 0; $i < length($number) - 1; $i++) {
403 $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
404 $sum += (($weight < 10) ? $weight : ($weight - 9));
407 return 1 if substr($number, -1) == (10 - $sum % 10) % 10;