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:
45 Diner's Club/Carte Blanche
55 "Not a credit card" is returned on obviously invalid data values.
57 As of 0.30, cardtype() will accept a partial card masked with "x", "X', ".",
58 "*" or "_". Only the first 2-6 digits and the lenth are significant;
59 whitespace and dashes are removed. To recognize just Visa, MasterCard and
60 Amex, you only need the first two digits; to recognize almost all cards
61 except some Switch cards, you need the first four digits, and to recognize
62 all cards including the remaining Switch cards, you need the first six
65 The generate_last_digit() subroutine computes and returns the last
66 digit of the card given the preceding digits. With a 16-digit card,
67 you provide the first 15 digits; the subroutine returns the sixteenth.
69 This module does I<not> tell you whether the number is on an actual
70 card, only whether it might conceivably be on a real card. To verify
71 whether a card is real, or whether it's been stolen, or to actually process
72 charges, you need a Merchant account. See L<Business::OnlinePayment>.
74 These subroutines will also work if you provide the arguments
75 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
77 =head1 CHANGES IN 0.30
79 Credit card issuers have recently been forming agreements to process cards on
80 other networks, in which one type of card is processed as another card type.
82 By default, Business::CreditCard returns the type the card should be treated as
83 in the US and Canada. You can change this to return the type the card should
84 be treated as in a different country by setting
85 C<$Business::OnlinePayment::Country> to your two-letter country code. This
86 is probably what you want to determine if you accept the card, or which
87 merchant agreement it is processed through.
89 You can also set C<$Business::OnlinePayment::Country> to a false value such
90 as the empty string to return the "base" card type. This is probably only
91 useful for informational purposes when used along with the default type.
93 Here are the currently known agreements:
97 =item Diner's club cards (starting with 36) are now identified as "MasterCard" inside the US and Canada.
99 =item China Union Pay cards are identified as Discover cards outside China.
109 The Perl Journal and MIT Media Lab
113 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
114 Please don't bother Jon with emails about this module.
116 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
117 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
118 types. Lee also contributed a working test.pl.
120 =head1 COPYRIGHT AND LICENSE
122 Copyright (C) 1995,1996,1997 Jon Orwant
123 Copyright (C) 2001-2006 Ivan Kohler
124 Copyright (C) 2007 Freeside Internet Services, Inc.
126 This library is free software; you can redistribute it and/or modify
127 it under the same terms as Perl itself, either Perl version 5.8.8 or,
128 at your option, any later version of Perl 5 you may have available.
132 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
133 providing an OO interface. Assistance integrating this into the base
134 Business::CreditCard distribution is welcome.
136 L<Business::OnlinePayment> is a framework for processing online payments
137 including modules for various payment gateways.
141 @EXPORT = qw(cardtype validate generate_last_digit);
146 $number =~ s/[\s\-]//go;
147 $number =~ s/[x\*\.\_]/x/gio;
149 return "Not a credit card" if $number =~ /[^\dx]/io;
153 return "Not a credit card" unless length($number) >= 13 && 0+$number;
156 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
157 || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
158 || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
160 return "VISA card" if $number =~ /^4[\dx]{12}([\dx]{3})?$/o;
163 if $number =~ /^5[1-5][\dx]{14}$/o
164 || ( $number =~ /^36[\dx]{12}/ && $Country =~ /^(US|CA)$/oi );
166 return "Discover card"
167 if $number =~ /^6011[\dx]{12}$/o
168 || $number =~ /^65[\dx]{14}$/o
169 || ( $number =~ /^622[\dx]{13}$/o && $Country !~ /^(CN)$/oi );
171 return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
173 return "Diner's Club/Carte Blanche"
174 if $number =~ /^3(0[0-5]|[68][\dx])[\dx]{11}$/o;
176 return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
178 return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
180 return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
183 if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
185 return "China Union Pay"
186 if $number =~ /^622[\dx]{13}$/o;
189 if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
194 sub generate_last_digit {
196 my ($i, $sum, $weight);
200 for ($i = 0; $i < length($number); $i++) {
201 $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
202 $sum += (($weight < 10) ? $weight : ($weight - 9));
205 return (10 - $sum % 10) % 10;
210 my ($i, $sum, $weight);
212 return 0 if $number =~ /[^\d\s]/;
216 return 0 unless length($number) >= 13 && 0+$number;
218 for ($i = 0; $i < length($number) - 1; $i++) {
219 $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
220 $sum += (($weight < 10) ? $weight : ($weight - 9));
223 return 1 if substr($number, -1) == (10 - $sum % 10) % 10;