src/manifest_clean.pl

#!/usr/bin/env perl
# mp manifest_clean <pkg...> -- deletes every file a package's own
# manifest lists, directly, without touching the db entry or running
# any remove:/del.sh phase. distinct from "mp remove" (which does all
# of that, PLUS this) and from "mp clean" (which only ever clears a
# port's stage/build dir, never a live installed file) -- this exists
# for the narrower, more surgical case: a package whose db/manifest
# and on-disk files have drifted out of sync (the exact shape of bug
# this tree's own mp_sysroot_inplace_install and gcc/cmake db-tracking
# incidents both were) and the fastest fix is "just delete what the
# manifest says is there," without a full uninstall/reinstall cycle.
#
# deliberately does NOT consult pkg_manifest_cleanup: that flag exists
# to stop mp's own AUTOMATIC internal sweep (mplib::resolve::
# clean_manifest_files, fired as a side effect of reinstall/remove)
# from fighting a port that manages its own complete removal, or from
# deleting files a port deliberately leaves behind (meta/mp itself).
# checking it here would need re-resolving the port's own pkg.conf,
# which may not even exist in the tree anymore -- and this command is
# a direct, explicitly-named, manually-confirmed action in the first
# place, not an incidental side effect; the y/N prompt below (showing
# the exact file list, not just a package name) is the real safety
# gate, the same way a human choosing "rm -rf" over "make uninstall"
# is already accepting responsibility for what that means.
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use mplib::config qw($CFG);
use mplib::util qw(fail note ok confirm bare_name);
use mplib::db qw(read_lines read_db);
use mplib::resolve qw(init resolved_db_key);
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
fail("pkg name required") unless @ARGV;
init();
 
my $db = read_db();
 
for my $arg (@ARGV)
{
	# resolved_db_key, not a bare bare_name lookup: same reasoning as
	# mp files -- a bare name for a slotted package needs to resolve to
	# whichever one slot is actually installed, or this silently misses
	# a manifest that's really there under its slotted canon.
	my $canon = resolved_db_key($arg, $db) // bare_name($arg);
	my $manfile = "$CFG->{MANDIR}/$canon";
	my @files = read_lines($manfile);
	unless(@files)
	{
		note("no manifest for $canon (not installed, or installed before manifest tracking)");
		next;
	}
 
	my @present = grep { -e "$CFG->{INSTPREFIX}/$_" || -l "$CFG->{INSTPREFIX}/$_" } @files;
	unless(@present)
	{
		note("$canon: manifest lists " . scalar(@files) . " file(s), none still present on disk");
		next;
	}
 
	print "$canon:\n";
	print "  $CFG->{INSTPREFIX}/$_\n" for @present;
	confirm("manifest_clean: delete the " . scalar(@present) . " file(s) listed above, tracked by ${canon}'s own manifest -- continue?");
 
	# directories deferred to their own pass, deepest first (rmdir, not
	# unlink -- always fails on a directory otherwise), so a directory's
	# own children are already gone by the time its own rmdir runs. a
	# directory anything else still lives in (another package's own
	# file sharing it, or simply not everything under it was in THIS
	# manifest) fails silently (ENOTEMPTY) rather than erroring -- the
	# same safe, deliberate no-op mp's own automatic manifest sweep
	# already relies on.
	my ($n, @dirs) = (0);
	for my $rel (@present)
	{
		my $abs = "$CFG->{INSTPREFIX}/$rel";
		if(-d $abs && !-l $abs) { push @dirs, $abs; next; }
		$n++ if unlink($abs);
	}
	for my $d (sort { length($b) <=> length($a) } @dirs)
	{
		$n++ if rmdir($d);
	}
	ok("$canon: removed $n of " . scalar(@present) . " manifest file(s)/dir(s)");
}