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   enRoute
  46   JCB
  47   BankCard
  48   Switch
  49   Solo
  50   China Union Pay
  51   Laser
  52   Unknown
  53
  54 "Not a credit card" is returned on obviously invalid data values.
  55
  56 Versions before 0.31 may also have returned "Diner's Club/Carte Blanche" (these
  57 cards are now recognized as "Discover card").
  58
  59 As of 0.30, cardtype() will accept a partial card masked with "x", "X', ".",
  60 "*" or "_".  Only the first 2-6 digits and the length are significant;
  61 whitespace and dashes are removed.  To recognize just Visa, MasterCard and
  62 Amex, you only need the first two digits; to recognize almost all cards
  63 except some Switch cards, you need the first four digits, and to recognize
  64 all cards including the remaining Switch cards, you need the first six
  65 digits.
  66
  67 The generate_last_digit() subroutine computes and returns the last
  68 digit of the card given the preceding digits.  With a 16-digit card,
  69 you provide the first 15 digits; the subroutine returns the sixteenth.
  70
  71 This module does I<not> tell you whether the number is on an actual
  72 card, only whether it might conceivably be on a real card.  To verify
  73 whether a card is real, or whether it's been stolen, or to actually process
  74 charges, you need a Merchant account.  See L<Business::OnlinePayment>.
  75
  76 These subroutines will also work if you provide the arguments
  77 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
  78
  79 =head1 PROCESSING AGREEMENTS
  80
  81 Credit card issuers have recently been forming agreements to process cards on
  82 other networks, in which one type of card is processed as another card type.
  83
  84 By default, Business::CreditCard returns the type the card should be treated as
  85 in the US and Canada.  You can change this to return the type the card should
  86 be treated as in a different country by setting
  87 C<$Business::CreditCard::Country> to your two-letter country code.  This
  88 is probably what you want to determine if you accept the card, or which
  89 merchant agreement it is processed through.
  90
  91 You can also set C<$Business::CreditCard::Country> to a false value such
  92 as the empty string to return the "base" card type.  This is probably only
  93 useful for informational purposes when used along with the default type.
  94
  95 Here are the currently known agreements:
  96
  97 =over 4
  98
  99 =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.)
 100
 101 =item JCB cards in the 3528-3589 range are identified as Discover inside the US and Canada.
 102
 103 =item China Union Pay cards are identified as Discover cards outside China.
 104
 105 =back
 106
 107 =head1 NOTE ON INTENDED PURPOSE
 108
 109 This module is for verifying I<real world> B<credit cards>.  It is B<NOT> a
 110 pedantic implementation of the ISO 7812 standard, a general-purpose LUHN
 111 implementation, or intended for use with "creditcard-like account numbers".
 112
 113 =head1 AUTHOR
 114
 115 Jon Orwant
 116
 117 The Perl Journal and MIT Media Lab
 118
 119 orwant@tpj.com
 120
 121 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
 122 Please don't bother Jon with emails about this module.
 123
 124 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
 125 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
 126 types.  Lee also contributed a working test.pl.  Alexandr Ciornii
 127 <alexchorny@gmail.com> contributed code cleanups.
 128
 129 =head1 COPYRIGHT AND LICENSE
 130
 131 Copyright (C) 1995,1996,1997 Jon Orwant
 132 Copyright (C) 2001-2006 Ivan Kohler
 133 Copyright (C) 2007-2009 Freeside Internet Services, Inc.
 134
 135 This library is free software; you can redistribute it and/or modify
 136 it under the same terms as Perl itself, either Perl version 5.8.8 or,
 137 at your option, any later version of Perl 5 you may have available.
 138
 139 =head1 SEE ALSO
 140
 141 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
 142 providing an OO interface.  Assistance integrating this into the base
 143 Business::CreditCard distribution is welcome.
 144
 145 L<Business::OnlinePayment> is a framework for processing online payments
 146 including modules for various payment gateways.
 147
 148 =cut
 149
 150 @EXPORT = qw(cardtype validate generate_last_digit);
 151
 152 sub cardtype {
 153     my ($number) = @_;
 154
 155     $number =~ s/[\s\-]//go;
 156     $number =~ s/[x\*\.\_]/x/gio;
 157
 158     return "Not a credit card" if $number =~ /[^\dx]/io;
 159
 160     #$number =~ s/\D//g;
 161     {
 162       local $^W=0; #no warning at next line
 163       return "Not a credit card" unless length($number) >= 13 && 0+$number;
 164     }
 165
 166     return "Switch"
 167       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
 168       || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
 169       || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 170
 171     return "VISA card" if $number =~ /^4[\dx]{12}([\dx]{3})?$/o;
 172
 173     return "MasterCard"
 174       if   $number =~ /^5[1-5][\dx]{14}$/o
 175       ;# || ( $number =~ /^36[\dx]{12}/ && $Country =~ /^(US|CA)$/oi );
 176
 177     return "Discover card"
 178       if   $number =~ /^30[0-5][\dx]{11}([\dx]{2})?$/o  #diner's: 300-305
 179       ||   $number =~ /^3095[\dx]{10}([\dx]{2})?$/o     #diner's: 3095
 180       ||   $number =~ /^3[68][\dx]{12}([\dx]{2})?$/o    #diner's: 36
 181       ||   $number =~ /^6011[\dx]{12}$/o
 182       ||   $number =~ /^64[4-9][\dx]{13}$/o
 183       ||   $number =~ /^65[\dx]{14}$/o
 184       || ( $number =~ /^62[24-68][\dx]{13}$/o && uc($Country) ne 'CN' ) #CUP
 185       || ( $number =~ /^35(2[89]|[3-8][\dx])[\dx]{10}$/o && uc($Country) eq 'US' );
 186
 187     return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
 188
 189     #return "Diner's Club/Carte Blanche"
 190     #  if $number =~ /^3(0[0-59]|[68][\dx])[\dx]{11}$/o;
 191
 192     #"Diners Club enRoute"
 193     return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
 194
 195     return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
 196
 197     return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
 198
 199     return "Solo"
 200       if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 201
 202     return "China Union Pay"
 203       if $number =~ /^62[24-68][\dx]{13}$/o;
 204
 205     return "Laser"
 206       if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
 207
 208     return "Unknown";
 209 }
 210
 211 sub generate_last_digit {
 212     my ($number) = @_;
 213     my ($i, $sum, $weight);
 214
 215     $number =~ s/\D//g;
 216
 217     for ($i = 0; $i < length($number); $i++) {
 218         $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
 219         $sum += (($weight < 10) ? $weight : ($weight - 9));
 220     }
 221
 222     return (10 - $sum % 10) % 10;
 223 }
 224
 225 sub validate {
 226     my ($number) = @_;
 227     my ($i, $sum, $weight);
 228
 229     return 0 if $number =~ /[^\d\s]/;
 230
 231     $number =~ s/\D//g;
 232
 233     return 0 unless length($number) >= 13 && 0+$number;
 234
 235     for ($i = 0; $i < length($number) - 1; $i++) {
 236         $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
 237         $sum += (($weight < 10) ? $weight : ($weight - 9));
 238     }
 239
 240     return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
 241     return 0;
 242 }
 243
 244 1;
 245
 246