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.32_01";
   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   Isracard
  53   Unknown
  54
  55 "Not a credit card" is returned on obviously invalid data values.
  56
  57 Versions before 0.31 may also have returned "Diner's Club/Carte Blanche" (these
  58 cards are now recognized as "Discover card").
  59
  60 As of 0.30, cardtype() will accept a partial card masked with "x", "X', ".",
  61 "*" or "_".  Only the first 2-6 digits and the length are significant;
  62 whitespace and dashes are removed.  To recognize just Visa, MasterCard and
  63 Amex, you only need the first two digits; to recognize almost all cards
  64 except some Switch cards, you need the first four digits, and to recognize
  65 all cards including the remaining Switch cards, you need the first six
  66 digits.
  67
  68 The generate_last_digit() subroutine computes and returns the last
  69 digit of the card given the preceding digits.  With a 16-digit card,
  70 you provide the first 15 digits; the subroutine returns the sixteenth.
  71
  72 This module does I<not> tell you whether the number is on an actual
  73 card, only whether it might conceivably be on a real card.  To verify
  74 whether a card is real, or whether it's been stolen, or to actually process
  75 charges, you need a Merchant account.  See L<Business::OnlinePayment>.
  76
  77 These subroutines will also work if you provide the arguments
  78 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
  79
  80 =head1 PROCESSING AGREEMENTS
  81
  82 Credit card issuers have recently been forming agreements to process cards on
  83 other networks, in which one type of card is processed as another card type.
  84
  85 By default, Business::CreditCard returns the type the card should be treated as
  86 in the US and Canada.  You can change this to return the type the card should
  87 be treated as in a different country by setting
  88 C<$Business::CreditCard::Country> to your two-letter country code.  This
  89 is probably what you want to determine if you accept the card, or which
  90 merchant agreement it is processed through.
  91
  92 You can also set C<$Business::CreditCard::Country> to a false value such
  93 as the empty string to return the "base" card type.  This is probably only
  94 useful for informational purposes when used along with the default type.
  95
  96 Here are the currently known agreements:
  97
  98 =over 4
  99
 100 =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.)
 101
 102 =item JCB cards in the 3528-3589 range are identified as Discover inside the US and Canada.
 103
 104 =item China Union Pay cards are identified as Discover cards outside China.
 105
 106 =back
 107
 108 =head1 NOTE ON INTENDED PURPOSE
 109
 110 This module is for verifying I<real world> B<credit cards>.  It is B<NOT> a
 111 pedantic implementation of the ISO 7812 standard, a general-purpose LUHN
 112 implementation, or intended for use with "creditcard-like account numbers".
 113
 114 =head1 AUTHOR
 115
 116 Jon Orwant
 117
 118 The Perl Journal and MIT Media Lab
 119
 120 orwant@tpj.com
 121
 122 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
 123 Please don't bother Jon with emails about this module.
 124
 125 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
 126 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
 127 types.  Lee also contributed a working test.pl.  Alexandr Ciornii
 128 <alexchorny@gmail.com> contributed code cleanups.
 129
 130 =head1 COPYRIGHT AND LICENSE
 131
 132 Copyright (C) 1995,1996,1997 Jon Orwant
 133 Copyright (C) 2001-2006 Ivan Kohler
 134 Copyright (C) 2007-2012 Freeside Internet Services, Inc.
 135
 136 This library is free software; you can redistribute it and/or modify
 137 it under the same terms as Perl itself, either Perl version 5.8.8 or,
 138 at your option, any later version of Perl 5 you may have available.
 139
 140 =head1 BUGS
 141
 142 (paraphrasing Neil Bowers) We export all functions by default.  It would be
 143 better to let the user decide which functions to import.  And validate() is
 144 a bit of a generic name.
 145
 146 The question is, after almost 2 decades with this interface (inherited from
 147 the original author, who probably never expected it to live half this long),
 148 how to change things to behave in a more modern fashion without breaking
 149 existing code?  "use Business::CreditCard <some_minimum_version>" turns it off?
 150 Explicitly ask to turn it off and list that in the SYNOPSIS?
 151
 152 =head1 SEE ALSO
 153
 154 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
 155 providing an OO interface.  Assistance integrating this into the base
 156 Business::CreditCard distribution is welcome.
 157
 158 L<Business::OnlinePayment> is a framework for processing online payments
 159 including modules for various payment gateways.
 160
 161 http://neilb.org/reviews/luhn.html is an excellent overview of similar modules
 162 providing credit card number verification (LUHN checking).
 163
 164 =cut
 165
 166 @EXPORT = qw(cardtype validate generate_last_digit);
 167
 168 ## ref http://neilb.org/reviews/luhn.html#Comparison it looks like
 169 ## Business::CCCheck is 2x faster than we are.  looking at their implementation
 170 ## not entirely a fair comparison, we also do the equivalent of their CC_clean,
 171 ## they don't recognize certain cards at all (i.e. Switch) which require
 172 ## an expensive check before VISA, Diners doesn't exist anymore, Discover is
 173 ## a lot more than just 6011*, they don't handle processing agreements, etc.
 174
 175 sub cardtype {
 176     my ($number) = @_;
 177
 178     $number =~ s/[\s\-]//go;
 179     $number =~ s/[x\*\.\_]/x/gio;
 180
 181     return "Not a credit card" if $number =~ /[^\dx]/io;
 182
 183     #$number =~ s/\D//g;
 184     {
 185       local $^W=0; #no warning at next line
 186       return "Not a credit card"
 187         unless ( length($number) >= 13
 188                  || length($number) == 8 || length($number) == 9 #Isracard
 189                )
 190             && 0+$number;
 191     }
 192
 193     return "VISA card" if $number =~ /^4[0-8][\dx]{11}([\dx]{3})?$/o;
 194
 195     return "MasterCard"
 196       if   $number =~ /^5[1-5][\dx]{14}$/o
 197       ;# || ( $number =~ /^36[\dx]{12}/ && $Country =~ /^(US|CA)$/oi );
 198
 199     return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
 200
 201     return "Discover card"
 202       if   $number =~ /^30[0-5][\dx]{11}([\dx]{2})?$/o  #diner's: 300-305
 203       ||   $number =~ /^3095[\dx]{10}([\dx]{2})?$/o     #diner's: 3095
 204       ||   $number =~ /^3[68][\dx]{12}([\dx]{2})?$/o    #diner's: 36
 205       ||   $number =~ /^6011[\dx]{12}$/o
 206       ||   $number =~ /^64[4-9][\dx]{13}$/o
 207       ||   $number =~ /^65[\dx]{14}$/o
 208       || ( $number =~ /^62[24-68][\dx]{13}$/o && uc($Country) ne 'CN' ) #CUP
 209       || ( $number =~ /^35(2[89]|[3-8][\dx])[\dx]{10}$/o && uc($Country) eq 'US' );
 210
 211     return "Switch"
 212       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
 213       || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
 214       || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 215     #redunant with above, catch 49* that's not Switch
 216     return "VISA card" if $number =~ /^4[\dx]{12}([\dx]{3})?$/o;
 217
 218     #return "Diner's Club/Carte Blanche"
 219     #  if $number =~ /^3(0[0-59]|[68][\dx])[\dx]{11}$/o;
 220
 221     #"Diners Club enRoute"
 222     return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
 223
 224     return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
 225
 226     return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
 227
 228     return "Solo"
 229       if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 230
 231     return "China Union Pay"
 232       if $number =~ /^62[24-68][\dx]{13}$/o;
 233
 234     return "Laser"
 235       if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
 236
 237     return "Isracard"
 238       if $number =~ /^[\dx]{8,9}$/;
 239
 240     return "Unknown";
 241 }
 242
 243 sub generate_last_digit {
 244     my ($number) = @_;
 245
 246     die "invalid operation" if length($number) == 8 || length($number) == 9;
 247
 248     my ($i, $sum, $weight);
 249
 250     $number =~ s/\D//g;
 251
 252     for ($i = 0; $i < length($number); $i++) {
 253         $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
 254         $sum += (($weight < 10) ? $weight : ($weight - 9));
 255     }
 256
 257     return (10 - $sum % 10) % 10;
 258 }
 259
 260
 261 ## this (GPLed) code from Business::CCCheck is apparantly 4x faster than ours
 262 ## ref http://neilb.org/reviews/luhn.html#Comparison
 263 ## maybe see if we can spped ours up a bit
 264 #  my @ccn = split('',$ccn);
 265 #  my $even = 0;
 266 #  $ccn = 0;
 267 #  for($i=$#ccn;$i >=0;--$i) {
 268 #    $ccn[$i] *= 2 if $even;
 269 #    $ccn -= 9 if $ccn[$i] > 9;
 270 #    $ccn += $ccn[$i];
 271 #    $even = ! $even;
 272 #  }
 273 #  $type = '' if $ccn % 10;
 274 #  return $type;
 275 sub validate {
 276     my ($number) = @_;
 277
 278     my ($i, $sum, $weight);
 279
 280     return 0 if $number =~ /[^\d\s]/;
 281
 282     $number =~ s/\D//g;
 283
 284     if ( $number =~ /^[\dx]{8,9}$/ ) { # Isracard
 285         $number = "0$number" if length($number) == 8;
 286         for($i=1;$i<length($number);$i++){
 287             $sum += substr($number,9-$i,1) * $i;
 288         }
 289         return 1 if $sum%11 == 0;
 290         return 0;
 291     }
 292
 293     return 0 unless length($number) >= 13 && 0+$number;
 294
 295     for ($i = 0; $i < length($number) - 1; $i++) {
 296         $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
 297         $sum += (($weight < 10) ? $weight : ($weight - 9));
 298     }
 299
 300     return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
 301     return 0;
 302 }
 303
 304 1;
 305
 306