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   3952 use strict;
  2         4  
  2         59  
4 2     2   13 use warnings;
  2         4  
  2         55  
5 2     2   10 use vars qw(@ISA $VERSION @EXPORT_OK);
  2         3  
  2         137  
6 2     2   889 use Business::DK::CVR qw(validate);
  2         6  
  2         126  
7 2     2   14 use Scalar::Util qw(blessed);
  2         6  
  2         94  
8 2     2   13 use Carp qw(croak);
  2         4  
  2         76  
9              
10 2     2   11 use base 'Exporter';
  2         5  
  2         202  
11              
12             @EXPORT_OK = qw(valid_cvr match_valid_cvr);
13              
14 2     2   13 use constant VALID => 1;
  2         4  
  2         124  
15 2     2   14 use constant INVALID => undef;
  2         5  
  2         516  
16              
17             $VERSION = '0.12';
18              
19             sub valid_cvr {
20             return sub {
21 6     6   6122 my $dfv = shift;
22              
23 6 50 33     59 if ( !blessed $dfv || !$dfv->isa('Data::FormValidator::Results') ) {
24 0         0 croak('Must be called using \'constraint_methods\'!');
25             }
26              
27 6         21 my $cvr = $dfv->get_current_constraint_value;
28              
29 6 50       43 if ( ref $dfv ) {
30 6         17 $dfv->name_this('valid_cvr');
31             }
32              
33 6 100       44 if ( validate($cvr) ) {
34 4         13 return VALID;
35             } else {
36 2         8 return INVALID;
37             }
38             }
39 4     4 1 3789 }
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__