Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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>);
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment