CreditCard.pm

   1 package Business::CreditCard;
   2
   3 require Exporter;
   4 use vars qw( @ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS $Country );
   5
   6 @ISA = qw( Exporter );
   7
   8 $VERSION = "0.37_01";
   9
  10 @EXPORT = qw( cardtype validate generate_last_digit );
  11 @EXPORT_OK = qw( receipt_cardtype validate_card );
  12 $EXPORT_TAGS{NEW} = [ qw( validate_card cardtype receipt_cardtype ) ];
  13
  14 $Country = 'US';
  15
  16 =head1 NAME
  17
  18 C<Business::CreditCard> - Validate/generate credit card checksums/names
  19
  20 =head1 SYNOPSIS
  21
  22     use Business::CreditCard;
  23
  24     print validate("5276 4400 6542 1319");
  25     print cardtype("5276 4400 6542 1319");
  26     print generate_last_digit("5276 4400 6542 131");
  27
  28 Business::CreditCard is available at a CPAN site near you.
  29
  30 =head1 DESCRIPTION
  31
  32 These subroutines tell you whether a credit card number is
  33 self-consistent -- whether the last digit of the number is a valid
  34 checksum for the preceding digits.
  35
  36 The validate() subroutine returns 1 if the card number provided passes
  37 the checksum test, and 0 otherwise.
  38
  39 The cardtype() subroutine returns a string containing the type of
  40 card.  The list of possible return values is more comprehensive than it used
  41 to be, but additions are still most welcome.
  42
  43 Possible return values are:
  44
  45   VISA card
  46   MasterCard
  47   Discover card
  48   American Express card
  49   enRoute
  50   JCB
  51   BankCard
  52   Switch
  53   Solo
  54   China Union Pay
  55   Laser
  56   Isracard
  57   Unknown
  58
  59 "Not a credit card" is returned on obviously invalid data values.
  60
  61 Versions before 0.31 may also have returned "Diner's Club/Carte Blanche" (these
  62 cards are now recognized as "Discover card").
  63
  64 As of 0.30, cardtype() will accept a partial card masked with "x", "X', ".",
  65 "*" or "_".  Only the first 2-6 digits and the length are significant;
  66 whitespace and dashes are removed.  With two digits, Visa, MasterCard, Discover
  67 and Amex are recognized (versions before 0.36 needed four digits to recognize
  68 all Discover cards).  With four digits, almost all cards except some
  69 Switch cards are recognized.  With six digits (the full "BIN" or "IIN"), all
  70 cards are recognized.  Six digits are also required for receipt_cardtype().
  71
  72 The generate_last_digit() subroutine computes and returns the last
  73 digit of the card given the preceding digits.  With a 16-digit card,
  74 you provide the first 15 digits; the subroutine returns the sixteenth.
  75
  76 This module does I<not> tell you whether the number is on an actual
  77 card, only whether it might conceivably be on a real card.  To verify
  78 whether a card is real, or whether it's been stolen, or to actually process
  79 charges, you need a Merchant account.  See L<Business::OnlinePayment>.
  80
  81 These subroutines will also work if you provide the arguments
  82 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
  83
  84 =head1 PROCESSING AGREEMENTS
  85
  86 Credit card issuers have recently been forming agreements to process cards on
  87 other networks, in which one type of card is processed as another card type.
  88
  89 By default, Business::CreditCard returns the type the card should be treated as
  90 in the US.  You can change this to return the type the card should
  91 be treated as in a different country by setting
  92 C<$Business::CreditCard::Country> to your two-letter country code.  This
  93 is probably what you want to determine if you accept the card, or which
  94 merchant agreement it is processed through.
  95
  96 You can also set C<$Business::CreditCard::Country> to a false value such
  97 as the empty string to return the "base" card type.  This is probably only
  98 useful for informational purposes when used along with the default type.
  99
 100 Here are the currently known agreements:
 101
 102 =over 4
 103
 104 =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.)
 105
 106 =item JCB cards in the 3528-3589 range are identified as Discover inside the US and territories.
 107
 108 =item China Union Pay cards are identified as Discover cards in the US, Mexico and most Caribbean countries.
 109
 110 =back
 111
 112 =head1 RECEIPT REQUIREMENTS
 113
 114 Discover requires some cards processed on its network to display "PayPal"
 115 on receipts instead of "Discover".  The receipt_cardtype() subroutine will
 116 return "PayPal card" for these cards only, and otherwise the same output as
 117 cardtype().
 118
 119 Use this for receipt display/printing only.
 120
 121 Note: this subroutine is not exported by default like the others.
 122 Before 0.36, you needed to call this subroutine fully-qualified, as
 123 Business::CreditCard::receipt_cardtype()
 124
 125 In 0.36 and later, you can import it into your namespace:
 126
 127   use Business::CreditCard qw( :DEFAULT receipt_cardtype );
 128
 129
 130 =head1 ORIGINAL AUTHOR
 131
 132 Jon Orwant
 133
 134 The Perl Journal and MIT Media Lab
 135
 136 =head1 MAINTAINER
 137
 138 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
 139
 140 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
 141 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
 142 types.  Lee also contributed a working test.pl.  Alexandr Ciornii
 143 <alexchorny@gmail.com> contributed code cleanups.  Jason Terry
 144 <jterry@bluehost.com> contributed updates for Discover BIN ranges.
 145
 146 =head1 COPYRIGHT AND LICENSE
 147
 148 Copyright (C) 1995,1996,1997 Jon Orwant
 149 Copyright (C) 2001-2006 Ivan Kohler
 150 Copyright (C) 2007-2016 Freeside Internet Services, Inc.
 151
 152 This library is free software; you can redistribute it and/or modify
 153 it under the same terms as Perl itself, either Perl version 5.8.8 or,
 154 at your option, any later version of Perl 5 you may have available.
 155
 156 =head1 HOMEPAGE
 157
 158 Homepage:  http://perl.business/creditcard
 159
 160 =head1 REPOSITORY
 161
 162 The code is available from our public git repository:
 163
 164   git clone git://git.freeside.biz/Business-CreditCard.git
 165
 166 Or on the web:
 167
 168   http://freeside.biz/gitweb/?p=Business-CreditCard.git
 169   Or:
 170   http://freeside.biz/gitlist/Business-CreditCard.git
 171
 172 =head1 BUGS
 173
 174 (paraphrasing Neil Bowers) We export all functions by default.  It would be
 175 better to let the user decide which functions to import.  And validate() is
 176 a bit of a generic name.
 177
 178 The question is, after almost 2 decades with this interface (inherited from
 179 the original author, who probably never expected it to live half this long),
 180 how to change things to behave in a more modern fashion without breaking
 181 existing code?  "use Business::CreditCard <some_minimum_version>" turns it off?
 182 Explicitly ask to turn it off and list that in the SYNOPSIS?
 183
 184 =head2 validate() and @EXPORT transition plan
 185
 186 First (done in 0.36):
 187
 188 validate_card() is the new name for validate().  Both work for now.
 189
 190 New-style usage (not recommended for code that needs to support B:CC before 0.36):
 191
 192   use Business::CreditCard qw( :NEW );
 193
 194 You get validate_card(), cardtype() and receipt_cardtype().  You can also ask
 195 for them explicitly / individually:
 196
 197   use Business::CreditCard qw( validate_card cardtype receipt_cardtype );
 198
 199
 200 Second (we're at now now):
 201
 202 Waiting for 0.36+ to become more prevalent.
 203
 204
 205 Third:
 206
 207 Recommend new-style usage.  Maybe asking for a specific minimum version turns
 208 it on too?
 209
 210
 211 Fourth:
 212  (this is the incompatible part):
 213
 214 Don't export validate() (or anything else [separately?]) by default.
 215
 216 This is the part that will break things and we probably won't do for a long
 217 time, until new-style usage is the norm and the tradeoff of breaking old code
 218 is worth it to stop or namespace pollution.  Maybe do a 1.00 releaes with the
 219 current API and 2.00 is when this happens (with a 1.99_01 pre-release)?
 220
 221 =head1 SEE ALSO
 222
 223 L<Business::CreditCard::Object> is a wrapper around Business::CreditCard
 224 providing an OO interface.  Assistance integrating this into the base
 225 Business::CreditCard distribution is welcome.
 226
 227 L<Business::OnlinePayment> is a framework for processing online payments
 228 including modules for various payment gateways.
 229
 230 http://neilb.org/reviews/luhn.html is an excellent overview of similar modules
 231 providing credit card number verification (LUHN checking).
 232
 233 =cut
 234
 235 ## ref http://neilb.org/reviews/luhn.html#Comparison it looks like
 236 ## Business::CCCheck is 2x faster than we are.  looking at their implementation
 237 ## not entirely a fair comparison, we also do the equivalent of their CC_clean,
 238 ## they don't recognize certain cards at all (i.e. Switch) which require
 239 ## an expensive check before VISA, Diners doesn't exist anymore, Discover is
 240 ## a lot more than just 6011*, they don't handle processing agreements, etc.
 241
 242 sub cardtype {
 243     # Allow use as a class method
 244     shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
 245
 246     my ($number) = @_;
 247
 248     $number =~ s/[\s\-]//go;
 249     $number =~ s/[x\*\.\_]/x/gio;
 250
 251     return "Not a credit card" if $number =~ /[^\dx]/io;
 252
 253     #$number =~ s/\D//g;
 254     {
 255       local $^W=0; #no warning at next line
 256       return "Not a credit card"
 257         unless ( length($number) >= 13
 258                  || length($number) == 8 || length($number) == 9 #Isracard
 259                )
 260             && 0+$number;
 261     }
 262
 263     return "VISA card" if $number =~ /^4[0-8][\dx]{11,17}$/o;
 264
 265     return "MasterCard"
 266       if $number =~ /^5[1-5][\dx]{14}$/o
 267       || $number =~ /^2 ( 22[1-9] | 2[3-9][\dx] | [3-6][\dx]{2} | 7[0-1][\dx] | 720 ) [\dx]{12}$/xo
 268       || $number =~ /^2[2-7]xx[\dx]{12}$/o;
 269
 270     return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
 271
 272     return "Discover card"
 273       if   $number =~ /^30[0-5x][\dx]{13,16}$/o  #diner's:  300-305, 30x
 274       ||   $number =~ /^309[5x][\dx]{12}$/o      #          3095, 309x
 275       ||   $number =~ /^36[\dx]{12,17}$/o        #          36
 276       ||   $number =~ /^3[89][\dx]{14,17}$/o     #          38 and 39
 277       ||   $number =~ /^60[1x]{2}[\dx]{12,15}$/o #discover: 6011 601x 60xx
 278       ||   $number =~ /^64[4-9x][\dx]{13,16}$/o  #          644-649, 64x
 279       ||   $number =~ /^65[\dx]{14,17}$/o        #          65
 280       || ( $number =~ /^62[24-68x][\dx]{13,16}$/o && $Country =~ /^(US|MX|AI|AG|AW|BS|BB|BM|BQ|VG|KY|CW|DM|DO|GD|GP|JM|MQ|MS|BL|KN|LC|VC|MF|SX|TT|TC)$/oi ) #China Union Pay identified as Discover in US, Mexico and Caribbean
 281       || ( $number =~ /^35(2[89x]|[3-8][\dx]|xx)[\dx]{12,15}$/o && $Country =~ /^(US|PR|VI|MP|PW|GU)$/oi ); #JCB cards in the 3528-3589 range are identified as Discover in US, Puerto Rico, US Virgin Islands, Northern Mariana Islands, Palau and Guam
 282
 283     return "Switch"
 284       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
 285       || $number =~ /^564182[\dx]{10}([\dx]{2,3})?$/o
 286       || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 287     #redunant with above, catch 49* that's not Switch
 288     return "VISA card" if $number =~ /^4[\dx]{12,18}$/o;
 289
 290     #"Diners Club enRoute"
 291     return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
 292
 293     return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
 294
 295     return "BankCard" if $number =~ /^56(10[\dx][\dx]|022[1-5])[\dx]{10}$/o;
 296
 297     return "Solo"
 298       if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
 299
 300     return "China Union Pay"
 301       if $number =~ /^62[24-68][\dx]{13}$/o;
 302
 303     return "Laser"
 304       if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
 305
 306     return "Isracard"
 307       if $number =~ /^[\dx]{8,9}$/;
 308
 309     return "Unknown";
 310 }
 311
 312 sub receipt_cardtype {
 313     # Allow use as a class method
 314     shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
 315
 316     my ($number) = @_;
 317
 318     $number =~ s/[\s\-]//go;
 319     $number =~ s/[x\*\.\_]/x/gio;
 320
 321     #ref Discover IIN Bulletin Feb 2015_021715
 322     return "PayPal card" if $number =~ /^6(01104|506[01]0)[\dx]{10,13}$/o;
 323
 324     cardtype($number);
 325 }
 326
 327 sub generate_last_digit {
 328     # Allow use as a class method
 329     shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
 330
 331     my ($number) = @_;
 332
 333     die "invalid operation" if length($number) == 8 || length($number) == 9;
 334
 335     my ($i, $sum, $weight);
 336
 337     $number =~ s/\D//g;
 338
 339     for ($i = 0; $i < length($number); $i++) {
 340         $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
 341         $sum += (($weight < 10) ? $weight : ($weight - 9));
 342     }
 343
 344     return (10 - $sum % 10) % 10;
 345 }
 346
 347
 348 ## this (GPLed) code from Business::CCCheck is apparantly 4x faster than ours
 349 ## ref http://neilb.org/reviews/luhn.html#Comparison
 350 ## maybe see if we can speed ours up a bit
 351 #  my @ccn = split('',$ccn);
 352 #  my $even = 0;
 353 #  $ccn = 0;
 354 #  for($i=$#ccn;$i >=0;--$i) {
 355 #    $ccn[$i] *= 2 if $even;
 356 #    $ccn -= 9 if $ccn[$i] > 9;
 357 #    $ccn += $ccn[$i];
 358 #    $even = ! $even;
 359 #  }
 360 #  $type = '' if $ccn % 10;
 361 #  return $type;
 362
 363 sub validate { validate_card(@_); }
 364
 365 sub validate_card {
 366     # Allow use as a class method
 367     shift if UNIVERSAL::isa( $_[0], 'Business::CreditCard' );
 368
 369     my ($number) = @_;
 370
 371     my ($i, $sum, $weight);
 372
 373     return 0 if $number =~ /[^\d\s]/;
 374
 375     $number =~ s/\D//g;
 376
 377     if ( $number =~ /^[\dx]{8,9}$/ ) { # Isracard
 378         $number = "0$number" if length($number) == 8;
 379         for($i=1;$i<length($number);$i++){
 380             $sum += substr($number,9-$i,1) * $i;
 381         }
 382         return 1 if $sum%11 == 0;
 383         return 0;
 384     }
 385
 386     return 0 unless length($number) >= 13 && 0+$number;
 387
 388     for ($i = 0; $i < length($number) - 1; $i++) {
 389         $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
 390         $sum += (($weight < 10) ? $weight : ($weight - 9));
 391     }
 392
 393     return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
 394     return 0;
 395 }
 396
 397 1;
 398
 399