view release on metacpan or  search on metacpan

lib/App/pmuninstall.pm  view on Meta::CPAN

package App::pmuninstall;
use strict;
use warnings;
use File::Spec;
use File::Basename qw(dirname);
use ExtUtils::Packlist;
use Getopt::Long qw(GetOptions :config bundling);
use Config;
use YAML ();
use CPAN::DistnameInfo;
use version;
use HTTP::Tiny;
use Term::ANSIColor qw(colored);
use Cwd ();
use JSON::PP qw(decode_json);

our $VERSION = "0.33";

my $perl_version     = version->new($])->numify;
my $depended_on_by   = 'http://deps.cpantesters.org/depended-on-by.pl?dist=';
my $cpanmetadb       = 'http://cpanmetadb.plackperl.org/v1.0/package';
my @core_modules_dir = do { my %h; grep !$h{$_}++, @Config{qw/archlib archlibexp privlib privlibexp/} };

$ENV{ANSI_COLORS_DISABLED} = 1 if $^O eq 'MSWin32';

our $OUTPUT_INDENT_LEVEL = 0;

sub new {
    my ($class, $inc) = @_;
    $inc = [@INC] unless ref $inc eq 'ARRAY';
    bless {
        check_deps => 1,
        verbose    => 0,
        inc        => $class->prepare_include_paths($inc),
    }, $class;
}

sub run {
    my ($self, @args) = @_;
    local @ARGV = @args;
    GetOptions(
        'f|force'                 => \$self->{force},
        'v|verbose!'              => sub { ++$self->{verbose} },
        'c|checkdeps!'            => \$self->{check_deps},
        'n|no-checkdeps!'         => sub { $self->{check_deps} = 0 },
        'q|quiet!'                => \$self->{quiet},
        'h|help!'                 => sub { $self->usage },
        'V|version!'              => \$self->{version},
        'l|local-lib=s'           => \$self->{local_lib},
        'L|local-lib-contained=s' => sub {
            $self->{local_lib}      = $_[1];
            $self->{self_contained} = 1;
        },
    ) or $self->usage;

    if ($self->{version}) {
        $self->puts("pm-uninstall (App::pmuninstall) version $App::pmuninstall::VERSION");
        exit;
    }

    $self->short_usage unless @ARGV;

    $self->uninstall(@ARGV);
}

sub uninstall {
    my ($self, @modules) = @_;

    $self->setup_local_lib;

    my $uninstalled = 0;
    for my $module (@modules) {
        $self->puts("--> Working on $module") unless $self->{quiet};
        my ($packlist, $dist, $vname) = $self->find_packlist($module);

        $packlist = File::Spec->canonpath($packlist);
        if ($self->is_core_module($module, $packlist)) {
            $self->puts(colored ['red'], "! $module is a core module!! Can't be uninstalled.");
            $self->puts unless $self->{quiet};
            next;
        }

        unless ($dist) {
            $self->puts(colored ['red'], "! $module not found.");
            $self->puts unless $self->{quiet};
            next;
        }

        unless ($packlist) {
            $self->puts(colored ['red'], "! $module is not installed.");
            $self->puts unless $self->{quiet};
            next;
        }

        if ($self->ask_permission($module, $dist, $vname, $packlist)) {
            if ($self->uninstall_from_packlist($packlist)) {
                $self->puts(colored ['green'], "Successfully uninstalled $module");
                ++$uninstalled;
            }
            else {