src/slots.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 slot_key split_slot_key bare_name spin_start spin_tick spin_stop);
use mplib::db qw(read_db);
use mplib::portformat qw(resolve_slot);
use mplib::resolve qw(init all_ports try_pkgconf);
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
fail("slots needs a package name") unless @ARGV;
init();
 
my $name = bare_name($ARGV[0]);
my $db = read_db();
 
# mirrors find_portdir's own candidate scan (mplib::resolve) exactly --
# every port directory declaring this pkg_name, its resolve_slot()'d
# effective slot (raw pkg_slot plus any enabled pkg_slot_use suffix, as
# currently configured) and pkg_pref -- so "auto-picked" here is never
# wrong relative to what a bare "mp install $name" would actually resolve
# to (find_portdir's own tie-break: lowest pkg_pref among ALL candidates,
# installed or not).
my %bySlot;
spin_start("resolving dependencies...");
for my $p (all_ports())
{
	spin_tick();
	my $pc = try_pkgconf($p->{dir});
	next unless $pc && $pc->{pkg_name} eq $name;
	my $slot = resolve_slot($pc, $pc->{pkg_name}) || '0';
	$bySlot{$slot} = { dir => $p->{dir}, slot => $slot, pref => ($pc->{pkg_pref} || 50) };
}
spin_stop();
fail("no port declares pkg_name $name") unless %bySlot;
 
# a pkg_slot_use port only ever shows ONE slot above -- whichever USE
# config is active right now -- but several of its slots can be
# simultaneously installed (that's the whole point of pkg_slot_use). fold
# in every db entry for this bare name too, so an installed slot that
# current config no longer produces (USE was toggled since) still shows.
for my $key (keys %$db)
{
	my ($base, $slot) = split_slot_key($key);
	next unless $base eq $name;
	$bySlot{$slot} ||= { dir => undef, slot => $slot, pref => undef };
}
 
# only candidates with a known pkg_pref (from an actual port directory,
# not a db-only leftover slot) compete for "auto-picked" -- matches
# find_portdir, which can only ever resolve to a real candidate.
my @ranked = sort { $a->{pref} <=> $b->{pref} } grep { defined $_->{pref} } values %bySlot;
my $picked = @ranked ? $ranked[0]{slot} : undef;
 
for my $m (sort { ($a->{pref} // 9**9**9) <=> ($b->{pref} // 9**9**9) || $a->{slot} cmp $b->{slot} } values %bySlot)
{
	my $canon = slot_key($name, $m->{slot});
	my @tags;
	push @tags, 'installed' if $db->{$canon};
	push @tags, 'auto-picked' if defined $picked && $m->{slot} eq $picked;
	print "$canon\t", (defined $m->{pref} ? "pref=$m->{pref}" : 'pref=?'), "\t", ($m->{dir} || '(not currently produced by any port config)');
	print "\t(" . join(', ', @tags) . ")" if @tags;
	print "\n";
}