use 5.012;
use warnings;
use CPANPLUS::Backend;
use Storable qw(nstore);
use Data::Dumper qw(Dumper);
use Getopt::Long qw(GetOptions);
use File::Spec::Functions qw(catfile);
warn ">> started '$0'\n";
# parse commandline options
my @spec = (
'module=s@',
'url=s',
'verbose=i',
);
my %a = ();
GetOptions(\%a, @spec) or die ">> invalid option(s)";
# defaults
$a{module} //= [];
$a{url} //= 'http://cpan.strawberryperl.com';
$a{verbose} //= 1;
$a{interactivity} //= 0; # 1 = allow_build_interactivity
### SUBROUTINES
sub get_cpanplus_backend {
my %args = @_;
warn ">> creating CPANPLUS::Backend\n";
my $cb = CPANPLUS::Backend->new();
my $conf = $cb->configure_object();
for (keys %args) {
if ($_ eq 'url' && $args{$_}) {
my $url = $args{url};
$url = "$url/" unless $url =~ m|/$|;
warn ">> using cpan mirror '$url'\n";
my ($scheme, $host, $path) = $url =~ m|(.*?)://(.*?)(/.*)|;
$conf->set_conf('hosts', [ {scheme=>$scheme, path=>$path, host=>$host} ]);
}
else {
warn">> set_conf('$_' => '$args{$_}')\n";
$conf->set_conf($_ => $args{$_});
}
}
return $cb;
}
sub save_output {
my ($data, $out_nstore, $out_dumper) = @_;
if ($out_nstore) {
warn ">> storing results via Storable to '$out_nstore'\n";
nstore($data, $out_nstore) or die ">> store failed";;
}
if ($out_dumper) {
warn ">> storing results via Data::Dumper to '$out_nstore'\n";
open my $fh, ">", $out_dumper or die ">> open: $!";
print $fh Dumper($data) or die ">> print: $!";
close $fh or die ">> close: $!";
}
}
### MAIN
die ">> no modules specified" unless scalar(@{$a{module}});
my %cfg = (verbose => $a{verbose});
my $success = 1;
my $cb = get_cpanplus_backend( url=>$a{url}, %cfg );
for my $name (@{$a{module}}) {
warn ">> Uninstalling '$name'\n";
warn ">> ########### PARSE\n";
my $mod_obj = $cb->parse_module(module=>$name);
warn ">> ########### UNINSTALL\n";
my $rv = $mod_obj->uninstall(type=>'all');
warn ">> result:uninstall=" . ($rv//'undef') . "\n";
$success = 0 unless $rv;
}
die ">> FAILUE\n" unless $success;
warn ">> done!\n";
exit 0;