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