CreditCard.pm

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