%depend=(
    a => ['b','y','c'],
    b => [],
    c => ['z'],
    d => ['a','x','h'],

); 
##</code><code>##

#!/usr/local/bin/perl -w

use strict;

my %depend;     #this hash contains all the packages and their dependncies.
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 requisites
        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 intersect @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;
}