cpandupmetaclean

cpandupmetaclean

#!/usr/bin/env perl
use strict;
use warnings;
use 5.008001;
use Config qw(%Config);
use File::Find;
use File::Path;
use JSON;
use Getopt::Long;
use version 0.77;

my $yes = 0;
GetOptions('yes' => \$yes);

main();

sub main {
    my $libdir = "local/lib/perl5/$Config{archname}/.meta";
    die("cannnot find $libdir") unless -e $libdir;

    my $installs   = +{};
    my $duplicates = +{};
    my $wanted = sub {
        if ($_ eq 'install.json') {
            my $module = load_json($_) or die("load_json fail at $_");
            $module->{metadir} = $File::Find::dir;
            if ( $installs->{$module->{name}} ) {
                $duplicates->{$module->{name}} = 1;
                push @{$installs->{$module->{name}}}, $module;
            }
            else {
                $installs->{$module->{name}} = [$module];
            }
        }
    };
    File::Find::find($wanted, $libdir);

    if ( !%{$duplicates} ) {
        print "Cannot find duplicate modules.\n";
        return;
    }

    print sprintf("Find %d Duplicate modules\n", scalar keys %{$duplicates});

    my $sorted_installs = {};
    for my $duplicate ( sort keys %{$duplicates} ) {
        print $duplicate, "\n";

        $sorted_installs->{$duplicate} = [
            sort { version->parse($b->{version}) <=> version->parse($a->{version}) }
            @{$installs->{$duplicate}}
        ];

        print " * " . $sorted_installs->{$duplicate}[0]{version}, "\n";

        my $last_index = @{$sorted_installs->{$duplicate}} - 1;
        print "   " . (join "\n   ", map { $_->{version} } @{$sorted_installs->{$duplicate}}[1 .. $last_index] );
        print "\n";
    }

    confirm() or return;

    print "\n";

    for my $duplicate ( sort keys %{$duplicates} ) {
        print "$duplicate : Delete .meta directories...", "\n";

        my $last_index = @{$sorted_installs->{$duplicate}} - 1;
        for my $module ( @{$sorted_installs->{$duplicate}}[1 .. $last_index] ) {
            print $module->{version} . " " . $module->{metadir}, "\n";
            rmtree($module->{metadir}, 1);
        }
        print "\n";
    }
}

sub confirm {
    return 1 if $yes;

    my $answer;
    while ( !defined $answer ) {
        print "Clean old .meta directories?(Y/n)";
        $answer = <>;
        chomp($answer);

        if ( $answer eq '' || $answer =~ m/^[Yy]/ ) {
            $answer = 1;
        }
        elsif ( $answer =~ m/^[Nn]/ ) {
            $answer = 0;
        }
        else {
            $answer = undef;
        }
    }
    return $answer;
}

sub load_json {
    my $file = shift;

    open my $fh, "<", $file or die "$file: $!";
    decode_json(join '', <$fh>);
}