CreditCard.pm

   1 package Business::CreditCard;
   2
   3 # Jon Orwant, <orwant@media.mit.edu>
   4 #
   5 # Copyright 1995,1996,1997 Jon Orwant.  All rights reserved.
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the same terms as Perl itself.
   8 #
   9 # Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
  10 # Please don't bother Jon with emails about this module.
  11
  12 require 5;
  13
  14 require Exporter;
  15 use vars qw( @ISA $VERSION );
  16
  17 @ISA = qw( Exporter );
  18
  19 $VERSION = "0.28";
  20
  21 =head1 NAME
  22
  23 C<Business::CreditCard> - Validate/generate credit card checksums/names
  24
  25 =head1 SYNOPSIS
  26
  27     use Business::CreditCard;
  28
  29     print validate("5276 4400 6542 1319");
  30     print cardtype("5276 4400 6542 1319");
  31     print generate_last_digit("5276 4400 6542 131");
  32
  33 Business::CreditCard is available at a CPAN site near you.
  34
  35 =head1 DESCRIPTION
  36
  37 These subroutines tell you whether a credit card number is
  38 self-consistent -- whether the last digit of the number is a valid
  39 checksum for the preceding digits.
  40
  41 The validate() subroutine returns 1 if the card number provided passes
  42 the checksum test, and 0 otherwise.
  43
  44 The cardtype() subroutine returns a string containing the type of
  45 card.  My list is not complete; I welcome additions.
  46
  47 Possible return values are:
  48
  49   VISA card
  50   MasterCard
  51   Discover card
  52   American Express card
  53   Diner's Club/Carte Blanche
  54   enRoute
  55   JCB
  56   BankCard
  57   Switch
  58   Solo
  59   Unknown
  60
  61 "Not a credit card" is returned on obviously invalid
  62 data values.
  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 what its
  71 balance is, you need a Merchant ID, which gives you access to credit
  72 card databases.  The Perl Journal (http://tpj.com/tpj) has
  73 a Merchant ID so that I can accept MasterCard and VISA payments; it
  74 comes with the little pushbutton/slide-your-card-through device you've
  75 seen in restaurants and stores.  That device calculates the checksum
  76 for you, so I don't actually use this module.
  77
  78 These subroutines will also work if you provide the arguments
  79 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
  80
  81 =head1 AUTHOR
  82
  83 Jon Orwant
  84
  85 The Perl Journal and MIT Media Lab
  86
  87 orwant@tpj.com
  88
  89 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
  90 Please don't bother Jon with emails about this module.
  91
  92 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
  93 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
  94 types.  Lee also contributed a working test.pl.
  95
  96 =cut
  97
  98 @EXPORT = qw(cardtype validate generate_last_digit);
  99
 100 sub cardtype {
 101     my ($number) = @_;
 102
 103     return "Not a credit card" if $number =~ /[^\d\s]/;
 104
 105     $number =~ s/\D//g;
 106
 107     return "Not a credit card" unless length($number) >= 13 && 0+$number;
 108
 109     return "VISA card" if $number =~ /^4\d{12}(\d{3})?$/o;
 110     return "MasterCard" if $number =~ /^5[1-5]\d{14}$/o;
 111     return "Discover card" if $number =~ /^6011\d{12}$/o;
 112     return "American Express card" if $number =~ /^3[47]\d{13}$/o;
 113     return "Diner's Club/Carte Blanche"
 114       if $number =~ /^3(0[0-5]|[68]\d)\d{11}$/o;
 115     return "enRoute" if $number =~ /^2(014|149)\d{11}$/o;
 116     return "JCB" if $number =~ /^(3\d{4}|2131|1800)\d{11}$/o;
 117     return "BankCard" if $number =~ /^56(10\d\d|022[1-5])\d{10}$/o;
 118     return "Switch"
 119       if $number =~ /^49(03(0[2-9]|3[5-9])|11(0[1-2]|7[4-9]|8[1-2])|36[0-9]{2})\d{10}(\d{2,3})?$/o
 120       || $number =~ /^564182\d{10}(\d{2,3})?$/o
 121       || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})\d{10}(\d{2,3})?$/o;
 122     return "Solo"
 123       if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})\d{10}(\d{2,3})?$/o;
 124     return "Unknown";
 125 }
 126
 127 # from http://perl.about.com/compute/perl/library/nosearch/P073000.htm
 128 # verified by http://www.beachnet.com/~hstiles/cardtype.html
 129 # Card Type                         Prefix                           Length
 130 # MasterCard                        51-55                            16
 131 # VISA                              4                                13, 16
 132 # American Express (AMEX)           34, 37                           15
 133 # Diners Club/Carte Blanche         300-305, 36, 38                  14
 134 # enRoute                           2014, 2149                       15
 135 # Discover                          6011                             16
 136 # JCB                               3                                16
 137 # JCB                               2131, 1800                       15
 138 #
 139 # from Neale Banks <neale@lowendale.com.au>
 140 # According to a booklet I have from Westpac (an Aussie bank), a card number
 141 # starting with 5610 or 56022[1-5] is a BankCard
 142 # BankCards have exactly 16 digits.
 143 #
 144 # from "Becker, Max" <Max.Becker@firstgate.com>
 145 # It's mostly used in the UK and is either alled "Switch" or "Solo".
 146 # Card Type                         Prefix                           Length
 147 # Switch                            various                          16,18,19
 148 # Solo                              63, 6767                         16,18,19
 149
 150 sub generate_last_digit {
 151     my ($number) = @_;
 152     my ($i, $sum, $weight);
 153
 154     $number =~ s/\D//g;
 155
 156     for ($i = 0; $i < length($number); $i++) {
 157         $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
 158         $sum += (($weight < 10) ? $weight : ($weight - 9));
 159     }
 160
 161     return (10 - $sum % 10) % 10;
 162 }
 163
 164 sub validate {
 165     my ($number) = @_;
 166     my ($i, $sum, $weight);
 167
 168     return 0 if $number =~ /[^\d\s]/;
 169
 170     $number =~ s/\D//g;
 171
 172     return 0 unless length($number) >= 13 && 0+$number;
 173
 174     for ($i = 0; $i < length($number) - 1; $i++) {
 175         $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
 176         $sum += (($weight < 10) ? $weight : ($weight - 9));
 177     }
 178
 179     return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
 180     return 0;
 181 }
 182
 183 1;
 184
 185