File Coverage

blib/lib/Validation/Class/Directive/Creditcard.pm
Criterion Covered Total %
statement 26 26 100.0
branch 10 12 83.3
condition 2 6 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 43 50 86.0


line stmt bran cond sub pod time code
1             # ABSTRACT: Creditcard Directive for Validation Class Field Definitions
2              
3             package Validation::Class::Directive::Creditcard;
4              
5 109     109   54756 use strict;
  109         316  
  109         3329  
6 109     109   635 use warnings;
  109         319  
  109         3058  
7              
8 109     109   601 use base 'Validation::Class::Directive';
  109         257  
  109         10843  
9              
10 109     109   863 use Validation::Class::Util;
  109         417  
  109         708  
11              
12             our $VERSION = '7.900059'; # VERSION
13              
14              
15             has 'mixin' => 1;
16             has 'field' => 1;
17             has 'multi' => 0;
18             has 'message' => '%s requires a valid credit card number';
19              
20             sub validate {
21              
22 19     19 0 50 my ($self, $proto, $field, $param) = @_;
23              
24 19 50 33     92 if (defined $field->{creditcard} && defined $param) {
25              
26 19         398 my $ccre = {
27             'amex' => qr/^3[4|7]\d{13}$/,
28             'bankcard' => qr/^56(10\d\d|022[1-5])\d{10}$/,
29             'diners' => qr/^(?:3(0[0-5]|[68]\d)\d{11})|(?:5[1-5]\d{14})$/,
30             'disc' => qr/^(?:6011|650\d)\d{12}$/,
31             'electron' => qr/^(?:417500|4917\d{2}|4913\d{2})\d{10}$/,
32             'enroute' => qr/^2(?:014|149)\d{11}$/,
33             'jcb' => qr/^(3\d{4}|2100|1800)\d{11}$/,
34             'maestro' => qr/^(?:5020|6\d{3})\d{12}$/,
35             'mastercard' => qr/^5[1-5]\d{14}$/,
36             'solo' => qr/^(6334[5-9][0-9]|6767[0-9]{2})\d{10}(\d{2,3})?$/,
37             'switch' => qr/^(?:49(03(0[2-9]|3[5-9])|11(0[1-2]|7[4-9]|8[1-2])|36[0-9]{2})\d{10}(\d{2,3})?)|(?:564182\d{10}(\d{2,3})?)|(6(3(33[0-4][0-9])|759[0-9]{2})\d{10}(\d{2,3})?)$/,
38             'visa' => qr/^4\d{12}(\d{3})?$/,
39             'voyager' => qr/^8699[0-9]{11}$/,
40             # or do a simple catch-all match
41             'any' => qr/^(?:4[0-9]{12}(?:[0-9]{3})?|5[1-5][0-9]{14}|6011[0-9]{12}|3(?:0[0-5]|[68][0-9])[0-9]{11}|3[47][0-9]{13})$/
42             };
43              
44 19         53 my $type = $field->{creditcard};
45              
46 19 50 33     75 if ($field->{required} || $param) {
47              
48 19         33 my $is_valid = 0;
49              
50 19 100       55 $type = isa_arrayref($type) ? $type : $type eq '1' ? ['any'] : [$type];
    100          
51              
52 19         37 for (@{$type}) {
  19         41  
53              
54 21 100       203 if ($param =~ $ccre->{$_}) {
55 13         25 $is_valid = 1;
56 13         25 last;
57             }
58              
59             }
60              
61 19 100       120 $self->error($proto, $field) unless $is_valid;
62              
63             }
64              
65             }
66              
67 19         67 return $self;
68              
69             }
70              
71             1;
72              
73             __END__