http://qs1969.pair.com?node_id=66553

hawson has asked for the wisdom of the Perl Monks concerning the following question:

This is, perhaps, a bit overly twisted...but that's never stopped me before. :-)

I have a hash of lists. Each key represents a software package, and the list contains the other packages that the key requires. An example:

%depend=( a => ['b','y','c'], b => [], c => ['z'], d => ['a','x','h'], );
This indicates that 'a' requires the packages 'b','y', and 'c'. Package 'b' has no dependencies, and package 'c' only requires 'z', and so on. Notice that 'y' and 'z' don't appear in keys %depend.

I want to process this hash and generate a list so that the elements are order to reduce the internal dependcies when I remove the actualy software packages. For the sample I have above, the list ('b','c','a','d') would be correct.

I have a solution that works for my test case (embedded below in the code). However, when I run it on the "real" data (a file with some 138 pakages), Perl complains about recursion limits. Also, I'm running 5.005_03 in case it matters, and it works, I think, on one machine, but not on another.

Any ideas, suggestions, or comments would be appreciated.

#!/usr/local/bin/perl -w use strict; my %depend; #this hash contains all the packages and their dependn +cies. my @pkgs; #Merely the results of keys %depend @pkgs=grep (!/^$/, keys %depend); @pkgs=grep (/\w+/, @pkgs); my %seen; my ($line,$found); #counter used later on... my @sorted; #contains the "sorted" list in order of nuking safety... # Suck in the file while (defined($_=<>)) { # print $_; @_=split (/\s/, $_); push @pkgs, @_; } # Generate the list of dependencies, stuff them into %depend # This really only applies to Solaris systems... my $basedir="/var/sadm/pkg"; my ($file,$pkg,@tmplist); foreach $pkg (@pkgs) { $file="$basedir/$pkg/install/depend"; next if (! -r $file); open (DEPEND, $file) || die "Failed to open $file for reading"; @tmplist=(); while (defined($line=&lt;DEPEND&gt;)) { chomp $line; next unless $line =~ /^P\s+(\w+)/; # skip all lines but requis +ites push @tmplist, $1; } $depend{$pkg}=[@tmplist]; } # This is my test data. # debugging data. if (1) { %depend=( a => ['b','y','c'], b => [], c => ['z'], d => ['a','x','h'], e => ['d','a'], f => ['a','b','y','c','d'], g => ['b','y'], h => ['g'], i => ['z','j'], j => ['z'], k => ['b','a','e'] ); } &PrintDepend; # Remove things in @depend not in @pkgs # i.e. if we aren't going to remove a package # then it's a non issue, and doesn't need to # be checked, or put in @sorted. my @list=(); my ($key,$item); foreach $key (keys %depend) { @list=@{$depend{$key}}; foreach $item (@list) { if (!grep(/$item/,@pkgs)) { Prune($item); } } } &PrintDepend; &PrintPkgs; #Since things can be removed at various times, # we have to process the hash until there are # no more changes, hence the do {} while loop. @list=(); do { @list=@sorted; foreach (@pkgs) { print "Recursing on $_...\n"; &Recurse($_); #&PrintDepend; } } while (!ListEqual(\@sorted, \@list)); print "The final, sorted list is: ", join " ", @sorted, "\n"; exit 0; ###################################################################### sub Recurse { my $node=shift || return undef; my @depend; my $found=0; my $result; if (defined($depend{$node})) { @depend=@{$depend{$node}} } else { @depend=(); } $found=grep(/$node/,@pkgs); # If $node is in @pkgs, then we care, otherwise, we aren't #planning on removing it, so we can pop out of the stack. #print "\nRecursing with $node => [", join " ",@depend,"]\t\t"; #print "$node not in \@pkgs, skipping." if !$found; return undef if !$found; # If @depend is not defined, or its contents # do not exist in @pkgs, then we can remove it if ( !defined(@depend)) { #print "$node doesn't require anything."; AddNode($node); } else { $found=0; # are we removing anything in @depend? i.e. does @depend inter +sect @pkgs foreach (@depend) { ++$found if grep (/$_/,@pkgs); } # are the depenedncies in @pkgs? if (!$found) { #print "Nothing in \@depend is in \@pkgs"; AddNode($node); Prune($node); } else { #nope, so we recurse foreach (@depend) { $result=&Recurse($_); #print "Depend $_ in \@pkgs\n"; AddNode($_) if (!defined($result)); } } } return 1; } #This sub just puts a scaler in a list if it's not there already. sub AddNode ($){ my $node=shift || return undef; #print "\nPushing $node\n"; if (!exists $seen{$node}) { push (@sorted, $node); $seen{$node}=1; } #print "==>", join " ", @sorted, "<==\n"; } # This sub modifies %depend. It takes a scalar, # runs through each key and removes the scaler # from the value lists. Modification is done place. sub Prune { my $node=shift || return undef; #print "Pruning $node\n"; my @temp; @temp=@{$depend{$node}} if exists $depend{$node}; #print join " ", @temp, "\n"; #print "\n\tremoving $node\n"; foreach (keys %depend) { @temp=@{$depend{$_}}; @temp=grep(!/$node/, @temp); #print join " ", @temp, "\n"; $depend{$_}=[ grep(!/$node/, @temp) ]; } #delete $depend{$node} if (exists $depend{$node}); #&PrintDepend; } # I'm lazy. :) sub PrintPkgs { print "\@pkgs = [", join "][", @pkgs,"]\n"; } #Print the dependencies. Format: # <pkg>: <req_pkg> [req_pkg] [req_pkg] ... sub PrintDepend { foreach $pkg (keys %depend) { print "$pkg: "; foreach ( @{$depend{$pkg}} ) { print "$_ "; } print "\n"; } print "\n"; } #my overly complicated routine to compare lists. :) sub ListEqual { my ($a,$b)=(@_); my (@a,@b,$i); @a=@{$a}; @b=@{$b}; my $ac=@a; my $bc=@b; return 0 if ($ac != $bc); for ($i=0; $i<$ac; $i++) { return 0 if $a[$i] ne $b[$i]; } return 1; }