File Coverage

blib/lib/Data/Rx/CoreType/any.pm
Criterion Covered Total %
statement 33 33 100.0
branch 9 10 90.0
condition 2 3 66.6
subroutine 7 7 100.0
pod 0 3 0.0
total 51 56 91.0


line stmt bran cond sub pod time code
1 1     1   6 use strict;
  1         2  
  1         53  
2 1     1   7 use warnings;
  1         3  
  1         56  
3             package Data::Rx::CoreType::any;
4             # ABSTRACT: the Rx //any type
5             $Data::Rx::CoreType::any::VERSION = '0.200006';
6 1     1   6 use parent 'Data::Rx::CoreType';
  1         2  
  1         7  
7              
8 1     1   65 use Scalar::Util ();
  1         2  
  1         365  
9              
10             sub guts_from_arg {
11 5     5 0 13 my ($class, $arg, $rx, $type) = @_;
12              
13 5 50       36 Carp::croak("unknown arguments to new")
14             unless Data::Rx::Util->_x_subset_keys_y($arg, { of => 1});
15              
16 5         14 my $guts = {};
17              
18 5 100       26 if (my $of = $arg->{of}) {
19 2 100 66     224 Carp::croak("invalid 'of' argument to //any") unless
20             Scalar::Util::reftype $of eq 'ARRAY' and @$of;
21              
22 1         4 $guts->{of} = [ map {; $rx->make_schema($_) } @$of ];
  2         8  
23             }
24              
25 4         12 return $guts;
26             }
27              
28             sub assert_valid {
29 120 100   120 0 30982 return 1 unless $_[0]->{of};
30              
31 54         99 my ($self, $value) = @_;
32              
33 54         59 my @failures;
34 54         61 for my $i (0 .. $#{ $self->{of} }) {
  54         223  
35 106         197 my $check = $self->{of}[ $i ];
36 106 100       129 return 1 if eval { $check->assert_valid($value) };
  106         426  
37              
38 103         315 my $failure = $@;
39 103         303 $failure->contextualize({
40             type => $self->type,
41             check_path => [ [ 'of', 'key'], [ $i, 'index' ] ],
42             });
43              
44 103         268 push @failures, $failure;
45             }
46              
47             $self->fail({
48 51         324 error => [ qw(none) ],
49             message => "matched none of the available alternatives",
50             value => $value,
51             failures => \@failures,
52             });
53             }
54              
55 54     54 0 240 sub subname { 'any' }
56              
57             1;
58              
59             __END__