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