1 package Business::CreditCard;
3 # Business::CreditCard.pm
5 # Jon Orwant, <orwant@media.mit.edu>
8 # 17 Jan 97 - 0.21 released.
9 # short numbers and numbers with letters are no longer kosher.
10 # 1 Feb 2001 - 0.22 released, new maintainer, MakeMaker installation
11 # 3 May 2001 - 0.23 released, silly bug in test.pl
12 # 11 Jun 2001 - 0.24. added enRoute, JCB, BankCard, rewrote with regexes
13 # 10 Jul 2001 - 0.25, 0.26 *sigh*
15 # Copyright 1995,1996,1997 Jon Orwant. All rights reserved.
16 # This program is free software; you can redistribute it and/or
17 # modify it under the same terms as Perl itself.
19 # Version 0.26. Module list status is "Rdpf."
24 use vars qw( @ISA $VERSION );
26 @ISA = qw( Exporter );
32 C<Business::CreditCard> - Validate/generate credit card checksums/names
36 use Business::CreditCard;
38 print validate("5276 4400 6542 1319");
39 print cardtype("5276 4400 6542 1319");
40 print generate_last_digit("5276 4400 6542 131");
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() 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: "MasterCard", "VISA", and so on. My list is not complete;
57 The generate_last_digit() subroutine computes and returns the last
58 digit of the card given the preceding digits. With a 16-digit card,
59 you provide the first 15 digits; the subroutine returns the sixteenth.
61 This module does I<not> tell you whether the number is on an actual
62 card, only whether it might conceivably be on a real card. To verify
63 whether a card is real, or whether it's been stolen, or what its
64 balance is, you need a Merchant ID, which gives you access to credit
65 card databases. The Perl Journal (http://tpj.com/tpj) has
66 a Merchant ID so that I can accept MasterCard and VISA payments; it
67 comes with the little pushbutton/slide-your-card-through device you've
68 seen in restaurants and stores. That device calculates the checksum
69 for you, so I don't actually use this module.
71 These subroutines will also work if you provide the arguments
72 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
78 The Perl Journal and MIT Media Lab
82 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
83 Please don't bother Jon with emails about this module.
85 Lee Lawrence <LeeL@aspin.co.uk> and Neale Banks <neale@lowendale.com.au>
86 contributed support for additional card types. Lee also contributed a working
91 @EXPORT = qw(cardtype validate generate_last_digit);
96 return "Not a credit card" if $number =~ /[^\d\s]/;
100 return "Not a credit card" unless length($number) >= 13 && 0+$number;
102 return "VISA card" if $number =~ /^4\d{12}(\d{3})?$/o;
103 return "MasterCard" if $number =~ /^5[1-5]\d{14}$/o;
104 return "Discover card" if $number =~ /^6011\d{12}$/o;
105 return "American Express card" if $number =~ /^3[47]\d{13}/o;
106 return "Diner's Club/Carte Blanche"
107 if $number =~ /^3(0[0-5]|[68]\d)\d{11}$/o;
108 return "enRoute" if $number =~ /^2(014|149)\d{11}$/o;
109 return "JCB" if $number =~ /^(3\d{4}|2131|1800)\d{11}$/o;
110 return "BankCard" if $number =~ /^56(10\d\d|022[1-5])\d{10}$/o;
114 # from http://perl.about.com/compute/perl/library/nosearch/P073000.htm
115 # verified by http://www.beachnet.com/~hstiles/cardtype.html
116 # Card Type Prefix Length
117 # MasterCard 51-55 16
119 # American Express (AMEX) 34, 37 15
120 # Diners Club/Carte Blanche 300-305, 36, 38 14
121 # enRoute 2014, 2149 15
126 # from Neale Banks <neale@lowendale.com.au>
127 # According to a booklet I have from Westpac (an Aussie bank), a card number
128 # starting with 5610 or 56022[1-5] is a BankCard
129 # BankCards have exactly 16 digits.
131 sub generate_last_digit {
133 my ($i, $sum, $weight);
137 for ($i = 0; $i < length($number); $i++) {
138 $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
139 $sum += (($weight < 10) ? $weight : ($weight - 9));
142 return (10 - $sum % 10) % 10;
147 my ($i, $sum, $weight);
149 return 0 if $number =~ /[^\d\s]/;
153 return 0 unless length($number) >= 13 && 0+$number;
155 for ($i = 0; $i < length($number) - 1; $i++) {
156 $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
157 $sum += (($weight < 10) ? $weight : ($weight - 9));
160 return 1 if substr($number, -1) == (10 - $sum % 10) % 10;