CreditCard.pm

   1 package Business::CreditCard;
   2
   3 require Exporter;
   4 use vars qw( @ISA $VERSION $Country );
   5
   6 @ISA = qw( Exporter );
   7
   8 $VERSION = "0.31";
   9
  10 $Country = 'US';
  11
  12 =head1 NAME
  13
  14 C<Business::CreditCard> - Validate/generate credit card checksums/names
  15
  16 =head1 SYNOPSIS
  17
  18     use Business::CreditCard;
  19
  20     print validate("5276 4400 6542 1319");
  21     print cardtype("5276 4400 6542 1319");
  22     print generate_last_digit("5276 4400 6542 131");
  23
  24 Business::CreditCard is available at a CPAN site near you.
  25
  26 =head1 DESCRIPTION
  27
  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.
  31
  32 The validate() subroutine returns 1 if the card number provided passes
  33 the checksum test, and 0 otherwise.
  34
  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.
  38
  39 Possible return values are:
  40
  41   VISA card
  42   MasterCard
  43   Discover card
  44   American Express card
  45   Diner's Club/Carte Blanche
  46   enRoute
  47   JCB
  48   BankCard
  49   Switch
  50   Solo
  51   China Union Pay
  52   Laser
  53   Unknown
  54
  55 "Not a credit card" is returned on obviously invalid data values.
  56
  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
  63 digits.
  64
  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.
  68
  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>.
  73
  74 These subroutines will also work if you provide the arguments
  75 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
  76
  77 =head1 CHANGES IN 0.30
  78
  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.
  81
  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.
  88
  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.
  92
  93 Here are the currently known agreements:
  94
  95 =over 4
  96
  97 =item Diner's club cards (starting with 36) are now identified as "MasterCard" inside the US and Canada.
  98
  99 =item China Union Pay cards are identified as Discover cards outside China.
 100
 101 =back
 102
 103 =head1 NOTE ON INTENDED PURPOSE
 104
 105 This module is for verifying I<real world> B<credit cards>.  It is B<NOT> a
 106 pedantic implementation of the ISO 7812 standard, a general-purpose LUHN
 107 implementation, or intended for use with "creditcard-like account numbers".
 108
 109 =head1 AUTHOR
 110
 111 Jon Orwant
 112
 113 The Perl Journal and MIT Media Lab
 114
 115 orwant@tpj.com
 116
 117 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
 118 Please don't bother Jon with emails about this module.
 119
 120 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
 121 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
 122 types.  Lee also contributed a working test.pl.
 123
 124 =head1 COPYRIGHT AND LICENSE
 125
 126 Copyright (C) 1995,1996,1997 Jon Orwant
 127 Copyright (C) 2001-2006 Ivan Kohler
 128 Copyright (C) 2007 Freeside Internet Services, Inc.
 129
 130 This library is free software; you can redistribute it and/or modify
 131 it under the same terms as Perl itself, either Perl version 5.8.8 or,
 132 at your option, any later version of Perl 5 you may have available.
 133
 134 =head1 SEE ALSO
 135
 136 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
 137 providing an OO interface.  Assistance integrating this into the base
 138 Business::CreditCard distribution is welcome.
 139
 140 L<Business::OnlinePayment> is a framework for processing online payments
 141 including modules for various payment gateways.
 142
 143 =cut
 144
 145 @EXPORT = qw(cardtype validate generate_last_digit);
 146
 147 sub cardtype {
 148     my ($number) = @_;
 149
 150     $number =~ s/[\s\-]//go;
 151     $number =~ s/[x\*\.\_]/x/gio;
 152
 153     return "Not a credit card" if $number =~ /[^\dx]/io;
 154
 155     #$number =~ s/\D//g;
 156
 157     return "Not a credit card" unless length($number) >= 13 && 0+$number;
 158
 159     return "Switch"
 160       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
 161       || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
 162       || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 163
 164     return "VISA card" if $number =~ /^4[\dx]{12}([\dx]{3})?$/o;
 165
 166     return "MasterCard"
 167       if   $number =~ /^5[1-5][\dx]{14}$/o
 168       || ( $number =~ /^36[\dx]{12}/ && $Country =~ /^(US|CA)$/oi );
 169
 170     return "Discover card"
 171       if   $number =~ /^6011[\dx]{12}$/o
 172       ||   $number =~ /^65[\dx]{14}$/o
 173       || ( $number =~ /^622[\dx]{13}$/o && $Country !~ /^(CN)$/oi );
 174
 175     return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
 176
 177     return "Diner's Club/Carte Blanche"
 178       if $number =~ /^3(0[0-5]|[68][\dx])[\dx]{11}$/o;
 179
 180     return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
 181
 182     return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
 183
 184     return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
 185
 186     return "Solo"
 187       if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 188
 189     return "China Union Pay"
 190       if $number =~ /^622[\dx]{13}$/o;
 191
 192     return "Laser"
 193       if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
 194
 195     return "Unknown";
 196 }
 197
 198 sub generate_last_digit {
 199     my ($number) = @_;
 200     my ($i, $sum, $weight);
 201
 202     $number =~ s/\D//g;
 203
 204     for ($i = 0; $i < length($number); $i++) {
 205         $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
 206         $sum += (($weight < 10) ? $weight : ($weight - 9));
 207     }
 208
 209     return (10 - $sum % 10) % 10;
 210 }
 211
 212 sub validate {
 213     my ($number) = @_;
 214     my ($i, $sum, $weight);
 215
 216     return 0 if $number =~ /[^\d\s]/;
 217
 218     $number =~ s/\D//g;
 219
 220     return 0 unless length($number) >= 13 && 0+$number;
 221
 222     for ($i = 0; $i < length($number) - 1; $i++) {
 223         $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
 224         $sum += (($weight < 10) ? $weight : ($weight - 9));
 225     }
 226
 227     return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
 228     return 0;
 229 }
 230
 231 1;
 232
 233