1package Regexp::Common::CC; 2 3use 5.10.0; 4 5use strict; 6use warnings; 7no warnings 'syntax'; 8 9use Regexp::Common qw /pattern clean no_defaults/; 10use Regexp::Common::_support qw /luhn/; 11 12our $VERSION = '2017060201'; 13 14my @cards = ( 15 # Name Prefix Length mod 10 16 [Mastercard => '5[1-5]', 16, 1], 17 [Visa => '4', [13, 16], 1], 18 [Amex => '3[47]', 15, 1], 19 # Carte Blanche 20 ['Diners Club' => '3(?:0[0-5]|[68])', 14, 1], 21 [Discover => '6011', 16, 1], 22 [enRoute => '2(?:014|149)', 15, 0], 23 [JCB => [['3', 16, 1], 24 ['2131|1800', 15, 1]]], 25); 26 27 28foreach my $card (@cards) { 29 my ($name, $prefix, $length, $mod) = @$card; 30 31 # Skip the harder ones for now. 32 next if ref $prefix || ref $length; 33 next unless $mod; 34 35 my $times = $length + $mod; 36 pattern name => [CC => $name], 37 create => sub { 38 use re 'eval'; 39 qr <((?=($prefix))[0-9]{$length}) 40 (?(?{Regexp::Common::_support::luhn $1})|(?!))>x 41 } 42 ; 43} 44 45 46 47 481; 49 50__END__ 51 52=pod 53 54=head1 NAME 55 56Regexp::Common::CC -- provide patterns for credit card numbers. 57 58=head1 SYNOPSIS 59 60 use Regexp::Common qw /CC/; 61 62 while (<>) { 63 /^$RE{CC}{Mastercard}$/ and print "Mastercard card number\n"; 64 } 65 66=head1 DESCRIPTION 67 68Please consult the manual of L<Regexp::Common> for a general description 69of the works of this interface. 70 71Do not use this module directly, but load it via I<Regexp::Common>. 72 73This module offers patterns for credit card numbers of several major 74credit card types. Currently, the supported cards are: I<Mastercard>, 75I<Amex>, I<Diners Club>, and I<Discover>. 76 77 78=head1 SEE ALSO 79 80L<Regexp::Common> for a general description of how to use this interface. 81 82=over 4 83 84=item L<http://www.beachnet.com/~hstiles/cardtype.html> 85 86Credit Card Validation - Check Digits 87 88=item L<http://euro.ecom.cmu.edu/resources/elibrary/everycc.htm> 89 90Everything you ever wanted to know about CC's 91 92=item L<http://www.webopedia.com/TERM/L/Luhn_formula.html> 93 94Luhn formula 95 96=back 97 98=head1 AUTHORS 99 100Damian Conway S<(I<damian@conway.org>)> and 101Abigail S<(I<regexp-common@abigail.be>)>. 102 103=head1 MAINTENANCE 104 105This package is maintained by Abigail S<(I<regexp-common@abigail.be>)>. 106 107=head1 BUGS AND IRRITATIONS 108 109Bound to be plenty. Send them in to S<I<regexp-common@abigail.be>>. 110 111=head1 LICENSE and COPYRIGHT 112 113This software is Copyright (c) 2001 - 2017, Damian Conway and Abigail. 114 115This module is free software, and maybe used under any of the following 116licenses: 117 118 1) The Perl Artistic License. See the file COPYRIGHT.AL. 119 2) The Perl Artistic License 2.0. See the file COPYRIGHT.AL2. 120 3) The BSD License. See the file COPYRIGHT.BSD. 121 4) The MIT License. See the file COPYRIGHT.MIT. 122 123=cut 124