CreditCard.pm

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