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