File Coverage

blib/lib/MooX/ValidateSubs/Role.pm
Criterion Covered Total %
statement 67 67 100.0
branch 29 30 96.6
condition 28 38 73.6
subroutine 8 8 100.0
pod n/a
total 132 143 92.3


line stmt bran cond sub pod time code
1             package MooX::ValidateSubs::Role;
2              
3 9     9   86976 use Moo::Role;
  9         24  
  9         53  
4 9     9   3468 use Carp qw/croak/;
  9         35  
  9         604  
5 9     9   4883 use Type::Utils qw//;
  9         283483  
  9         338  
6 9     9   5579 use Type::Params qw/compile compile_named/;
  9         565862  
  9         97  
7 9     9   2882 use Types::Standard qw//;
  9         26  
  9         7119  
8              
9             sub _validate_sub {
10 53     53   174 my ( $self, $name, $type, $spec, @params ) = @_;
11 53         232 my $store_spec = sprintf '%s_spec', $name;
12              
13 53   66     255 my $compiled_check = ($self->$store_spec->{"compiled_$type"} ||= do {
14 21 100       78 if (ref $spec eq 'ARRAY') {
15             my @types = map {
16 7         18 my ($constraint, $default) = (@$_, 0);
  20         1219  
17 20 100       66 $default eq '1' ? Types::Standard::Optional->of($constraint) : $constraint;
18             } @$spec;
19 7         120 compile(@types);
20             }
21             else {
22 14         23 my %types;
23 14         59 for my $key (keys %$spec) {
24 50         3192 my ($constraint, $default) = (@{$spec->{$key}}, 0);
  50         135  
25 50 100       184 $types{$key} =
26             $default eq '1' ? Types::Standard::Optional->of($constraint) : $constraint;
27             }
28 14         102 compile_named(%types);
29             }
30             });
31              
32 53         31317 my @count = ( scalar @params );
33 53 100       187 if ( ref $spec eq 'ARRAY' ) {
34 22         36 push @count, scalar @{$spec};
  22         44  
35              
36 22 100 50     35 @params = $self->_preprocess_params(@params) and $count[0] = scalar @params if ( do {
37 22         40 my $preprocess = $count[0];
38 22 100 66     188 $_ == 0 || ! $_ % 2 ? $params[$_] =~ m/[0-9]+/ && $params[$_] <= $count[1] ? next : do { $preprocess = 0 } && last : next foreach 0 .. $count[0] - 1;
    100 100        
      50        
39 22         62 $preprocess;
40             } );
41              
42 22 100 100     80 if ( $count[0] == 1 && $count[1] != 1 and ref $params[0] eq 'ARRAY' ) {
      100        
43 3         6 @params = @{ $params[0] };
  3         8  
44 3         8 $count[0] = scalar @params;
45 3         6 $count[3] = 'ref';
46             }
47              
48 22         61 $count[2] = $count[1] - grep { $spec->[$_]->[1] } 0 .. $count[1] - 1;
  67         127  
49 22 100 66     743 $count[0] >= $count[2] && $count[0] <= $count[1]
50             or croak sprintf 'Error - Invalid count in %s for sub - %s - expected - %s - got - %s',
51             $type, $name, $count[1], $count[0];
52              
53 17         41 foreach ( 0 .. $count[1] - 1 ) {
54 50 50 100     214 not $params[$_] and $spec->[$_]->[1]
      33        
      66        
55             and ( $spec->[$_]->[1] =~ m/^1$/ and next or $params[$_] = $self->_default( $spec->[$_]->[1] ) );
56             }
57              
58 17         56 @params = $compiled_check->(@params);
59 17 100       394 return defined $count[3] ? \@params : @params;
60             }
61              
62 31 100       127 my %para = $count[0] == 1 ? %{ $params[0] } : @params;
  4         18  
63 31         58 my %cry = ( %{$spec}, %para );
  31         142  
64 31         105 foreach ( keys %cry ) {
65             not $para{$_} and $spec->{$_}->[1]
66 111 100 100     580 and ( $spec->{$_}->[1] =~ m/^1$/ and next or $para{$_} = $self->_default( $spec->{$_}->[1] ) );
      33        
      100        
67             }
68              
69 31         137 my $paraRef = $compiled_check->(\%para);
70              
71 21 100       893 return $count[0] == 1 ? $paraRef : %{$paraRef};
  18         144  
72             }
73              
74             sub _default {
75 55     55   121 my ( $self, $default ) = @_;
76              
77 55 100       134 if ( ref $default eq 'CODE' ) {
78 39         108 return $default->();
79             }
80 16         76 return $self->$default;
81             }
82              
83             sub _preprocess_params {
84 4     4   13 my ($self, %params) = @_;
85              
86 4         6 my @world;
87 4         17 map { $world[$_] = $params{$_} } sort keys %params;
  5         15  
88 4         21 return @world;
89             }
90              
91             1;
92