File Coverage

blib/lib/App/installdeps.pm

Criterion	Covered	Total	%
statement	64	72	88.8
branch	27	36	75.0
condition	21	28	75.0
subroutine	11	12	91.6
pod	1	1	100.0
total	124	149	83.2

package App::installdeps;

use strict;
use warnings;

# ABSTRACT: A tiny script to install dependent modules
our $VERSION = 'v0.0.3'; # VERSION

use Getopt::Std;
use Getopt::Config::FromPod;
use Pod::Usage;

use Module::ExtractUse;
use File::Find;
use version 0.77;

sub _exists
{
	my $module = shift;
	unless($module =~ /\.pm$/) {
		$module =~ s@::@/@g;
		$module .= '.pm';
	}
	for my $prefix (@INC) {
		my $path = "$prefix/$module";
		return $path if -e $path;
	}
	return;
}

sub _process
{
	local (@ARGV) = @_;

	my %opts;
	getopts(Getopt::Config::FromPod->string, \%opts);
	pod2usage(-verbose => 2) if exists $opts{h};
	pod2usage(-msg => 'At least one argument MUST be specified', -verbose => 0, -exitval => 1) if ! @ARGV;
	$opts{i} ||= 'cpanm';

	my $p = Module::ExtractUse->new;

	while(my $arg = shift @ARGV) {
		if(-f $arg) { $p->extract_use($arg); }
		elsif(-d $arg) {
			find({ no_chdir => 1, wanted => sub {
				$p->extract_use($_) if -f $_;
			}}, $arg);
		} else {
			warn "can't recognize argument: $arg";
		}
	}
	my @target;
	my %checked;
	my @candidate = keys %{exists $opts{r} ? $p->used_out_of_eval || {}: $p->used || {}};
	while(my $candidate = shift @candidate) {
		next if version::is_lax($candidate);
		my $path;
		$path = _exists($candidate) if ! exists $opts{u} || exists $opts{R};
		next if exists $opts{x} && $candidate =~ /$opts{x}/;
		next if ! exists $opts{X} && $candidate =~ /\$/;
		next if exists $checked{$candidate};
		$checked{$candidate} = 1;
		if(defined $path && exists $opts{R}) {
			my $pp = Module::ExtractUse->new;
			$pp->extract_use($path);
			push @candidate, grep { ! exists $checked{$_} } keys %{exists $opts{r} ? $pp->used_out_of_eval || {} : $pp->used || {}};
		}
		next if ! exists $opts{u} && defined $path;
		push @target, $candidate;
	}
	return (\%opts, \@target);
}

sub run
{
	shift if @_ && eval { $_[0]->isa(__PACKAGE__) };
	my ($opts, $target) = _process(@_);

	if($opts->{n}) {
		print join(' ', @$target), "\n";
	} else {
		print $opts->{i},' ',join(' ', @$target), "\n";
		system $opts->{i},@$target;
	}
}

1;

__END__