prt-auf: use Fun's algorithm instead of Kahn's

This commit is contained in:
John McQuah 2023-05-24 08:57:02 -04:00
parent 646e3b74a3
commit bc438288c5

View File

@ -672,26 +672,37 @@ sub port_diff { # find differences between the pkgdb and the repo
sub deporder { # returns a sorted list of packages required.
my $type=shift; my @seeds=@_; our @treewalk=(); our %missing;
our %numPred = map { $_ => 0 } @seeds; our %children; my @result;
our %level = map { $_ => 1 } @seeds; our $maxLevel=1; my @result;
# determine the minimal set of targets needed to satisfy all dependencies
foreach my $t (@seeds) { recurse_deptree(0,$t); }
foreach my $t (@seeds) { recurse_deptree(0,1,$t); }
sub recurse_deptree {
my $greedy=shift; my $s=shift; my %curdeps;
my $greedy=shift; my $thisLevel=shift; my $s=shift; my %curdeps;
# detect any dependencies that have been dropped from the repositories
if (! $V_REPO{$s}) { $missing{$s}=1; undef $numPred{$s}; return; }
if (! $V_REPO{$s}) { $missing{$s}=1; delete $level{$s}; return; }
# cycle detection
( grep /^$s$/, @treewalk ) ? return : push(@treewalk, $s);
if (grep /^$s$/, @treewalk) {
return if ($greedy == 1);
print "Dependency cycle found: ";
foreach (@treewalk) { print "$_ => "; }
print "$s\n";
} else { push(@treewalk, $s); }
# update the hash table and the height of the tree
if ( (! $level{$s}) or ($level{$s} < $thisLevel) ) {
$level{$s} = $thisLevel;
}
if ( $maxLevel < $thisLevel ) { $maxLevel = $thisLevel; }
%curdeps = map { $_ => $greedy } split /[ ,]/, $DEPENDS{$s};
# if the user toggles --softdeps, consider the optional dependencies
# that are already installed or are given on the command line
if ($odepends{soft} == 1) {
foreach (grep { ($V_INST{$_}) or ($numPred{$_}) }
foreach (grep { ($V_INST{$_}) or ($level{$_}) }
split /[ ,]/, $SOFTDEPS{$s}) {
$curdeps{$_} = 1;
}
@ -700,36 +711,21 @@ sub deporder { # returns a sorted list of packages required.
foreach my $sd (keys %curdeps) {
my $subit = who_aliased_to($sd);
if ($subit) {
$children{$s} .= " $subit ";
$numPred{$subit} += 1 unless ($greedy == 1);
recurse_deptree($curdeps{$sd},$subit);
recurse_deptree($curdeps{$sd},$thisLevel+1,$subit);
} else {
$children{$s} .= " $sd ";
$numPred{$sd} += 1 unless ($greedy == 1);
recurse_deptree($curdeps{$sd},$sd);
recurse_deptree($curdeps{$sd},$thisLevel+1,$sd);
}
}
pop (@treewalk);
} # proceed with the topological sort
# initialize a queue of nodes with in-degree zero (nothing depends on them)
my @indZero = grep { ($numPred{$_} == 0) } keys %numPred;
# move each node from the queue to the sorted list, and reduce by 1 the
# in-degree of its dependencies (Kahn 1962)
while (my $q = shift @indZero) {
push(@result, $q);
next if (! $children{$q});
foreach my $s (split / /, $children{$q}) {
$numPred{$s} -= 1;
push(@indZero,$s) if ($numPred{$s} == 0);
}
# gather up all the targets farthest from the root of the tree,
# then reduce by 1 the level at which to search.
while ($maxLevel >= 1) {
push(@result, grep { ($level{$_} == $maxLevel) } keys %level);
$maxLevel -= 1;
}
# the resulting list is backwards (dependencies come after the packages they
# support), and must be reversed.
@result = reverse @result;
if ((keys %missing > 0) and ($type ne "quickdep")) { push (@result, "MISSING", sort(keys %missing)); }
return @result;
}