File Coverage

inc/My/Module/Recommend/Any.pm
Criterion Covered Total %
statement 27 40 67.5
branch 1 8 12.5
condition 1 3 33.3
subroutine 9 12 75.0
pod 4 4 100.0
total 42 67 62.6


line stmt bran cond sub pod time code
1             package My::Module::Recommend::Any;
2              
3 1     1   25 use 5.008;
  1         4  
4              
5 1     1   6 use strict;
  1         1  
  1         27  
6 1     1   5 use warnings;
  1         1  
  1         67  
7              
8 1     1   6 use Carp;
  1         1  
  1         141  
9 1     1   8 use Exporter qw{ import };
  1         2  
  1         97  
10              
11             our $VERSION = '0.048';
12              
13             our @EXPORT_OK = qw{ __any };
14              
15 1     1   7 use constant RECOMMEND_TEMPLATE_SINGLE => " * %s is not available.\n";
  1         2  
  1         114  
16 1     1   7 use constant RECOMMEND_TEMPLATE_MULTI => " * None of %s is available.\n";
  1         2  
  1         608  
17              
18             sub __any {
19 5     5   16 my ( @args ) = @_;
20 5         12 return __PACKAGE__->new( @args );
21             }
22              
23             sub new {
24 6     6 1 13 my ( $class, @modules ) = @_;
25 6 50       16 @modules > 1
26             or croak 'Must specify at least one module and a message';
27 6         8 my $msg = pop @modules;
28 6         36 $msg =~ s/ ^\s* / /smxg;
29              
30 6   33     49 return bless {
31             modules => \@modules,
32             message => $msg,
33             }, ref $class || $class;
34             }
35              
36             sub check {
37 0     0 1   my ( $self ) = @_;
38 0           my @missing;
39 0           foreach my $m ( $self->modules() ) {
40 0 0         eval "require $m; 1"
41             and return;
42 0           push @missing, $m;
43             }
44 0           return @missing;
45             }
46              
47             sub modules {
48 0     0 1   my ( $self ) = @_;
49 0           return @{ $self->{modules} };
  0            
50             }
51              
52             sub recommend {
53 0     0 1   my ( $self ) = @_;
54 0 0         my @missing = $self->check()
55             or return;
56 0 0         my $tplt = @missing > 1 ?
57             $self->RECOMMEND_TEMPLATE_MULTI() :
58             $self->RECOMMEND_TEMPLATE_SINGLE();
59             return sprintf( $tplt, join ', ', @missing ) .
60 0           $self->{message};
61             }
62              
63             1;
64              
65             __END__