src/revdep.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(fail note bare_name);
use mplib::db qw(read_db linkdeps_users);
use mplib::resolve qw(init with_sysroot_scope resolved_db_key);
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
fail("revdep needs a package name") unless @ARGV;
init();
 
my $db0 = read_db();
# resolved_db_key (not a bare bare_name lookup): linkdeps.db only ever
# stores exact, possibly slotted, canons (mplib::resolve::
# resolved_slotted_deps only tracks a dependency that IS slotted), so a
# bare name for a slotted package needs the same fallback-to-its-one-
# installed-slot resolution mp remove/why/tree/update/prune already get,
# or "mp revdep <barename>" wrongly reports nothing links against it.
my $canon = resolved_db_key($ARGV[0], $db0) // bare_name($ARGV[0]);
# a package routed into a sysroot has its own linkdeps.db (and db), not
# the default ones -- both need to be read from INSIDE the swapped scope
# (mirrors remove_pkg), since $CFG->{WD} only points at the sysroot for
# the dynamic extent of the callback below, not after it returns; the
# sysroot may track a different installed slot than the default root, so
# resolve again against ITS db rather than reusing $canon blindly.
my @users;
my $swapped = with_sysroot_scope($canon, sub {
	my ($db) = @_;
	my $c = resolved_db_key($ARGV[0], $db) // $canon;
	@users = grep { $db->{$_} } linkdeps_users($c);
});
unless($swapped)
{
	@users = grep { $db0->{$_} } linkdeps_users($canon);
}
 
if(@users)
{
	print "$_\n" for @users;
}
else
{
	note("nothing currently links against $canon");
}