File Coverage

inc/My/Module/Recommend/Any.pm

Criterion	Covered	Total	%
statement	27	54	50.0
branch	1	18	5.5
condition	1	3	33.3
subroutine	9	14	64.2
pod	4	4	100.0
total	42	93	45.1

package My::Module::Recommend::Any;

use 5.006002;

use strict;
use warnings;

use Carp;
use Exporter qw{ import };

our $VERSION = '0.028';

our @EXPORT_OK = qw{ __any };

use constant RECOMMEND_TEMPLATE_SINGLE	=> "    * %s is not available.\n";
use constant RECOMMEND_TEMPLATE_MULTI	=> "    * None of %s is available.\n";

sub __any {
    my ( @args ) = @_;
    return __PACKAGE__->new( @args );
}

sub new {
    my ( $class, @modules ) = @_;
    @modules > 1
	or croak 'Must specify at least one module and a message';
    my $msg = pop @modules;
    $msg =~ s/ ^\s* /      /smxg;

    return bless {
	modules	=> \@modules,
	message	=> $msg,
    }, ref $class || $class;
}

sub check {
    my ( $self ) = @_;
    my @missing;
    foreach my $m ( $self->modules() ) {
	$self->__is_module_available( $m )
	    and return;
	push @missing, $m;
    }
    return @missing;
}

sub __is_module_available {
    my ( undef, $m ) = @_;
    my ( $mod, $ver ) = 'ARRAY' eq ref $m ? @{ $m } : ( $m );
    my @eval = ( "require $mod;" );
    defined $ver
	and push @eval, "$mod->VERSION( $ver );";
    eval "@eval 1;"
	and return $m;
    return;
}

sub modules {
    my ( $self ) = @_;
    return (
	map { 'ARRAY' eq ref $_ ? $_->[0] : $_ }
	@{ $self->{modules} }
    );
}

sub recommend {
    my ( $self ) = @_;
    my @missing = $self->check()
	or return;
    my $tplt = @missing > 1 ?
	$self->RECOMMEND_TEMPLATE_MULTI() :
	$self->RECOMMEND_TEMPLATE_SINGLE();
    return sprintf( $tplt, join ', ', _module_stringify( @missing ) ) .
	$self->{message};
}

sub _module_stringify {
    my @arg = @_;
    my @rslt;
    foreach my $m ( @arg ) {
	push @rslt, 'ARRAY' eq ref $m ? "@{ $m }" : $m;
    }
    return @rslt;
}

1;

__END__