Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2024-03-28 17:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found