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; }

In reply to Recursive generation of a sorted list from a hash by hawson

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.