#!perl

use strict;
use warnings;
use File::Spec;
use File::Basename qw/dirname/;
use Getopt::Long qw/GetOptions :config bundling/;
use Pod::Usage qw/pod2usage/;
use Config;
use ExtUtils::MakeMaker;
use LWP::Simple;
use YAML;
use CPAN::DistnameInfo;
use Module::CoreList;
use version;

use App::pmuninstall;

my $perl_version = version->new($])->numify;
my $base_url = 'http://deps.cpantesters.org/depended-on-by.pl?dist=';
my $cpanmetadb = 'http://cpanmetadb.appspot.com/v1.0/package';
my $uninstalled = 0;

my @inc = @INC;
my @core_modules_dir = do { my %h; grep !$h{$_}++, @Config{qw/archlib archlibexp privlib privlibexp/} };

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

pod2usage 1 if $opt->{help};

if ($opt->{version}) {
    warn "App::pmuninstall v$App::pmuninstall::VERSION\n"; 
    exit;
}

pod2usage 1 if !@ARGV;

main(@ARGV);
exit;

sub main {
    my @modules = @_;

    if ($opt->{local_lib}) {
        setup_local_lib($opt->{local_lib}, $opt->{self_contained});
    }

    for my $module (@modules) {
        my($packlist, $dist, $vname) = find_packlist($module);

        unless ($dist) {
            warn "$module is not found.\n";
            next;
        }

        unless ($packlist) {
            warn "$module is not installed.\n";
            next;
        }

        $packlist = File::Spec->catfile($packlist);

        if (is_core_module($module, $packlist)) {
            warn "$module is Core Module!! Can't be uninstall.\n";
            next;
        }

        if ($opt->{force} or ask_permission($module, $dist, $vname, $packlist, $opt->{local_lib})) {
            if (uninstall_from_packlist($packlist, $opt->{local_lib})) {
                warn "$module is successfully uninstalled.\n\n";
                $uninstalled++;
            }
            else {
                warn "! $module is failed uninstall.\n";
            }
        }
    }

    if ($uninstalled) {
        warn "You may want to rebuild man(1) entires. Try `mandb -c` if needed\n"
    }
}

sub vname_for {
    my $module = shift;

    my $yaml = get("$cpanmetadb/$module") or return;
    my $meta = YAML::Load($yaml);
    my $info = CPAN::DistnameInfo->new($meta->{distfile}) or return;

    return $info->distvname;
}

sub ask_permission {
    my($module, $dist, $vname, $packlist, $local_lib_base) = @_;

    my(@deps, %seen);
    if ($opt->{check_deps}) {
        $vname ||= vname_for($module) || $module;
        warn "Checking modules depending on $vname\n" if $opt->{verbose};
        warn "-> Getting from $base_url$vname\n" if $opt->{verbose};
        my $content = get("$base_url$vname") || '';
        for my $dep ($content =~ m|<li><a href=[^>]+>([a-zA-Z0-9_:-]+)|smg) {
            $dep =~ s/^\s+|\s+$//smg; # trim
            next if $seen{$dep}++;
            push @deps, $dep if locate_pack($dep);
        }
    }

    warn "$module is included in the distribution $dist and contains:\n\n";

    for (fixup_packilist($packlist, $local_lib_base)) {
        warn "  $_";
    }
    warn "\n";

    my $default = 'y';
    if (@deps) {
        warn "Also, they're depended on by the following dists you have:\n\n";
        for my $dep (@deps) {
            warn "  $dep\n";
        }
        warn "\n";
        $default = 'n';
    }

    lc(prompt("Are you sure to uninstall $dist?", $default)) eq 'y';
}

sub find_packlist {
    my $module = shift;

    warn "Finding $module in your \@INC\n" if $opt->{verbose};

    # find with the given name first
    (my $try_dist = $module) =~ s!::!-!g;
    my $pl = locate_pack($try_dist);
    return ($pl, $try_dist) if $pl;

    warn "Looking up $module on cpanmetadb\n" if $opt->{verbose};

    # map module -> dist and retry
    my $yaml = get("$cpanmetadb/$module") or return;
    my $meta = YAML::Load($yaml);
    my $info = CPAN::DistnameInfo->new($meta->{distfile});

    my $pl2 = locate_pack($info->dist);
    return ($pl2, $info->dist, $info->distvname);
}

sub is_core_module {
    my ($dist, $packlist) = @_;
    return unless exists $Module::CoreList::version{$perl_version}{$dist};

    my $is_core = 0;
    for my $dir (@core_modules_dir) {
        if ($packlist =~ /^$dir/) {
            $is_core = 1;
            last;
        }
    }

    return $is_core;
}

sub locate_pack {
    my $dist = shift;
    $dist =~ s!-!/!g;

    for my $lib (@inc) {
        my $packlist = "$lib/auto/$dist/.packlist";
        return $packlist if -f $packlist && -r _;
    }

    return;
}

sub uninstall_from_packlist {
    my ($packlist, $local_lib_base) = @_;

    my $inc = {
        map { File::Spec->catfile($_) => 1 } @inc
    };

    my $failed;
    for my $file (fixup_packilist($packlist, $local_lib_base)) {
        chomp $file;
        print -f $file ? 'unlink   ' : 'not found', " : $file\n" if $opt->{verbose};
        unlink $file or warn "$file: $!\n" and $failed++;
        rm_empty_dir_from_file($file, $inc);
    }
    print "unlink    : $packlist\n" if $opt->{verbose};
    unlink $packlist or warn "$packlist: $!\n" and $failed++;
    rm_empty_dir_from_file($packlist, $inc);

    print "\n" if $opt->{verbose};

    return !$failed;
}

sub fixup_packilist {
    my ($packlist, $local_lib_base) = @_;
    my @target_list;
    my $is_local_lib = is_local_lib($packlist, $local_lib_base);
    open my $in, "<", $packlist or die "$packlist: $!";
    while (my $file = <$in>) {
        if ($is_local_lib) {
            next unless is_local_lib($file, $local_lib_base);
        }
        push @target_list, $file;
    }
    return @target_list;
}

sub is_local_lib {
    my ($file, $local_lib_base) = @_;
    return 0 unless exists $INC{'local/lib.pm'};

    $local_lib_base ||= '~/perl5';
    $local_lib_base = quotemeta File::Spec->catfile(Cwd::realpath($local_lib_base));
    $file = File::Spec->catfile($file);

    return $file =~ /^$local_lib_base/ ? 1 : 0;
}

sub is_empty_dir {
    my ($dir) = @_;
    opendir my $dh, $dir or die "$dir: $!";
    my @dir = grep !/^\.{1,2}$/, readdir $dh;
    closedir $dh;
    return @dir ? 0 : 1;
}

sub rm_empty_dir_from_file {
    my ($file, $inc) = @_;
    my $dir = dirname $file;
    return unless -d $dir;
    return if $inc->{+File::Spec->catfile($dir)};

    my $failed;
    if (is_empty_dir($dir)) {
        print "rmdir     : $dir\n" if $opt->{verbose};
        rmdir $dir or warn "$dir: $!\n" and $failed++;
        rm_empty_dir_from_file($dir, $inc);
    }

    return !$failed;
}

# taken from cpan-outdated
sub setup_local_lib {
    my ($base, $self_contained) = @_;
    $base ||= '~/perl5/';

    require local::lib;
    local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
    @inc = map { Cwd::realpath($_) } split $Config{path_sep},
        +{local::lib->build_environment_vars_for($base, $self_contained ? 0 : 1)}->{PERL5LIB};
    push @inc, @INC unless $self_contained;
}


__END__

=head1 NAME

  pm-uninstall - Uninstall modules

=head1 SYNOPSIS

  pm-uninstall [options] Module ...

  options:
      -v,--verbose                  Turns on chatty output
      -f,--force                    Uninstalls without prompts
      -c,--checkdeps                Check dependencies ( default on )
      -n,--no-checkdeps             Not check dependencies
      -h,--help                     This help message
      -V,--version                  Show version
      -l,--local-lib                Additional module path
      -L,--local-lib-contained      Additional module path (don't include non-core modules)

=cut