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