- Add documentation on what this module *is* and *is NOT* about.
- Spelling fix in docs
- correct misdocumentation of $Business::CreditCard::Country
+ - Move test.pl to test/t and modify MANIFEST accordingly (thanks to
+ Alexander Ciornii)
+ - Silence unwanted warnings (thanks to Alexander Ciornii)
+ - Discover cards starting with 644-649 are now recognized
+ - Most Diner's Club cards (300-305, 3095 and 36) now processed as
+ Discover
+ - China Union pay now includes 624-626 and 628 in addition to 622 (and
+ still identified as Discover outside China)
+ - JCB identified as Discover in the US
0.30 Mon Dec 18 23:24:25 PST 2006
- back after two and a half years; happy hanukkah!
MasterCard
Discover card
American Express card
- Diner's Club/Carte Blanche
enRoute
JCB
BankCard
"Not a credit card" is returned on obviously invalid data values.
+Versions before 0.31 may also have returned "Diner's Club/Carte Blanche" (these
+cards are now recognized as "Discover card").
+
As of 0.30, cardtype() will accept a partial card masked with "x", "X', ".",
"*" or "_". Only the first 2-6 digits and the length are significant;
whitespace and dashes are removed. To recognize just Visa, MasterCard and
These subroutines will also work if you provide the arguments
as numbers instead of strings, e.g. C<validate(5276440065421319)>.
-=head1 CHANGES IN 0.30
+=head1 PROCESSING AGREEMENTS
Credit card issuers have recently been forming agreements to process cards on
other networks, in which one type of card is processed as another card type.
=over 4
-=item Diner's club cards (starting with 36) are now identified as "MasterCard" inside the US and Canada.
+=item Most Diner's club is now identified as Discover. (This supercedes the earlier identification of some Diner's club cards as MasterCard inside the US and Canada.)
+
+=item JCB cards in the 3528-3589 range are identified as Discover inside the US and Canada.
=item China Union Pay cards are identified as Discover cards outside China.
Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
Max Becker <Max.Becker@firstgate.com> contributed support for additional card
-types. Lee also contributed a working test.pl.
+types. Lee also contributed a working test.pl. Alexandr Ciornii
+<alexchorny@gmail.com> contributed code cleanups.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 1995,1996,1997 Jon Orwant
Copyright (C) 2001-2006 Ivan Kohler
-Copyright (C) 2007 Freeside Internet Services, Inc.
+Copyright (C) 2007-2009 Freeside Internet Services, Inc.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
return "Not a credit card" if $number =~ /[^\dx]/io;
#$number =~ s/\D//g;
-
- return "Not a credit card" unless length($number) >= 13 && 0+$number;
+ {
+ local $^W=0; #no warning at next line
+ return "Not a credit card" unless length($number) >= 13 && 0+$number;
+ }
return "Switch"
if $number =~ /^49(03(0[2-9]|3[5-9])|11(0[1-2]|7[4-9]|8[1-2])|36[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o
return "MasterCard"
if $number =~ /^5[1-5][\dx]{14}$/o
- || ( $number =~ /^36[\dx]{12}/ && $Country =~ /^(US|CA)$/oi );
+ ;# || ( $number =~ /^36[\dx]{12}/ && $Country =~ /^(US|CA)$/oi );
return "Discover card"
- if $number =~ /^6011[\dx]{12}$/o
+ if $number =~ /^30[0-5][\dx]{11}([\dx]{2})?$/o #diner's: 300-305
+ || $number =~ /^3095[\dx]{10}([\dx]{2})?$/o #diner's: 3095
+ || $number =~ /^3[68][\dx]{12}([\dx]{2})?$/o #diner's: 36
+ || $number =~ /^6011[\dx]{12}$/o
+ || $number =~ /^64[4-9][\dx]{13}$/o
|| $number =~ /^65[\dx]{14}$/o
- || ( $number =~ /^622[\dx]{13}$/o && $Country !~ /^(CN)$/oi );
+ || ( $number =~ /^62[24-68][\dx]{13}$/o && uc($Country) ne 'CN' ) #CUP
+ || ( $number =~ /^35(2[89]|[3-8][\dx])[\dx]{10}$/o && uc($Country) eq 'US' );
return "American Express card" if $number =~ /^3[47][\dx]{13}$/o;
- return "Diner's Club/Carte Blanche"
- if $number =~ /^3(0[0-5]|[68][\dx])[\dx]{11}$/o;
+ #return "Diner's Club/Carte Blanche"
+ # if $number =~ /^3(0[0-59]|[68][\dx])[\dx]{11}$/o;
+ #"Diners Club enRoute"
return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
if $number =~ /^6(3(34[5-9][0-9])|767[0-9]{2})[\dx]{10}([\dx]{2,3})?$/o;
return "China Union Pay"
- if $number =~ /^622[\dx]{13}$/o;
+ if $number =~ /^62[24-68][\dx]{13}$/o;
return "Laser"
if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
CreditCard.pm
MANIFEST
Makefile.PL
-test.pl
README
BINS
META.yml
+t/test.t
--- /dev/null
+# 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..2\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Business::CreditCard;
+$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):
+
+#test 2
+if( test_card_identification() ){ print "ok 2\n" }else{ print "not ok 2\n" }
+
+sub test_card_identification{
+ #
+ # For the curious the table of test number aren't real credit card
+ # in fact they won't validate but they do obey the rule for the
+ # cardtype table to identify the card type.
+ #
+ my %test_table=(
+ '5212345678901234' => 'MasterCard',
+ '5512345678901234' => 'MasterCard',
+ '4123456789012' => 'VISA card',
+ '4512345678901234' => 'VISA card',
+ '341234567890123' => 'American Express card',
+ '371234567890123' => 'American Express card',
+ #'30112345678901' => "Diner's Club/Carte Blanche",
+ '30112345678901' => 'Discover card',
+ #'30512345678901' => "Diner's Club/Carte Blanche",
+ '30512345678901' => 'Discover card',
+ #'36123456789012' => "Diner's Club/Carte Blanche",
+ #'36123456789012' => 'MasterCard',
+ '36123456789012' => 'Discover card',
+ #'38123456789012' => "Diner's Club/Carte Blanche",
+ '38123456789012' => 'Discover card',
+ '201412345678901' => 'enRoute',
+ '214912345678901' => 'enRoute',
+ '6011123456789012' => 'Discover card',
+ '3123456789012345' => 'JCB',
+ '213112345678901' => 'JCB',
+ '180012345678901' => 'JCB',
+ '1800123456789012' => 'Unknown',
+ '312345678901234' => 'Unknown',
+ '4111xxxxxxxxxxxx' => 'VISA card',
+ '6599xxxxxxxxxxxx' => 'Discover card',
+ '6222xxxxxxxxxxxx' => 'Discover card', #China Union Pay
+ '6304980000000000004' => 'Laser',
+ '6499xxxxxxxxxxxx' => 'Discover card',
+ '5610xxxxxxxxxxxx' => 'BankCard',
+ '6250xxxxxxxxxxxx' => 'Discover card', #China Union Pay
+ '6280xxxxxxxxxxxx' => 'Discover card', #China Union Pay
+ );
+ while( my ($k, $v)=each(%test_table) ){
+ if(cardtype($k) ne $v){
+ warn "Card $k - should be $v but cardtype returns ". cardtype($k). "\n";
+ return;
+ }
+ }
+ return 1;
+}
+
+++ /dev/null
-# 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..2\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Business::CreditCard;
-$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):
-
-#test 2
-if( test_card_identification() ){ print "ok 2\n" }else{ print "not ok 2\n" }
-
-sub test_card_identification{
- #
- # For the curious the table of test number aren't real credit card
- # in fact they won't validate but they do obey the rule for the
- # cardtype table to identify the card type.
- #
- my %test_table=(
- '5212345678901234' => 'MasterCard',
- '5512345678901234' => 'MasterCard',
- '4123456789012' => 'VISA card',
- '4512345678901234' => 'VISA card',
- '341234567890123' => 'American Express card',
- '371234567890123' => 'American Express card',
- '30112345678901' => "Diner's Club/Carte Blanche",
- '30512345678901' => "Diner's Club/Carte Blanche",
- #'36123456789012' => "Diner's Club/Carte Blanche",
- '36123456789012' => 'MasterCard',
- '38123456789012' => "Diner's Club/Carte Blanche",
- '201412345678901' => 'enRoute',
- '214912345678901' => 'enRoute',
- '6011123456789012' => 'Discover card',
- '3123456789012345' => 'JCB',
- '213112345678901' => 'JCB',
- '180012345678901' => 'JCB',
- '1800123456789012' => 'Unknown',
- '312345678901234' => 'Unknown',
- '4111xxxxxxxxxxxx' => 'VISA card',
- '6599xxxxxxxxxxxx' => 'Discover card',
- '6222xxxxxxxxxxxx' => 'Discover card', #China Union Pay
- '6304980000000000004' => 'Laser',
- );
- while( my ($k, $v)=each(%test_table) ){
- if(cardtype($k) ne $v){
- print "Card $k - should be $v cardtpe returns ",cardtype
-($k),"\n";
- return;
- }
- }
- return 1;
-}
-
projects / Business-CreditCard.git / commitdiff