File Coverage

blib/lib/Data/FormValidator/Constraints/Business/DK/CVR.pm
Criterion Covered Total %
statement 36 41 87.8
branch 4 8 50.0
condition 1 3 33.3
subroutine 11 12 91.6
pod 2 2 100.0
total 54 66 81.8


line stmt bran cond sub pod time code
1             package Data::FormValidator::Constraints::Business::DK::CVR;
2              
3 2     2   3084 use strict;
  2         4  
  2         50  
4 2     2   10 use warnings;
  2         2  
  2         46  
5 2     2   8 use vars qw(@ISA $VERSION @EXPORT_OK);
  2         3  
  2         114  
6 2     2   768 use Business::DK::CVR qw(validate);
  2         5  
  2         97  
7 2     2   12 use Scalar::Util qw(blessed);
  2         4  
  2         76  
8 2     2   10 use Carp qw(croak);
  2         4  
  2         61  
9              
10 2     2   8 use base 'Exporter';
  2         4  
  2         161  
11              
12             @EXPORT_OK = qw(valid_cvr match_valid_cvr);
13              
14 2     2   10 use constant VALID => 1;
  2         4  
  2         78  
15 2     2   10 use constant INVALID => undef;
  2         4  
  2         422  
16              
17             $VERSION = '0.10';
18              
19             sub valid_cvr {
20             return sub {
21 6     6   5659 my $dfv = shift;
22              
23 6 50 33     46 if ( !blessed $dfv || !$dfv->isa('Data::FormValidator::Results') ) {
24 0         0 croak('Must be called using \'constraint_methods\'!');
25             }
26              
27 6         19 my $cvr = $dfv->get_current_constraint_value;
28              
29 6 50       65 if ( ref $dfv ) {
30 6         18 $dfv->name_this('valid_cvr');
31             }
32              
33 6 100       39 if ( validate($cvr) ) {
34 4         9 return VALID;
35             } else {
36 2         5 return INVALID;
37             }
38             }
39 4     4 1 3654 }
40              
41             sub match_valid_cvr {
42 0     0 1   my $dfv = shift;
43              
44             # if $dfv is a ref then we are called as 'constraint_method'
45             # else as 'constraint'
46              
47 0 0         my $cvr = ref $dfv ? $dfv->get_current_constraint_value : $dfv;
48              
49             #my $cvr = $dfv->get_current_constraint_value;
50              
51 0           my ($untainted_cvr) = $cvr =~ m/\b(\d{8})\b/smx;
52              
53 0           return $dfv->untainted_constraint_value($untainted_cvr);
54             }
55              
56             1;
57              
58             __END__