src/prune.pl

#!/usr/bin/env perl
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use mplib::config qw($CFG);
use mplib::util qw(ok confirm spin_start spin_tick spin_stop);
use mplib::db qw(read_db);
use mplib::resolve qw(init remove_pkg reachable_needed_set);
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
init();
 
my $dodry = grep { $_ eq '--dry-run' } @ARGV;
my $db = read_db();
 
# the transitive RUNTIME-dependency closure over every explicitly
# requested package (not build-only pkg_bdepend/USE:b: deps -- those
# legitimately become prunable once whatever needed them to build is
# already built) -- shared with install_pkg_body's own soft-conflict
# auto-resolution now, see mplib::resolve::reachable_needed_set's own
# comment. spin_tick passed through as the tick callback so this
# whole-installed-db walk still animates the same "resolving
# dependencies..." spinner it always has.
spin_start("resolving dependencies...");
my $need = reachable_needed_set($db, \&spin_tick);
spin_stop();
# drop non-requested packages nothing needed pulled in.
my @drop = sort grep { !$need->{$_} } keys %$db;
if(!@drop)
{
	ok("nothing to prune");
	exit 0;
}
confirm("prune: " . join(' ', @drop) . " -- continue?") unless $dodry;
for my $name (@drop)
{
	if($dodry)
	{
		print "would remove: $name\n";
		next;
	}
	remove_pkg($name, $db);
}