- Move test.pl to test/t and modify MANIFEST accordingly (thanks to
authorivan <ivan>
Mon, 28 Sep 2009 21:59:52 +0000 (21:59 +0000)
committerivan <ivan>
Mon, 28 Sep 2009 21:59:52 +0000 (21:59 +0000)
          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

Changes
CreditCard.pm
MANIFEST
t/test.t [new file with mode: 0644]
test.pl [deleted file]

diff --git a/Changes b/Changes
index 2de7d06..da17d5f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -7,6 +7,15 @@ Revision history for Perl extension Business::CreditCard.
         - Add documentation on what this module *is* and *is NOT* about.
         - Spelling fix in docs
         - correct misdocumentation of $Business::CreditCard::Country
         - 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!
 
 0.30  Mon Dec 18 23:24:25 PST 2006
         - back after two and a half years; happy hanukkah!
index 959430a..ba63d63 100644 (file)
@@ -42,7 +42,6 @@ Possible return values are:
   MasterCard
   Discover card
   American Express card
   MasterCard
   Discover card
   American Express card
-  Diner's Club/Carte Blanche
   enRoute
   JCB
   BankCard
   enRoute
   JCB
   BankCard
@@ -54,6 +53,9 @@ Possible return values are:
 
 "Not a credit card" is returned on obviously invalid data values.
 
 
 "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
 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
@@ -74,7 +76,7 @@ charges, you need a Merchant account.  See L<Business::OnlinePayment>.
 These subroutines will also work if you provide the arguments
 as numbers instead of strings, e.g. C<validate(5276440065421319)>.  
 
 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.
 
 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.
@@ -94,7 +96,9 @@ Here are the currently known agreements:
 
 =over 4
 
 
 =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.
 
 
 =item China Union Pay cards are identified as Discover cards outside China.
 
@@ -119,13 +123,14 @@ Please don't bother Jon with emails about this module.
 
 Lee Lawrence <LeeL@aspin.co.uk>, Neale Banks <neale@lowendale.com.au> and
 Max Becker <Max.Becker@firstgate.com> contributed support for additional card
 
 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
 
 =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,
 
 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,
@@ -153,8 +158,10 @@ sub cardtype {
     return "Not a credit card" if $number =~ /[^\dx]/io;
 
     #$number =~ s/\D//g;
     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 "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
@@ -165,18 +172,24 @@ sub cardtype {
 
     return "MasterCard"
       if   $number =~ /^5[1-5][\dx]{14}$/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"
 
     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 =~ /^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 "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;
     return "enRoute" if $number =~ /^2(014|149)[\dx]{11}$/o;
 
     return "JCB" if $number =~ /^(3[\dx]{4}|2131|1800)[\dx]{11}$/o;
@@ -187,7 +200,7 @@ sub cardtype {
       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 =~ /^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;
 
     return "Laser"
       if $number =~ /^6(304|7(06|09|71))[\dx]{12,15}$/o;
index 16a81e4..b6ba995 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2,7 +2,7 @@ Changes
 CreditCard.pm
 MANIFEST
 Makefile.PL
 CreditCard.pm
 MANIFEST
 Makefile.PL
-test.pl
 README
 BINS
 META.yml
 README
 BINS
 META.yml
+t/test.t
diff --git a/t/test.t b/t/test.t
new file mode 100644 (file)
index 0000000..2a3d091
--- /dev/null
+++ b/t/test.t
@@ -0,0 +1,71 @@
+# 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;
+}
+
diff --git a/test.pl b/test.pl
deleted file mode 100644 (file)
index f1ff8da..0000000
--- a/test.pl
+++ /dev/null
@@ -1,64 +0,0 @@
-# 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;
-}
-