#!/usr/bin/perl -w
#
# Copyright 1999 Raphaël Hertzog <hertzog@debian.org>
# Copyright 2006-2016 Steve McIntyre <93sam@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 $add_rec = ! read_env('NORECOMMENDS', 1);
my $add_sug = ! read_env('NOSUGGESTS', 1);
my $verbose = read_env('VERBOSE', 0);
my $max_pkg_size = read_env('MAX_PKG_SIZE', 9999999999999);
my $codename = $ENV{'CODENAME'};
my $backports_list = read_env('BACKPORTS', "");
my $backports = 1;
if ($backports_list =~ /^$/) {
    $backports = 0;
}

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;
my %backport_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, "Include Recommends: ");
msg(1, yesno($add_rec)."\n");
msg(1, "Include Suggests: ");
msg(1, yesno($add_sug)."\n");
msg(1, "Maximum allowed package size: $max_pkg_size bytes\n");
msg(1, "======================================================================
");

# Get the information on all packages
my $oldrs = $/;
$/ = '';
msg(1, "Parsing packages...\n");
open(AVAIL, "$apt cache dumpavail |") || die "Can't fork : $!\n";
my ($p, $re);
my $num_pkgs = 0;
while (defined($_=<AVAIL>)) {
    next if not m/^Package: (\S+)\s*$/m;
    if (!$force_unstable_tasks || $1 !~ /^task-/) {
        parse_package(0, $_);
	$num_pkgs++;
    }
}
msg(1, "Got $num_pkgs packages\n");
close AVAIL or die "apt-cache failed : $@ ($!)\n";
if ($backports) {
    $num_pkgs = 0;
    msg(1, "Parsing packages from backports...\n");
    open(AVAIL, "USE_BP=1 $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(1, $_);
	    $num_pkgs++;
	}
    }
    msg(1, "Got $num_pkgs packages\n");
    close AVAIL or die "apt-cache (backports) 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(0, $_);
            $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) = grep (!/\/$codename-backports$/, 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";
    # 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);
    }
    
}
# Now redo with backports packages
if ($backports) {
    @list = grep (/\/$codename-backports$/, keys %packages);
    while (@list) {
	my (@pkg) = splice(@list,0,200);
	$ENV{'LC_ALL'} = 'C'; # Required since apt is now translated
	open (APT, "USE_BP=1 $apt cache depends @pkg |") || die "Can't fork : $!\n";
	my (@res) = (<APT>);
	close APT or die "'apt-cache depends failed: $! \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/$codename-backports' ...\n");
	    read_depends (\$i, \@res, "$p/$codename-backports");
	}
    }
    # Now check and maybe up our dependencies in the backports
    # packages. If any of them depend on package versions not already
    # in the base set, change them to be package/$codename-backports
    # instead. Only need to check direct dependencies here; any
    # indirects going through base packages shouldn't have any
    # backports dependencies, of course. Can only do this once we've
    # read *all* the packages in.
    @list = grep (/\/$codename-backports$/, keys %packages);
    foreach my $pkg (@list) {
	msg(1, "Fixing up deps for $pkg\n");
	$packages{$pkg}{"Depends"} = fix_backport_depends($packages{$pkg}{"Depends"});
	$packages{$pkg}{"Recommends"} = fix_backport_depends($packages{$pkg}{"Recommends"});
	$packages{$pkg}{"Suggests"} = fix_backport_depends($packages{$pkg}{"Suggests"});
    }
}

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};
    if ($p =~ /\/$codename-backports$/) {
	add_package($p, 1);
    } else {
	add_package($p, 0);
    }
}
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;
    msg(1, "Looking at list, line \"$_\"\n");
    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 {
	if ($_ =~ /\/$codename-backports$/) {
	    add_package($_, 1);
	} else {
	    add_package($_, 0);
	}
    }
}
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 {
	    if ($p =~ /\/$codename-backports$/i) {
		add_package (lc $p, 1);
	    } else {
		add_package (lc $p, 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)
	{
	    if ($p =~ /\/$codename-backports$/i) {
		add_package (lc $p, 1);
	    } else {
		add_package (lc $p, 0);
	    }
	}

	# 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 {
		    if ($_ =~ /\/$codename-backports$/i) {
			add_package (lc $_, 1);
		    } else {
			add_package (lc $_, 0);
		    }
		}
	}
	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 {
			    if ($p =~ /\/$codename-backports$/i) {
				add_package (lc $p, 1);
			    } else {
				add_package (lc $p, 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;
	my $use_bp = shift;
	m/^Package: (\S+)\s*$/m and $p = $1;
	if ($use_bp) {
	    $p = "$p/$codename-backports";
	}
	$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 $check_backports = shift;
	my $need_udeb = shift;
	my %d = %$p;
	my $pn = $d{"Package"};

	if ($included{$pn}) {
		if (check_versions($d{"Version"}, $d{"CmpOp"}, $packages{$pn}{"Version"})) {
			if ($packages{$pn}{"IsUdeb"} == $need_udeb) {
				msg(1, "      $pn is included already, acceptable version " . $packages{$pn}{"Version"} . "\n");
				return 1;
			} else {
				my $explanation = "it's a udeb instead of regular deb";
				$explanation = "it's a deb instead of an udeb" if $need_udeb;
				msg(1, "      $pn is included already, but $explanation\n");
			}
		} else {
			msg(1, "      $pn is included already, but invalid version " . $packages{$pn}{"Version"} . "\n");
		}
	}
	msg(1, "    $pn not included in a useful version, check_backports $check_backports\n");
	if ($check_backports) {
	    $pn = "$pn/$codename-backports";
	    msg(1, "    Checking $pn too:\n");
	    if ($included{$pn}) {
		if (check_versions($d{"Version"}, $d{"CmpOp"}, $packages{$pn}{"Version"})) {
		    if ($packages{$pn}{"IsUdeb"} == $need_udeb) {
			msg(1, "      $pn is included already, acceptable version " . $packages{$pn}{"Version"} . "\n");
			return 1;
		    } else {
			my $explanation = "it's a udeb instead of regular deb";
			$explanation = "it's a deb instead of an udeb" if $need_udeb;
			msg(1, "      $pn is included already, but $explanation\n");
		    }
		} else {
		    msg(1, "      $pn is included already, but invalid version " . $packages{$pn}{"Version"} . "\n");
		}
		msg(1, "    $pn not included in a useful version\n");
	    }
	}
	# else
	return 0;
}

# Check backports package dependencies; update them if they are also only in backports
sub fix_backport_depends {
    my $deplist = shift;
    my @new_dep_list;
    foreach my $thisdep (@{$deplist}) {
	if ("ARRAY" eq ref($thisdep)) {
	    # If it's an OR list
	    my @new_or_list;
	    foreach my $pkg (@{$thisdep}) {
		my %t = %$pkg;
		my $pkgname = lc $t{"Package"};
		# Does the package exist?
		if (exists $excluded{$pkgname} &&
		    check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pkgname}{"Version"})) {
		    # Looks fine already
		    push (@new_or_list, $pkg);
		    next;
		}
		# Doesn't exist, or version doesn't work. Try backports
		$pkgname = "$pkgname/$codename-backports";
		if (exists $excluded{$pkgname} &&
		    check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pkgname}{"Version"})) {
		    my %elt;
		    $elt{"Package"} = $pkgname;
		    $elt{"CmpOp"} = $t{"CmpOp"};
		    $elt{"Version"} = $t{"Version"};
		    push @new_or_list, \%elt;
		    msg(1, "  Upgrading dep to $pkgname\n");
		    next;
		}
	    }
	    push (@new_dep_list, \@new_or_list);
	} else {
	    # It's virtual or a normal package
	    my %t = %{$thisdep};
	    my $pkgname = lc $t{"Package"};
	    # Does the package exist?
	    if (exists $excluded{$pkgname} &&
		check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pkgname}{"Version"})) {
		# Looks fine already
		push (@new_dep_list, $thisdep);
		next;
	    }
	    # Doesn't exist, or version doesn't work. Try backports
	    $pkgname = "$pkgname/$codename-backports";
	    if (exists $excluded{$pkgname} &&
		check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pkgname}{"Version"})) {
		my %elt;
		$elt{"Package"} = $pkgname;
		$elt{"CmpOp"} = $t{"CmpOp"};
		$elt{"Version"} = $t{"Version"};
		push @new_dep_list, \%elt;
		msg(1, "  Upgrading dep to $pkgname\n");
		next;
	    }
	}
    }
    return \@new_dep_list;
}

# 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;
    my $check_backports = shift;
    my $need_udeb = shift;
    
    if ("ARRAY" eq ref $p) {
	foreach (@{$p}) {
	    if (dep_pkg_included($_, $check_backports, $need_udeb)) {
		return 1;
	    }
	}
    } elsif ("HASH" eq ref $p) {
	return dep_pkg_included($p, $check_backports, $need_udeb);
    } else {
    }
    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 $check_backports = shift;
	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, $check_backports));

	# 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, $check_backports);
	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, $check_backports);
		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, $check_backports);
		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, $check_backports);
		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, $check_backports);
        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;
	if (exists $excluded{$p}) {
	    return not $excluded{$p}
	}
	# Return false for a non-existent package ...
	return 0;
}

sub add_suggests {
	my $deps_list = shift;
	my $pkg = shift;
	my $check_backports = 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, $check_backports);
	}
}

sub add_recommends {
	my $deps_list = shift;
	my $pkg = shift;
	my $check_backports = 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, $check_backports);
	}
}

sub get_missing {
	my $p = shift;
	my $check_backports = shift;
	my @deps_list = ();
	my @parents = ();
	my %t;
	my $dep_text;
	my $found_missing = 0;

	$t{"Package"} = $p;
	$t{"CmpOp"} = "";
	$t{"Version"} = "";

	if (add_missing (\@deps_list, $packages{$p}{"Depends"}, \%t, 0, \@parents, $check_backports)) {
		$found_missing = 1;
	}

	if ($add_rec and add_missing (\@deps_list, $packages{$p}{"Recommends"}, \%t, 1, \@parents, $check_backports)) {
		$found_missing = 1;
	}

	if ($add_sug and add_missing (\@deps_list, $packages{$p}{"Suggests"}, \%t, 1, \@parents, $check_backports)) {
		$found_missing = 1;
	}

	if (not $found_missing) {
		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 $check_backports = shift;
	my $pkgname;
	my (%pkgin);

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

	my $need_udeb = $packages{$pkgin{"Package"}}{"IsUdeb"};

	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, $check_backports, $need_udeb)) {
			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, $check_backports, $need_udeb)) {
					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, check_backports $check_backports\n");
				
				foreach my $pkg (@{$thisdep}) {
				    my %t = %$pkg;
				    my $pkgname = $t{"Package"};
				    if (not accepted($pkgname)) {
					if ($check_backports && accepted("$pkgname/$codename-backports")) {
					    $pkgname = "$pkgname/$codename-backports";
					    $t{"Package"} = $pkgname;
					} else {
					    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
					# FIXME! NEED TO CHECK IF VERSION DEPS ARE SATISFIED, FALL BACK TO BPO VERSION
					push (@{$list}, $pkg);
					if (add_missing ($list, $packages{$pkgname}{"Depends"}, $pkg, $soft_depend, $parents, $check_backports)) {
					    $or_ok = 1;
					    if ($add_rec) {
						add_missing ($list, $packages{$pkgname}{"Recommends"}, $pkg, 1, $parents, $check_backports);
					    }
					    if ($add_sug) {
						add_missing ($list, $packages{$pkgname}{"Suggests"}, $pkg, 1, $parents, $check_backports);
					    }
					    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, $check_backports, $need_udeb)) {
				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, $check_backports)) {
				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;
				}
			} else {
			    if ($add_rec) {
				add_missing ($list, $packages{$t{"Package"}}{"Recommends"}, \%t, 1, $parents, $check_backports);
			    }
			    if ($add_sug) {
				add_missing ($list, $packages{$t{"Package"}}{"Suggests"}, \%t, 1, $parents, $check_backports);
			    }
			}
			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 $check_backports = 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)) {
			my $text = $excluded{"$pkgname"};
			msg(1,"  $pkgname has been refused because of $text ...\n");
			$ok = 0;
			push @to_remove, $thispkg;
			$reasons = $reasons . " " . $excluded{$pkgname};
			next;
		}
		if ($check_backports &&
		    ($pkgname !~ /\/$codename-backports/) &&
		    (not accepted("$pkgname/$codename-backports"))) {
			my $text = $excluded{"$pkgname/$codename-backports"};
			msg(1,"  $pkgname/$codename-backports has been refused because of $text} ...\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;
		}
		if ($check_backports && $included{"$pkgname/$codename-backports"}) {
			msg(1, "  $pkgname/$codename-backports 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";
}