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