File Coverage

blib/lib/Sub/Meta/Creator.pm
Criterion Covered Total %
statement 39 39 100.0
branch 14 14 100.0
condition 3 3 100.0
subroutine 11 11 100.0
pod 5 5 100.0
total 72 72 100.0


line stmt bran cond sub pod time code
1             package Sub::Meta::Creator;
2 6     6   400339 use strict;
  6         26  
  6         196  
3 6     6   29 use warnings;
  6         9  
  6         215  
4              
5             our $VERSION = "0.15";
6              
7 6     6   28 use List::Util ();
  6         11  
  6         82  
8 6     6   1597 use Sub::Meta;
  6         16  
  6         1801  
9              
10 5     5   21 sub _croak { require Carp; goto &Carp::croak }
  5         480  
11              
12             sub new {
13 18     18 1 24477 my ($class, @args) = @_;
14 18 100       121 my %args = @args == 1 ? %{$args[0]} : @args;
  1         4  
15              
16 18 100       51 unless (exists $args{finders}) {
17 1         3 _croak 'required finders';
18             }
19              
20 17 100 100     96 unless (ref $args{finders} && ref $args{finders} eq 'ARRAY') {
21 2         5 _croak 'finders must be an arrayref'
22             }
23              
24 15 100   17   60 unless (List::Util::all { ref $_ && ref $_ eq 'CODE' } @{$args{finders}}) {
  17 100       90  
  15         85  
25 2         3 _croak 'elements of finders have to be a code reference'
26             }
27              
28 13         66 return bless \%args => $class;
29             }
30              
31 8     8 1 70 sub sub_meta_class { return 'Sub::Meta' }
32              
33 15     15 1 26 sub finders { my $self = shift; return $self->{finders} }
  15         113  
34              
35             sub find_materials {
36 14     14 1 48 my ($self, $sub) = @_;
37 14         23 for my $finder (@{$self->finders}) {
  14         36  
38 18         49 my $materials = $finder->($sub);
39 18 100       107 return $materials if defined $materials;
40             }
41 5         21 return;
42             }
43              
44             sub create {
45 10     10 1 36 my ($self, $sub) = @_;
46 10 100       39 if (my $materials = $self->find_materials($sub)) {
47 7         28 return $self->sub_meta_class->new($materials)
48             }
49 3         28 return;
50             }
51              
52             1;
53             __END__