src/tree.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 split_slot_key);
use mplib::db qw(read_db);
use mplib::resolve qw(init resolve_dep_name find_portdir try_pkgconf effective_deps);
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
fail("tree needs at least one package name") unless @ARGV;
init();
 
my $db = read_db();
 
sub tree_pkg {
	my ($dep, $cur, $seen, $depth) = @_;
	my $name = resolve_dep_name($dep, $cur, $db);
	my $src = $dep;
	$src = "$dep (-> $name)" if defined $name && $name ne $dep;
 
	print "  " x $depth, "- $src\n";
	return unless defined $name;
	return if $seen->{$name}++;
	# $name may be a slotted canon (resolve_dep_name can now return one
	# directly for an already-satisfied %tag dep) -- find_portdir needs
	# the slot split off and passed separately, or it silently fails to
	# find the directory and the tree stops recursing into it.
	my ($base, $slot) = split_slot_key($name);
	my $dir = find_portdir($base, $slot);
	return unless $dir;
	my $pc = try_pkgconf($dir);
	return unless $pc;
	for my $d (effective_deps($pc, $name))
	{
		tree_pkg($d, $name, $seen, $depth + 1);
	}
	return;
}
 
tree_pkg($_, undef, {}, 0) for @ARGV;