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 Lee Lawrence <LeeL@aspin.co.uk> and Neale Banks <neale@lowendale.com.au>
  85 contributed support for additional card types.  Lee also contributed a working
  86 test.pl.
  87
  88 =cut
  89
  90 @EXPORT = qw(cardtype validate generate_last_digit);
  91
  92 sub cardtype {
  93     my ($number) = @_;
  94
  95     return "Not a credit card" if $number =~ /[^\d\s]/;
  96
  97     $number =~ s/\D//g;
  98
  99     return "Not a credit card" unless length($number) >= 13 && 0+$number;
 100
 101     return "VISA card" if $number =~ /^4\d{12}(\d{3})?$/o;
 102     return "MasterCard" if $number =~ /^5[1-5]\d{14}$/o;
 103     return "Discover card" if $number =~ /^6011\d{12}$/o;
 104     return "American Express card" if $number =~ /^3[47]\d{13}/o;
 105     return "Diner's Club/Carte Blanche"
 106       if $number =~ /^3(0[0-5]|[68]\d)\d{11}$/o;
 107     return "enRoute" if $number =~ /^2(014|149)\d{11}$/o;
 108     return "JCB" if $number =~ /^(3\d{4}|2131|1800)\d{11}$/o;
 109     return "BankCard" if $number =~ /^56(10\d\d|022[1-5])\d{10}$/o;
 110     return "Unknown";
 111 }
 112
 113 # from http://perl.about.com/compute/perl/library/nosearch/P073000.htm
 114 # Card Type                         Prefix                           Length
 115 # MasterCard                        51-55                            16
 116 # VISA                              4                                13, 16
 117 # American Express (AMEX)           34, 37                           15
 118 # Diners Club/Carte Blanche         300-305, 36, 38                  14
 119 # enRoute                           2014, 2149                       15
 120 # Discover                          6011                             16
 121 # JCB                               3                                16
 122 # JCB                               2131, 1800                       15
 123 #
 124 # from Neale Banks <neale@lowendale.com.au>
 125 # According to a booklet I have from Westpac (an Aussie bank), a card number
 126 # starting with 5610 or 56022[1-5] is a BankCard
 127 # BankCards have exactly 16 digits.
 128
 129 sub generate_last_digit {
 130     my ($number) = @_;
 131     my ($i, $sum, $weight);
 132
 133     $number =~ s/\D//g;
 134
 135     for ($i = 0; $i < length($number); $i++) {
 136         $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
 137         $sum += (($weight < 10) ? $weight : ($weight - 9));
 138     }
 139
 140     return (10 - $sum % 10) % 10;
 141 }
 142
 143 sub validate {
 144     my ($number) = @_;
 145     my ($i, $sum, $weight);
 146
 147     return 0 if $number =~ /[^\d\s]/;
 148
 149     $number =~ s/\D//g;
 150
 151     return 0 unless length($number) >= 13 && 0+$number;
 152
 153     for ($i = 0; $i < length($number) - 1; $i++) {
 154         $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
 155         $sum += (($weight < 10) ? $weight : ($weight - 9));
 156     }
 157
 158     return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
 159     return 0;
 160 }
 161
 162 1;
 163
 164