File Coverage

inc/My/Module/Recommend/Any.pm

Criterion	Covered	Total	%
statement	33	52	63.4
branch	1	14	7.1
condition	1	6	16.6
subroutine	10	14	71.4
pod	5	5	100.0
total	50	91	54.9

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

use 5.008;

use strict;
use warnings;

use Carp;
use Exporter qw{ import };

our $VERSION = '0.057';

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;

    foreach ( @modules ) {
	my ( $name, $version ) = split qr{ = }smx, $_, 2;
	$_ = [ $name, $version ];
    }

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

sub check {
    my ( $self ) = @_;
    my @missing;
    foreach my $m ( $self->__modules() ) {
	my $msg = $self->module_is_ok( @{ $m } )
	    or return;
	push @missing, $msg;
    }
    return @missing;
}

sub module_is_ok {
    my ( undef, $name, $version ) = @_;
    local $@ = undef;
    eval "require $name; 1"
	and eval {
	not $version
	    or $name->VERSION( $version );
    } and return;
    return $version ? "$name $version" : $name;
}

sub modules {
    my ( $self ) = @_;
    return ( map { $_->[0] } $self->__modules() );
}

sub __modules {
    my ( $self ) = @_;
    return @{ $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 ', ', @missing ) .
	$self->{message};
}

1;

__END__