File Coverage

blib/lib/Data/Rx/CoreType/arr.pm
Criterion Covered Total %
statement 29 29 100.0
branch 10 10 100.0
condition 12 13 92.3
subroutine 7 7 100.0
pod 0 3 0.0
total 58 62 93.5


line stmt bran cond sub pod time code
1 1     1   12 use v5.12.0;
  1         3  
2 1     1   6 use warnings;
  1         2  
  1         39  
3             package Data::Rx::CoreType::arr 0.200008;
4             # ABSTRACT: the Rx //arr type
5              
6 1     1   5 use parent 'Data::Rx::CoreType';
  1         2  
  1         4  
7              
8 1     1   66 use Scalar::Util ();
  1         2  
  1         394  
9              
10 70     70 0 231 sub subname { 'arr' }
11              
12             sub guts_from_arg {
13 10     10 0 38 my ($class, $arg, $rx, $type) = @_;
14              
15 10 100       59 Carp::croak("unknown arguments to new")
16             unless Data::Rx::Util->_x_subset_keys_y($arg, {length=>1, contents=>1,
17             skip=>1});
18              
19             Carp::croak("no contents schema given")
20 9 100 100     225 unless $arg->{contents} and (ref $arg->{contents} || 'HASH' eq 'HASH');
      66        
21              
22             my $guts = {
23 8         35 content_check => $rx->make_schema($arg->{contents}),
24             };
25              
26             $guts->{length_check} = Data::Rx::Util->_make_range_check($arg->{length})
27 6 100       33 if $arg->{length};
28              
29 6   100     42 $guts->{skip} = $arg->{skip} || 0;
30              
31 6         19 return $guts;
32             }
33              
34             sub assert_valid {
35 114     114 0 13303 my ($self, $value) = @_;
36              
37 114 100 100     594 unless (! Scalar::Util::blessed($value) and ref $value eq 'ARRAY') {
38 78         388 $self->fail({
39             error => [ qw(type) ],
40             message => "found value is not an arrayref",
41             value => $value,
42             });
43             }
44              
45 36         59 my @subchecks;
46              
47 36 100 100     149 if ($self->{length_check} and
48             ! $self->{length_check}->(@$value - $self->{skip})) {
49 5         145 push @subchecks,
50             $self->new_fail({
51             error => [ qw(size) ],
52             size => 0 + @$value, # note: actual size, not size - skip
53             message => "number of entries is outside permitted range",
54             value => $value,
55             });
56             }
57              
58 36         430 for my $i ($self->{skip} .. $#$value) {
59             push @subchecks, [
60             $value->[$i],
61             $self->{content_check},
62             {
63 88         382 data_path => [ [ $i, 'index' ] ],
64             check_path => [ [ 'contents', 'key'] ],
65             },
66             ];
67             }
68              
69 36         140 $self->perform_subchecks(\@subchecks);
70              
71 24         92 return 1;
72             }
73              
74             1;
75              
76             __END__