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 108     108   70415 use strict;
  108         219  
  108         2881  
6 108     108   550 use warnings;
  108         219  
  108         3121  
7              
8 108     108   547 use base 'Validation::Class::Directive';
  108         213  
  108         8679  
9              
10 108     108   593 use Validation::Class::Util;
  108         230  
  108         758  
11              
12             our $VERSION = '7.900057'; # 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 41 my ($self, $proto, $field, $param) = @_;
23              
24 19 50 33     100 if (defined $field->{creditcard} && defined $param) {
25              
26 19         462 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         46 my $type = $field->{creditcard};
45              
46 19 50 33     94 if ($field->{required} || $param) {
47              
48 19         29 my $is_valid = 0;
49              
50 19 100       59 $type = isa_arrayref($type) ? $type : $type eq '1' ? ['any'] : [$type];
    100          
51              
52 19         28 for (@{$type}) {
  19         48  
53              
54 21 100       176 if ($param =~ $ccre->{$_}) {
55 13         21 $is_valid = 1;
56 13         21 last;
57             }
58              
59             }
60              
61 19 100       152 $self->error($proto, $field) unless $is_valid;
62              
63             }
64              
65             }
66              
67 19         61 return $self;
68              
69             }
70              
71             1;
72              
73             __END__