debian-cd-clone/tools/sort_deps

#!/usr/bin/perl -w
#
# Copyright 1999 Raphaël Hertzog <hertzog@debian.org>
# See the README file for the license
#
# This script takes 1 argument on input :
# - a filename listing all the packages to include
#
# and it sorts those packages such that dependencies are met in order
#
# Used to be called list2cds, renamed as it now just sorts
# dependencies. Later code in make_disc_trees.pl actually splits on a
# per-disc basis now.

use strict;
use Data::Dumper;
use Dpkg::Version;

my $listfile = shift;

my $nonfree = read_env('NONFREE', 0);
my $extranonfree = read_env('EXTRANONFREE', 0);
my $force_firmware = read_env('FORCE_FIRMWARE', 0);
my $local = read_env('LOCAL', 0);
my $complete = read_env('COMPLETE', 0);
my $norecommends = read_env('NORECOMMENDS', 1);
my $nosuggests = read_env('NOSUGGESTS', 1);
my $verbose = read_env('VERBOSE', 0);
my $max_pkg_size = read_env('MAX_PKG_SIZE', 9999999999999);

my $apt = "$ENV{'BASEDIR'}/tools/apt-selection";
my $adir = "$ENV{'APTTMP'}/$ENV{'CODENAME'}-$ENV{'ARCH'}";
my $arch = "$ENV{'ARCH'}";
my $dir = "$ENV{'TDIR'}/$ENV{'CODENAME'}";

my $force_unstable_tasks = read_env('FORCE_SID_TASKSEL', 0);
my $tasks_packages = read_env('TASKS_PACKAGES',
                              "$ENV{'MIRROR'}/dists/sid/main/binary-$ENV{'ARCH'}/Packages.gz");
my @output = ();

$| = 1; # Autoflush for debugging

open(LOG, ">$dir/sort_deps.$arch.log")
       || die "Can't write in $dir/sort_deps.$arch.log !\n";

sub read_env {
    my $env_var = shift;
    my $default = shift;

    if (exists($ENV{$env_var})) {
        return $ENV{$env_var};
    }
    # else
    return $default;
}

sub msg {
	my $level = shift;
	if ($verbose >= $level) {
		print @_;
	}
	print LOG @_;
}

my %included;
my %excluded;
my %packages;

msg(0, "Running sort_deps to sort packages for $arch:\n");
msg(1, "======================================================================
Here are the settings you've chosen for making the list:
Architecture: $arch
List of prefered packages: $listfile
Output file: $dir/packages.$arch
");
msg(1, "Complete selected packages with all the rest: ");
msg(1, yesno($complete)."\n");
msg(1, "Include non-free packages: ");
msg(1, yesno($nonfree)."\n");
msg(1, "Force inclusion of firmware packages: ");
msg(1, yesno($force_firmware)."\n");
msg(1, "Ignore Recommends: ");
msg(1, yesno($norecommends)."\n");
msg(1, "Ignore Suggests: ");
msg(1, yesno($nosuggests)."\n");
msg(1, "Maximum allowed package size: $max_pkg_size bytes\n");
msg(1, "======================================================================
");

# Get the information on all packages
my $oldrs = $/;
$/ = '';
open(AVAIL, "$apt cache dumpavail |") || die "Can't fork : $!\n";
my ($p, $re);
while (defined($_=<AVAIL>)) {
	next if not m/^Package: (\S+)\s*$/m;
    if (!$force_unstable_tasks || $1 !~ /^task-/) {
        parse_package($_);
    }
}
close AVAIL or die "apt-cache failed : $@ ($!)\n";

# Read in the extra (new/unstable) tasks packages
if ($force_unstable_tasks) {
    my $num = 0;
    if ($tasks_packages =~ /\.gz$/) {
        open(AVAIL, "zcat $tasks_packages |") || die "Can't zcat $tasks_packages : $!\n";
    } else {
        open(AVAIL, "< $tasks_packages") || die "Can't open $tasks_packages for reading: $!\n";
    }
    while (defined($_=<AVAIL>)) {
        next if not m/^Package: (\S+)\s*$/m;
        if ($1 =~ /^task-/) {
            parse_package($_);
            $num++;
        }
    }
    close AVAIL or die "reading unstable tasks failed : $@ ($!)\n";
    msg(0, "  Read $num tasks packages from $tasks_packages\n");
}
    
$/ = $oldrs;

# Get the list of excluded packages
%excluded = %included;
my $count_excl = 0;

# Now exclude packages because of the non-free rules
if (not $nonfree) {
	foreach (grep { $packages{$_}{"Section"} =~ /non-free/ }
	              (keys %packages)) {
        if ($force_firmware and $packages{$_}{"IsFirmware"}) {
            msg(1, "force_firmware: keeping non-free package $_\n");
        } else {
            $excluded{$_} = 'nonfree';
            $count_excl++;
        }
	}
}

msg(1, "Statistics:
Number of packages: @{ [scalar(keys %packages)] }
Number of excluded: $count_excl of @{ [scalar(keys %excluded)] }
======================================================================

");

open(STATS, "> $dir/stats.excluded.$arch") 
                       || die "Can't write in stats.excluded.$arch: $!\n";
foreach (keys %excluded) {
	print STATS "$_ => $excluded{$_}\n";
}
close (STATS);

# Browse the list of packages to include
my ($output_size, $size) = (0, 0);
my %cds;

# Generate a dependency tree for each package
msg(0, "  Generating dependency tree with apt-cache depends...\n");
my (@list) = keys %packages;
while (@list) {
	my (@pkg) = splice(@list,0,200);
	$ENV{'LC_ALL'} = 'C'; # Required since apt is now translated
	open (APT, "$apt cache depends @pkg |") || die "Can't fork : $!\n";
	my (@res) = (<APT>);
	close APT or die "'apt-cache depends failed ... \n" . 
	                 "you must have apt >= 0.3.11.1 !\n";
	# Getting rid of conflicts/replaces/provides
	my $i = 0;
	my $nb_lines = scalar @res;
	push @res, ""; # Avoid warnings ...
	while ($i < $nb_lines) {
		if ($res[$i] !~ m/^(\S+)\s*$/) {
			msg(0, "UNEXPECTED: Line `$res[$i]' while parsing " .
			       "end of deptree from '$p'\n");
			die "sort_deps failed! :-(\n";
		}
		$p = lc $1;
		$i++;
		msg(2, "  Dependency tree of `$p' ...\n");
		read_depends (\$i, \@res, $p);
	}
	
}

msg(0, "  Adding standard, required, important and base packages first\n");
# Automatically include packages listed in the status file
open(STATUS, "< $adir/status") || die "Can't open status file $adir/status: $!\n";
while (defined($_ = <STATUS>)) {
       next if not m/^Package: (\S+)/;
       $p = $1;
       if (not exists $packages{$p}) {
               msg(1, "WARNING: Package `$p' is listed in the status file "
                      . "but doesn't exist ! (ignored) \n",
                      "    TIP: Try to generate the status file with " .
                       "make (correct)status (after a make distclean)...\n");
                next;
       }
       next if $excluded{$p};
       add_package($p, ! $norecommends, ! $nosuggests);
}
close STATUS;
msg(0, "  S/R/I/B packages take $output_size bytes\n");

# Now start to look for packages wanted by the user ...
msg(0, "  Adding the rest of the requested packages\n");
open (LIST, "< $listfile") || die "Can't open $listfile : $!\n";
while (defined($_=<LIST>)) {
	chomp;
	next if m/^\s*$/;
	if (not exists $packages{$_}) { 
	    msg(1, "WARNING: '$_' does not appear to be available ... " . 
	           "(ignored)\n");
	    next;
	}
	next if $excluded{$_};
	if ($included{$_}) {
	    msg(3, "$_ has already been included.\n");
	    next;
	}
	# This is because udebs tend to have bad dependencies but work
	# nevertheless ... this may be removed once the udebs have a
	# better depencency system
	if ($packages{$_}{"IsUdeb"}) {
		add_to_output($_);
	} else {
		add_package ($_, ! $norecommends, ! $nosuggests);
	}
}
close LIST;

msg(0, "  Now up to $output_size bytes\n");
# All requested packages have been included
# But we'll continue to add if $complete was requested
if ($complete) {
    msg(0, "  COMPLETE=1; add all remaining packages\n");
    # Try to sort them by section even if packages from
    # other sections will get in through dependencies
    # With some luck, most of them will already be here
    foreach my $p (sort { ($packages{lc $a}{"Section"} cmp $packages{lc $b}{"Section"})
                       || (lc $a cmp lc $b) }
             grep { not ($included{$_} or $excluded{$_}) } keys %packages) {
	# At this point, we should *not* be adding any more udebs,
	# as they're no use to anybody.
	if ($packages{lc $p}{"IsUdeb"}) {
	    msg(2, "  Ignoring udeb $p ...\n");
	} else {
	    add_package (lc $p, 0, 0);
	}
    }
}

# Now select the non-free packages for an extra CD
if ($extranonfree and (! $nonfree))
{
	my ($p, @toinclude);
	
	msg(0, "  Adding non-free packages now\n");

	# Finally accept non-free packages ...
	foreach $p (grep { $excluded{$_} eq "nonfree" } (keys %excluded))
	{
		$excluded{$p} = 0;
		push @toinclude, $p;
	}
	
	# Include non-free packages
	foreach $p (@toinclude)
	{
		add_package(lc $p, 1, 1);
	}

	# If a contrib package was listed in the list of packages to
	# include and if COMPLETE=0 there's a chance that the package
	# will not get included in any CD ... so I'm checking the complete
	# list again
	open (LIST, "< $listfile") || die "Can't open $listfile : $!\n";
	while (defined($_=<LIST>)) {
		chomp;
		next if m/^\s*$/;
		next if $included{$_};
		next if $included{lc $_};
		next if $excluded{$_};
		next if $excluded{lc $_};
		if (not exists $packages{$_} && not exists $packages{lc $_}) { 
		  msg(1, "WARNING: '$_' does not appear to be available ... " . 
	          	 "(ignored)\n");
		  next;
		}
		if ($packages{lc $p}{"IsUdeb"}) {
			msg(2, "  Ignoring udeb $p ...\n");
		} else {
			add_package (lc $_, 1, 1);
		}
	}
	close LIST;

	# Try to include other packages that could not be included
	# before (because they depends on excluded non-free packages)
	if ($complete)
	{
	    foreach $p (sort { ($packages{$a}{"Section"} 
				cmp $packages{$b}{"Section"}) || ($a cmp $b) }
			grep { not ($included{$_} or $excluded{$_}) } 
			keys %packages) 
	    {
			if ($packages{lc $p}{"IsUdeb"}) {
				msg(2, "  Ignoring udeb $p ...\n");
			} else {
				add_package (lc $p, 0, 0);
			}
		}
	}

}

# Remove old files
foreach (glob("$dir/*.packages*")) {
	unlink $_;
}

# Now write the list down
my $count = 0;
open(CDLIST, "> $dir/packages.$arch") 
    || die "Can't write in $dir/$_.packages.$arch: $!\n";
open(FWLIST, ">> $dir/firmware-packages")
    || die "Can't write in $dir/firmware-packages: $!\n";
foreach (@output) {
    my $component = $packages{$_}{"Component"};
    my $size = $packages{$_}{"Size"};
    my $bu = $packages{$_}{"Built-Using"};
    print CDLIST "$arch:$component:$_:$size:$bu\n";
    if ($packages{$_}{"IsFirmware"}) {
        print FWLIST "$_\n";
    }
    $count++;
}
close CDLIST;
close FWLIST;
msg(0, "Done: processed/sorted $count packages, total size $output_size bytes.\n");

close LOG;

## END OF MAIN
## BEGINNING OF SUBS

sub parse_package {
	my $p;
	m/^Package: (\S+)\s*$/m and $p = $1;
	$included{$p} = 0;
	$packages{$p}{"Package"} = $p;
	foreach $re (qw(Version Priority Section Filename Size MD5sum)) {
		(m/^$re: (\S+)\s*$/m and $packages{$p}{$re} = $1)
		|| msg(1, "Header field '$re' missing for package '$p'.\n");
	}
	$packages{$p}{"Depends"} = [];
	$packages{$p}{"Suggests"} = [];
	$packages{$p}{"Recommends"} = [];
	$packages{$p}{"Built-Using"} = "";	
	if (m/^Built-Using: (.*)$/m) {
	    my $built = $1;
	    $built =~ s/ \(= \S*\)//g;
	    $built =~ s/,//g;
	    $built =~ s/ /,/g;
	    $packages{$p}{"Built-Using"} = $built;
	}
	$packages{$p}{"IsUdeb"} = ($packages{$p}{"Filename"} =~ /.udeb$/) ? 1 : 0;
	$packages{$p}{"IsFirmware"} = ($packages{$p}{"Filename"} =~ /(firmware|microcode)/) ? 1 : 0;
	if ($packages{$p}{"Section"} =~ /contrib\//) {
		$packages{$p}{"Component"} = "contrib";
	} elsif ($packages{$p}{"Section"} =~ /non-free\//) {
		$packages{$p}{"Component"} = "non-free";
	} elsif ($packages{$p}{"IsUdeb"}) {
		$packages{$p}{"Component"} = "main-installer";
	} else {
		$packages{$p}{"Component"} = "main";
	}
}

sub dump_depend {
    my $tmpin = shift;
    my %d;
    my $ret = "";

    if ("ARRAY" eq ref($tmpin)) {
        my @array = @{$tmpin};
        foreach (@array) {
            %d = %$_;
            $ret .= $d{"Package"};
            if ($d{"CmpOp"} ne "") {
                $ret .= " (" . $d{"CmpOp"} . " " . $d{"Version"} . ")";
            }
            $ret .= " ";
        }
    } elsif ("HASH" eq ref($tmpin)) {
        %d = %$tmpin;
        $ret .= $d{"Package"};
        if ($d{"CmpOp"} ne "") {
            $ret .= " (" . $d{"CmpOp"} . " " . $d{"Version"} . ")";
        }
    } else {
        die "dump_depend: $tmpin is neither an array nor a hash!\n";
    }

    return $ret;
}

sub dump_or_list {
	my $out_type = shift;
	my $elt = shift;
	my @or = @$elt;

	if (scalar @or == 1) {
		msg(1, "    $out_type: " . dump_depend($or[0]) . "\n");
	} else {
		msg(1, "    $out_type: OR (");
		foreach my $t (@or) {
			msg(1, dump_depend($t) . " ");
		}
		msg(1, ")\n");
	}
}

sub read_depends {
	my $i = shift;     # Ref
	my $lines = shift; # Ref
	my $pkg = shift;   # string
	my $types = "(?:Pre)?Depends|Suggests|Recommends|Replaces|Conflicts|Breaks|Enhances";
	my (@dep, @rec, @sug);
	my ($type, $or);

	while ($lines->[$$i] =~ m/^\s([\s\|])($types):/) {
		$type = $2; $or = $1;
		# Get rid of replaces, conflicts and any other fields we don't
		# care about...
		if (($type eq "Replaces") or
			($type eq "Conflicts") or
			($type eq "Breaks") or
			($type eq "Enhances")) {
			$$i++;
			while ($lines->[$$i] =~ m/^\s{4}/) {
				$$i++;
			}
			next;
		}

		my $out_type = $type;
		$out_type =~ s/^Pre//; # PreDepends are like Depends for me 

		# Check the kind of depends : or, virtual, normal
		if ($or eq '|') {
			my $elt = read_ordepends ($i, $lines);
			dump_or_list($out_type, \@$elt);
			push @{$packages{$pkg}{$out_type}}, $elt;
		} elsif ($lines->[$$i] =~ m/^\s\s$type: <([^>]+)>/) {
			my $elt = read_virtualdepends ($i, $lines);
			foreach my $t (@$elt) {
				msg(1, "    $out_type: " . dump_depend($t) . " <virt>\n");
			}
			push @{$packages{$pkg}{$out_type}}, $elt;
		} elsif ($lines->[$$i] =~ m/^\s\s$type: (\S+)( \((\S+) (\S+)\))*/) {
			my @or;
			my %elt;
			$elt{"Package"} = $1;
			if (defined $2) {
				$elt{"CmpOp"} = $3;
				$elt{"Version"} = $4;
			} else {
				$elt{"CmpOp"} = "";
				$elt{"Version"} = "";
			}
			push @or, \%elt;
			$$i++;

			# Special case for packages providing not
			# truly virtual packages
			if ($lines->[$$i] =~ m/^\s{4}/) {
				while ($lines->[$$i] =~ m/\s{4}(\S+)( \((\S+) (\S+)\))*/) {
					my %elt1;
					$elt1{"Package"} = $1;
					if (defined $2) {
						$elt1{"CmpOp"} = $3;
						$elt1{"Version"} = $4;
					} else {
						$elt1{"CmpOp"} = "";
						$elt1{"Version"} = "";
					}
					push @or, \%elt1;
					$$i++;
				}
			}
			dump_or_list($out_type, \@or);
			push @{$packages{$pkg}{$out_type}}, \@or;
		} else {
			msg(0, "ERROR: Unknown depends line : $lines->[$$i]\n");
			foreach ($$i - 3 .. $$i + 3) {
				msg(0, "      ", $lines->[$_]);
			}
		}
	}
}

# Big matrix of tests. Check to see if the available version of a
# package matches what we're requesting in a dependency relationship
sub check_versions {
	my $wanted = shift;
	my $op = shift;
	my $available = shift;

	# Trivial check - if we don't care about versioning, anything will
	# do!
	if ($op eq "") {
		return 1;
	}

	# Ask the dpkg perl code to compare the version strings
	my $comp = version_compare($available, $wanted);

	if ($op eq "<=") {
		if ($comp == -1 || $comp == 0) {
			return 1;
		}
	} elsif ($op eq ">=") {
		if ($comp == 0 || $comp == 1) {
			return 1;
		}
	} elsif ($op eq "<<") {
		if ($comp == -1) {
			return 1;
		}
	} elsif ($op eq ">>") {
		if ($comp == 1) {
			return 1;
		}
	} elsif ($op eq "=") {
		if ($comp == 0) {
			return 1;
		}
	# Not sure this ("!") actually exists!
	# Mentioned in apt sources, but not in debian policy
	# No harm done by checking for it, though...
	} elsif ($op eq "!") {
		if ($comp == -1 || $comp == 1) {
			return 1;
		}
	}
	# else
	return 0;
}

# Check if a specific dependency package is installed already
sub dep_pkg_included {
	my $p = shift;
	my %d = %$p;
	my $pn = $d{"Package"};

	if ($included{$pn}) {
		if (check_versions($d{"Version"}, $d{"CmpOp"}, $packages{$pn}{"Version"})) {
			msg(1, "      $pn is included already, acceptable version " . $packages{$pn}{"Version"} . "\n");
			return 1;
		} else {
			msg(1, "      $pn is included already, but invalid version " . $packages{$pn}{"Version"} . "\n");
		}
	}
	# else
	return 0;
}

# Check to see if a dependency is satisfied, either a direct
# dependency or any one of an OR array
sub dep_satisfied {
	my $p = shift;

	if ("ARRAY" eq ref $p) {
		foreach (@{$p}) {
			if (dep_pkg_included($_)) {
				return 1;
			}
		}
	} elsif ("HASH" eq ref $p) {
		return dep_pkg_included($p);
	} else {
		die "dep_satisfied: $p is neither a hash nor an array!\n";
	}
	return 0;
}

sub read_ordepends {
	my $i = shift;
	my $lines = shift;
	my @or = ();
	my ($val, $dep, $last) = ('','',0);
	my ($op, $version);

	chomp $lines->[$$i];
	
	while ($lines->[$$i] 
	            =~ m/^\s([\s\|])((?:Pre)?Depends|Suggests|Recommends): (\S+)( \((\S+) (\S+)\))*/) {
		$val = $3;
		if (defined $4) {
			$op = $5;
			$version = $6;
		} else {
			$op = "";
			$version = "";
		}
		$last = 1 if $1 ne '|'; #Stop when no more '|'
		if ($val =~ m/^<.*>$/) {
			$dep = read_virtualdepends ($i, $lines);
			if (ref $dep) {
				push @or, @{$dep};
			} else {
				push @or, $dep;
			}
		} else {
			my %elt;
			$elt{"Package"} = $val;
			$elt{"CmpOp"} = $op;
			$elt{"Version"} = $version;
			push @or, \%elt;
			$$i++;
			# Hack for packages providing not a truly
			# virtual package
			while ($lines->[$$i] =~ m/^\s{4}(\S+)( \((\S+) (\S+)\))*/) {
				my %elt1;
				$elt1{"Package"} = $1;
				if (defined $2) {
					$elt1{"CmpOp"} = $3;
					$elt1{"Version"} = $4;
				} else {
					$elt1{"CmpOp"} = "";
					$elt1{"Version"} = "";
				}
				msg(1, "    " . dump_depend(\%elt1) . "\n");
				push @or, \%elt1;
				$$i++;
			}
		}
		last if $last;
	}
	return \@or;
}

sub read_virtualdepends {
	my $i = shift;
	my $lines = shift;
	my $virtual;
	my @or = ();

	#Check for the lines with <>
	if ($lines->[$$i] 
	    =~ m/^\s[\s\|]((?:Pre)?Depends|Recommends|Suggests): <([^>]+)>/) {
	    $virtual = $2;
	    $$i++
	}
	# Now look at the alternatives on the following lines
	while ($lines->[$$i] =~ m/^\s{4}(\S+)( \((\S+) (\S+)\))*/) {
		my %elt;
		$elt{"Package"} = $1;
		if (defined $2) {
			$elt{"CmpOp"} = $3;
			$elt{"Version"} = $4;
		} else {
			$elt{"CmpOp"} = "";
			$elt{"Version"} = "";
		}
		push @or, \%elt;
		$$i++;
	}
	if (@or) {
		return \@or;
	} else {
		my %elt;
		$elt{"Package"} = $virtual;
		$elt{"CmpOp"} = "";
		$elt{"Version"} = "";
		push @or, \%elt;
		return \@or;
	}
}

sub add_package {
	my $p = shift;
	my $add_rec = shift; # Do we look for recommends
	my $add_sug = shift; # Do we look for suggests
	my ($ok, $reasons);
	
	msg(2, "+ Trying to add $p...\n");
	if ($included{$p}) {
		msg(2, "  Already included ...\n");
		return;
	}
	
	# Get all dependencies (not yet included) of each package
	my (@dep) = (get_missing ($p));

	# Stop here if apt failed
	if (not scalar(@dep)) {
		msg(2, "Can't add $p ... dependency problem.\n");
		return;
	}

	if ($packages{$p}{"Size"} > $max_pkg_size) {
		msg(2, "Can't add $p ... too big!\n");
		$excluded{$p} = 'toobig';
		return;
	}
	
	msg(3, "  \@dep before checklist = " . dump_depend(\@dep) . "\n");
	
	# Check if all packages are allowed (fail if one cannot)
	($ok, $reasons) = check_list (\@dep, 1);
	if (not $ok) {
		msg(2, "Can't add $p ... one of the packages needed has " .
		       "been refused. Reasons: $reasons\n"); 
		return;
	}
	
	msg(3, "  \@dep after checklist = " . dump_depend(\@dep) . "\n");
	
	if ($add_rec) {
		#TODO: Look for recommends (not yet included !!)
		add_recommends (\@dep, $p);
		msg(3, "  \@dep after add_recommends = " . dump_depend(\@dep) . "\n");
		# Check again but doesn't fail if one of the package cannot be
		# installed, just ignore it (it will be removed from @dep)
		($ok, $reasons) = check_list (\@dep, 0);
		if (not $ok) {
			msg(0, "UNEXPECTED: It shouldn't fail here !\n");
			return;
		}
		msg(3, "  \@dep after checklist2 = " . dump_depend(\@dep) . "\n");
	}

	if ($add_sug) {
	    #TODO: Look for suggests (not yet included !!)
		add_suggests (\@dep, $p);
		msg(3, "  \@dep after add_suggests = " . dump_depend(\@dep) . "\n");
        # Check again but doesn't fail if one of the package cannot be
        # installed, just ignore it (it will be removed from @dep)
        ($ok, $reasons) = check_list (\@dep, 0);
        if (not $ok) {
            msg(0, "UNEXPECTED: It shouldn't fail here !\n");
            return;
        }
		msg(3, "  \@dep after checklist3 = " . dump_depend(\@dep) . "\n");
	}
	
	# All packages are ok, now list them out and add sizes
	foreach my $t (@dep) {
		my %t = %$t;
		my $pkgname = $t{"Package"};
		add_to_output($pkgname);
    }
}

sub accepted {
	my $p = shift;
	return not $excluded{$p} if (exists $excluded{$p});
	# Return false for a non-existent package ...
	msg(1, "WARNING: $p cannot be accepted, it doesn't exist ...\n");
	return 0;
}

sub add_suggests {
	my $deps_list = shift;
	my $pkg = shift;
	my @parents = ($pkg);
	my $p; # = shift;
	my @copy = @{$deps_list}; # A copy is needed since I'll modify the array
	
	foreach $p (@copy) {
		my %t = %$p;
		my $pkgname = $t{"Package"};
		add_missing($deps_list, $packages{$pkgname}{"Suggests"}, \%t, 1, \@parents);
	}
}

sub add_recommends {
	my $deps_list = shift;
	my $pkg = shift;
	my @parents = ($pkg);
	my $p; # = shift;
	my @copy = @{$deps_list}; # A copy is needed since I'll modify the array
	
	foreach $p (@copy) {
		my %t = %$p;
		my $pkgname = $t{"Package"};
		add_missing($deps_list, $packages{$pkgname}{"Recommends"}, \%t, 1, \@parents);
	}
}

sub get_missing {
	my $p = shift;
	my @deps_list = ();
	my @parents = ();
	my %t;
	my $dep_text;
	
	$t{"Package"} = $p;
	$t{"CmpOp"} = "";
	$t{"Version"} = "";

	if (not add_missing (\@deps_list, $packages{$p}{"Depends"}, \%t, 0, \@parents)) {
		return ();
	}

	# Explicitly move the package itself to the end of the list,
	# i.e. *after* all its dependencies
	remove_entry(\%t, \@deps_list);
	push @deps_list, \%t;

	return (@deps_list);
}

# Recursive function adding packages to our list
sub add_missing {
	my $list = shift;
	my $new = shift;
	my $pkgin = shift;
	my @backup = @{$list};
	my $ok = 1;
	my $soft_depend = shift;
	my $parents = shift;
	my $pkgname;
	my (%pkgin);

	if (ref $pkgin eq "HASH") {
		%pkgin = %$pkgin;
	} else {
		die "add_missing passed a non-hash";
	}

	push(@{$parents}, $pkgin{"Package"});
	#msg(3, "   add_missing: parents atm @{$parents}\n");
	# Check all dependencies 
	foreach my $thisdep (@{$new}) {
		my $textout = "";
		$pkgname = $pkgin{"Package"};

		# Print out status
		if ("ARRAY" eq ref($thisdep)) {
			if (scalar(@{$thisdep} > 1)) {
				$textout = "(OR ";
			}
			foreach my $orpkg (@{$thisdep}) {
				$textout .= dump_depend($orpkg) . " ";
			}
			if (scalar(@{$thisdep} > 1)) {
				$textout .= ")";
			}
		} elsif ("HASH" eq ref($thisdep)) {
			$textout = dump_depend($thisdep);
		} else {
			die "add_missing: $thisdep should be an array or hash!\n";
		}
		msg(3, "    $pkgname Dep: $textout soft_depend $soft_depend\n");

		# Bail out early if we can!
		if (dep_satisfied ($thisdep)) {
			next;
		}

		# Still work to do...
		# If it's an OR
		if ("ARRAY" eq ref($thisdep)) {
			my $or_ok = 0;

			# First check all the OR packages up-front with no
			# recursion. If *any* one of them is already installed, it
			# will do.
			foreach my $pkg (@{$thisdep}) {
				my %t = %$pkg;
				my $pkgname = lc $t{"Package"};

				if (exists $packages{$pkgname} && 
				    ($packages{$pkgname}{"Size"} > $max_pkg_size)) {
				    msg(2, "    $pkgname is too big, mark it as excluded\n");
				    $excluded{$pkgname} = 'toobig';
				}
                               
				# Already installed?
				if (dep_satisfied($pkg)) {
					msg(3, "    OR relationship already installed: " . dump_depend($pkg) . "\n");
					$or_ok = 1;
					last;
				}

				# Pulled in already somewhere above us in the
				# depth-first search? (yes, we have to cope with
				# circular dependencies here...)
				if (is_in ($t{"Package"}, $parents) &&
					check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pkgname}{"Version"})) {
					msg(3, "    OR relationship already satisfied by parent " . dump_depend($pkg) . "\n");
					$or_ok = 1;
					last;
				}
				# else
				msg(3, "      " . dump_depend($pkg) . " not already installed\n");
			}

			# If we don't have any of the OR packages, then start
			# again and try them in order. We always add the first
			# package in the OR to allow APT to figure out which is
			# the better one to install for any combination of
			# packages that have similar alternative dependencies, but
			# in different order. Having the first alternative
			# available should be good enough for all cases we care
			# about.
			if (not $or_ok) {
				msg(3, "    OR relationship not already satisfied, looking at alternatives in order\n");
				
				foreach my $pkg (@{$thisdep}) {
					my %t = %$pkg;
					my $pkgname = $t{"Package"};
					if (not accepted($pkgname)) {
						next;
					}
					# Check we don't already have the package
					if (is_in_dep_list($pkg, $list)) {
						$or_ok = 1;
						last;
						# Otherwise try to add it
					} else {
						# Stop after the first
						# package that is
						# added successfully
						push (@{$list}, $pkg);
						if (add_missing ($list, $packages{$pkgname}{"Depends"}, $pkg, $soft_depend, $parents)) {
							$or_ok = 1;
							remove_entry($pkg, $list);
							push @{$list}, $pkg;
							last;
						} else {
							pop @{$list};
						}
					}
				}
			}
			$ok &&= $or_ok;
			if (not $ok) {
				$pkgname = $pkgin{"Package"};
				if ($soft_depend) {
					msg(1, "  $pkgname failed, couldn't satisfy OR dep (but it's a soft dep, so ignoring...)\n");
					$ok = 1;
				} else {
					msg(1, "  $pkgname failed, couldn't satisfy OR dep\n");
				}
			}				
		# Else it's a simple dependency
		} else {
			my %t = %{$thisdep};
			my $pt = dump_depend(\%t);
			msg(1, "  Looking at adding $pt to satisfy dep\n");

			if (not exists $packages{lc $t{"Package"}}) {
				msg(1, "  $pt doesn't exist...\n");
				if ($soft_depend) {
					msg(1, "  soft dep: $pkgname ok, despite missing dep on $pt\n");
					$ok = 1;
				} else {
					msg(1, "  $pkgname failed, couldn't satisfy dep on $pt\n");
					$ok = 0;
					last;
				}
			}
			if (dep_satisfied(\%t)) {
				msg(1, "    $pt already included\n");
				next; # Already included, don't worry
			}
			if (is_in_dep_list(\%t, $list)) {
				msg(1, "    $pt already in dep list\n");
				next;
			}
			push @{$list}, \%t;
			if (not add_missing ($list, $packages{$t{"Package"}}{"Depends"}, \%t, $soft_depend, $parents)) {
				my $pkgname = $pkgin{"Package"};
				msg(1, "couldn't add $pt ...\n");
				if ($soft_depend) {
					msg(1, "soft dep: $pkgname ok, despite missing dep on $pt\n");
					$ok = 1;
				} else {
					msg(1, "$pkgname failed, couldn't satisfy dep on $pt\n");
					pop @{$list};
					$ok = 0;
				}
			}
			remove_entry(\%t, $list);
			push @{$list}, \%t;
		}
	}
	# If a problem has come up, then restore the original list
	if (not $ok) {
		@{$list} = @backup;
	}
	if (not is_in_dep_list(\%pkgin, $list)) {
		push @{$list}, \%pkgin;
	}
	return $ok;
}

# Check if $value is in @{$array}
sub is_in {
	my $value = shift;
	my $array = shift;
	foreach my $key (@{$array}) {
		return 1 if ($key eq $value);
	}
	return 0;		
}

# Check if a package dependency is already in a dependency list
sub is_in_dep_list {
	my $hash = shift;
	my $array = shift;
	my %t = %$hash;

	foreach my $key (@{$array}) {
		my %a = %$key;
		if ($a{"Package"} eq $t{"Package"}) {
			my $pn = $a{"Package"};
			if (check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pn}{"Version"})) {
				return 1;
			}
		}
	}
	return 0;		
}

# Remove an antry from @{$array}
sub remove_entry {
	my $tmp1 = shift;
	my $array = shift;
	my $entries = scalar(@{$array});
	my $i;
	my %t1 = %$tmp1;

	for ($i=0; $i < $entries; $i++) {
		my $tmp2 = @{$array}[$i];
		my %t2 = %$tmp2;
		if ($t1{"Package"} eq $t2{"Package"}) {
            splice(@{$array}, $i, 1);
			$i--;
			$entries--;
		}
	}
}

# Check a list of packages
sub check_list {
	my $ref = shift;
	my $fail = shift;
	my $ok = 1;
	my @to_remove = ();
	my $reasons = "";
	foreach my $thispkg (@{$ref}) {
		my %t = %$thispkg;
		my $pkgname = $t{"Package"};
		if (not exists $excluded{$pkgname}) {
			msg(1,"  $pkgname has been refused because it doesn't exist ...\n");
			$ok = 0;
			push @to_remove, $thispkg;
			$reasons = $reasons . " noexist";
			next;
		}
		if (not accepted($pkgname)) {
			msg(1,"  $pkgname has been refused because of $excluded{$pkgname} ...\n");
			$ok = 0;
			push @to_remove, $thispkg;
			$reasons = $reasons . " " . $excluded{$pkgname};
			next;
		}
		if ($included{$pkgname}) {
			msg(1, "  $pkgname has already been included.\n");
			push @to_remove, $thispkg;
			$reasons = $reasons . " alreadyinc";
			next;
		}
	}
	foreach my $removed (@to_remove) {
		my %t = %$removed;
		my $pkgname = $t{"Package"};
		msg(2, "  Removing $pkgname ... ($reasons )\n");
		@{$ref} = grep { $_ ne $removed } @{$ref};
	}
	return ($fail ? $ok : 1, $reasons);
}

# Add packages to the output list
sub add_to_output {
	my $pkgname = shift;
	my $size = $packages{$pkgname}{"Size"};

	$output_size += $size;
	$included{$pkgname} = 1;
	push(@output, $pkgname);
}

sub yesno {
	my $in = shift;
	return $in ? "yes" : "no";
}