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: "MasterCard", "VISA", and so on.  My list is not complete;
  46 I welcome additions.
  47
  48 The generate_last_digit() subroutine computes and returns the last
  49 digit of the card given the preceding digits.  With a 16-digit card,
  50 you provide the first 15 digits; the subroutine returns the sixteenth.
  51
  52 This module does I<not> tell you whether the number is on an actual
  53 card, only whether it might conceivably be on a real card.  To verify
  54 whether a card is real, or whether it's been stolen, or what its
  55 balance is, you need a Merchant ID, which gives you access to credit
  56 card databases.  The Perl Journal (http://tpj.com/tpj) has
  57 a Merchant ID so that I can accept MasterCard and VISA payments; it
  58 comes with the little pushbutton/slide-your-card-through device you've
  59 seen in restaurants and stores.  That device calculates the checksum
  60 for you, so I don't actually use this module.
  61
  62 These subroutines will also work if you provide the arguments
  63 as numbers instead of strings, e.g. C<validate(5276440065421319)>.
  64
  65 =head1 AUTHOR
  66
  67 Jon Orwant
  68
  69 The Perl Journal and MIT Media Lab
  70
  71 orwant@tpj.com
  72
  73 Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
  74 Please don't bother Jon with emails about this module.
  75
  76 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
  77 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
  78 types.  Lee also contributed a working test.pl.
  79
  80 =cut
  81
  82 @EXPORT = qw(cardtype validate generate_last_digit);
  83
  84 sub cardtype {
  85     my ($number) = @_;
  86
  87     return "Not a credit card" if $number =~ /[^\d\s]/;
  88
  89     $number =~ s/\D//g;
  90
  91     return "Not a credit card" unless length($number) >= 13 && 0+$number;
  92
  93     return "VISA card" if $number =~ /^4\d{12}(\d{3})?$/o;
  94     return "MasterCard" if $number =~ /^5[1-5]\d{14}$/o;
  95     return "Discover card" if $number =~ /^6011\d{12}$/o;
  96     return "American Express card" if $number =~ /^3[47]\d{13}$/o;
  97     return "Diner's Club/Carte Blanche"
  98       if $number =~ /^3(0[0-5]|[68]\d)\d{11}$/o;
  99     return "enRoute" if $number =~ /^2(014|149)\d{11}$/o;
 100     return "JCB" if $number =~ /^(3\d{4}|2131|1800)\d{11}$/o;
 101     return "BankCard" if $number =~ /^56(10\d\d|022[1-5])\d{10}$/o;
 102     return "Switch"
 103       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
 104       || $number =~ /^564182\d{10}(\d{2,3})?$/o
 105       || $number =~ /^6(3(33[0-4][0-9])|759[0-9]{2})\d{10}(\d{2,3})?$/o;
 106     return "Solo"
 107       if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})\d{10}(\d{2,3})?$/o;
 108     return "Unknown";
 109 }
 110
 111 # from http://perl.about.com/compute/perl/library/nosearch/P073000.htm
 112 # verified by http://www.beachnet.com/~hstiles/cardtype.html
 113 # Card Type                         Prefix                           Length
 114 # MasterCard                        51-55                            16
 115 # VISA                              4                                13, 16
 116 # American Express (AMEX)           34, 37                           15
 117 # Diners Club/Carte Blanche         300-305, 36, 38                  14
 118 # enRoute                           2014, 2149                       15
 119 # Discover                          6011                             16
 120 # JCB                               3                                16
 121 # JCB                               2131, 1800                       15
 122 #
 123 # from Neale Banks <neale@lowendale.com.au>
 124 # According to a booklet I have from Westpac (an Aussie bank), a card number
 125 # starting with 5610 or 56022[1-5] is a BankCard
 126 # BankCards have exactly 16 digits.
 127 #
 128 # from "Becker, Max" <Max.Becker@firstgate.com>
 129 # It's mostly used in the UK and is either alled "Switch" or "Solo".
 130 # Card Type                         Prefix                           Length
 131 # Switch                            various                          16,18,19
 132 # Solo                              63, 6767                         16,18,19
 133
 134 sub generate_last_digit {
 135     my ($number) = @_;
 136     my ($i, $sum, $weight);
 137
 138     $number =~ s/\D//g;
 139
 140     for ($i = 0; $i < length($number); $i++) {
 141         $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2));
 142         $sum += (($weight < 10) ? $weight : ($weight - 9));
 143     }
 144
 145     return (10 - $sum % 10) % 10;
 146 }
 147
 148 sub validate {
 149     my ($number) = @_;
 150     my ($i, $sum, $weight);
 151
 152     return 0 if $number =~ /[^\d\s]/;
 153
 154     $number =~ s/\D//g;
 155
 156     return 0 unless length($number) >= 13 && 0+$number;
 157
 158     for ($i = 0; $i < length($number) - 1; $i++) {
 159         $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
 160         $sum += (($weight < 10) ? $weight : ($weight - 9));
 161     }
 162
 163     return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
 164     return 0;
 165 }
 166
 167 1;
 168
 169