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   447757 use strict;
  6         24  
  6         179  
3 6     6   38 use warnings;
  6         11  
  6         239  
4              
5             our $VERSION = "0.14";
6              
7 6     6   34 use List::Util ();
  6         21  
  6         118  
8 6     6   2003 use Sub::Meta;
  6         16  
  6         2088  
9              
10 5     5   25 sub _croak { require Carp; goto &Carp::croak }
  5         577  
11              
12             sub new {
13 18     18 1 30455 my ($class, @args) = @_;
14 18 100       72 my %args = @args == 1 ? %{$args[0]} : @args;
  1         3  
15              
16 18 100       54 unless (exists $args{finders}) {
17 1         3 _croak 'required finders';
18             }
19              
20 17 100 100     113 unless (ref $args{finders} && ref $args{finders} eq 'ARRAY') {
21 2         5 _croak 'finders must be an arrayref'
22             }
23              
24 15 100   17   61 unless (List::Util::all { ref $_ && ref $_ eq 'CODE' } @{$args{finders}}) {
  17 100       99  
  15         96  
25 2         7 _croak 'elements of finders have to be a code reference'
26             }
27              
28 13         98 return bless \%args => $class;
29             }
30              
31 8     8 1 67 sub sub_meta_class { return 'Sub::Meta' }
32              
33 15     15 1 27 sub finders { my $self = shift; return $self->{finders} }
  15         58  
34              
35             sub find_materials {
36 14     14 1 72 my ($self, $sub) = @_;
37 14         25 for my $finder (@{$self->finders}) {
  14         35  
38 18         54 my $materials = $finder->($sub);
39 18 100       116 return $materials if defined $materials;
40             }
41 5         31 return;
42             }
43              
44             sub create {
45 10     10 1 46 my ($self, $sub) = @_;
46 10 100       35 if (my $materials = $self->find_materials($sub)) {
47 7         35 return $self->sub_meta_class->new($materials)
48             }
49 3         12 return;
50             }
51              
52             1;
53             __END__