From f0bb572574c03a7f0a2473ded659a21efe653826 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 1 Feb 2001 12:49:27 +0000 Subject: [PATCH] initial import --- CreditCard.pm | 138 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ MANIFEST | 5 +++ Makefile.PL | 7 +++ README | 14 ++++++ test.pl | 19 ++++++++ 5 files changed, 183 insertions(+) create mode 100644 CreditCard.pm create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 test.pl diff --git a/CreditCard.pm b/CreditCard.pm new file mode 100644 index 0000000..c95af0f --- /dev/null +++ b/CreditCard.pm @@ -0,0 +1,138 @@ +package Business::CreditCard; + +# Business::CreditCard.pm +# +# Jon Orwant, +# +# 12 Jul 96 - created +# 17 Jan 97 - 0.21 released. +# short numbers and numbers with letters are no longer kosher. +# 1 Feb 2001 - 0.22 released, new maintainer, MakeMaker installation +# +# Copyright 1995,1996,1997 Jon Orwant. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# Version 0.22. Module list status is "Rdpf." + +require 5; + +require Exporter; +use vars qw( @ISA $VERSION ); + +@ISA = qw( Exporter ); + +$VERSION = "0.22"; + +=head1 NAME + +C - Validate/generate credit card checksums/names + +=head1 SYNOPSIS + + use Business::CreditCard; + + print validate("5276 4400 6542 1319"); + print cardtype("5276 4400 6542 1319"); + print generate_last_digit("5276 4400 6542 131"); + +Business::CreditCard is available at a CPAN site near you. + +=head1 DESCRIPTION + +These subroutines tell you whether a credit card number is +self-consistent -- whether the last digit of the number is a valid +checksum for the preceding digits. + +The validate() subroutine returns 1 if the card number provided passes +the checksum test, and 0 otherwise. + +The cardtype() subroutine returns a string containing the type of +card: "MasterCard", "VISA", and so on. My list is not complete; +I welcome additions. + +The generate_last_digit() subroutine computes and returns the last +digit of the card given the preceding digits. With a 16-digit card, +you provide the first 15 digits; the subroutine returns the sixteenth. + +This module does I tell you whether the number is on an actual +card, only whether it might conceivably be on a real card. To verify +whether a card is real, or whether it's been stolen, or what its +balance is, you need a Merchant ID, which gives you access to credit +card databases. The Perl Journal (http://tpj.com/tpj) has +a Merchant ID so that I can accept MasterCard and VISA payments; it +comes with the little pushbutton/slide-your-card-through device you've +seen in restaurants and stores. That device calculates the checksum +for you, so I don't actually use this module. + +These subroutines will also work if you provide the arguments +as numbers instead of strings, e.g. C. + +=head1 AUTHOR + +Jon Orwant + +The Perl Journal and MIT Media Lab + +orwant@tpj.com + +Current maintainer is Ivan Kohler . +Please don't bother Jon with emails about this module. + +=cut + +@EXPORT = qw(cardtype validate generate_last_digit); + +sub cardtype { + my ($number) = @_; + + return "Not a credit card" if $number =~ /[^\d\s]/; + + $number =~ s/\D//g; + + return "Not a credit card" unless length($number) >= 13 && 0+$number; + + return "VISA card" if substr($number,0,1) == "4"; + return "MasterCard" if substr($number,0,1) == "5"; + return "Discover card" if substr($number,0,1) == "6"; + return "American Express card" if substr($number,0,2) == "37"; + return "Diner's Club, Transmedia, or other dining/entertainment card" if substr($number,0,1) == "3"; + return "Unknown"; +} + +sub generate_last_digit { + my ($number) = @_; + my ($i, $sum, $weight); + + $number =~ s/\D//g; + + for ($i = 0; $i < length($number); $i++) { + $weight = substr($number, -1 * ($i + 1), 1) * (2 - ($i % 2)); + $sum += (($weight < 10) ? $weight : ($weight - 9)); + } + + return (10 - $sum % 10) % 10; +} + +sub validate { + my ($number) = @_; + my ($i, $sum, $weight); + + return 0 if $number =~ /[^\d\s]/; + + $number =~ s/\D//g; + + return 0 unless length($number) >= 13 && 0+$number; + + for ($i = 0; $i < length($number) - 1; $i++) { + $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2)); + $sum += (($weight < 10) ? $weight : ($weight - 9)); + } + + return 1 if substr($number, -1) == (10 - $sum % 10) % 10; + return 0; +} + +1; + + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..5d9bbb5 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,5 @@ +CreditCard.pm +MANIFEST +Makefile.PL +test.pl +README diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..7a2be20 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,7 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Business::CreditCard', + 'VERSION_FROM' => 'CreditCard.pm', # finds $VERSION +); diff --git a/README b/README new file mode 100644 index 0000000..c7522e9 --- /dev/null +++ b/README @@ -0,0 +1,14 @@ +Business::CreditCard + +These subroutines tell you whether a credit card number is self-consistent -- +whether the last digit of the number is a valid checksum for the preceding +digits. + +Jon Orwant + +The Perl Journal and MIT Media Lab + +orwant@tpj.com + +Current maintainer is Ivan Kohler . +Please don't bother Jon with emails about this module. diff --git a/test.pl b/test.pl new file mode 100644 index 0000000..0210ca9 --- /dev/null +++ b/test.pl @@ -0,0 +1,19 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use DBIx::DataSource; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): -- 2.11.0