#!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;

my $base_url = 'http://deps.cpantesters.org/depended-on-by.pl?dist=';
my $cpanmetadb = 'http://cpanmetadb.appspot.com/v1.0/package';

our $VERSION = "0.04";

my $opt = +{};
GetOptions(
    'f|force'                 => \$opt->{force},
    'v|verbose!'              => \$opt->{verbose},
    'c|checkdeps'             => \$opt->{check_deps},
    'h|help!'                 => \$opt->{help},
    '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} or !@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 ($packlist) {
            warn "Module $module not installed\n";
            next;
        }

        if ($opt->{force} or ask_permission($module, $dist, $vname, $packlist, $opt->{local_lib})) {
            uninstall_from_packlist($packlist, $opt->{local_lib});
            warn "Module $module successfully uninstalled.\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);
        warn "Checking modules depending on $vname\n" if $opt->{verbose};
        my $content = get("$base_url$vname");
        for my $dep ($content =~ m|<th align=left>([^<]+)</th>|smg) {
            $dep =~ s/\-[^\-]+$//; # version
            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) if $pl2;

    return;
}

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
    };

    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";
        rm_empty_dir_from_file($file, $inc);
    }
    print "unlink    : $packlist\n" if $opt->{verbose};
    unlink $packlist;
    rm_empty_dir_from_file($packlist, $inc);

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

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 = File::Spec->catfile($local_lib_base);
    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)};

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

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

    require local::lib;
    if ($self_contained) {
        @INC = (
            local::lib->install_base_perl_path($base),
            local::lib->install_base_arch_path($base),
            @Config{qw(privlibexp archlibexp)},
        );
    }

    local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
    local::lib->import($base);
}


__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
      -h,--help                     This help message
      -l,--local-lib                Additional module path
      -L,--local-lib-contained      Additional module path (don't include non-core modules)

=cut
