#!/usr/bin/perl -w

# Check the dependency tree of a package.

use strict;
use warnings;

use MLDBM qw(DB_File Storable);
use Fcntl;

my %packages;
my %virtuals;
my $debug=0;

tie(%packages, "MLDBM", $ENV{"HOME"} . "/.packages-dbm", O_RDONLY, 0640) or die "Could not open cache file: $!";
tie(%virtuals, "MLDBM", $ENV{"HOME"} . "/.virtuals-dbm", O_RDONLY, 0640) or die "Could not open cache file: $!";

sub check_depends($$\%);

sub debug_print($) {
	if($debug) {
		print $_[0];
	}
}

# Return value is a list:
# First value:
# 1 - yes, all depends can be satisfied
# 0 - no, not all depends can be satisfied. 
# Second value contains what should be copy-pasted into a dep-wait string
sub check_depends($$\%) {
	my $ws = shift;
	my $dep = shift;
	my $done_yet = shift;
	my $pname;
	my $rel;
	my $ver;
	my $dep_part;
	my $alt;
	my @deps;
	my $satisfied;

	$dep=~s/^\s*//;
	$dep=~s/\s*$//;
	if(exists $done_yet->{$dep}) {
		debug_print "${ws}skipping $dep, we've already checked that or are doing so\n";
		return 1, undef;
	}
	debug_print "${ws}considering $dep\n";
	$done_yet->{$dep}=$dep;
	if($dep=~/^([^ ]*) \(([=<>]*) (.*)\)$/) {
		$pname = $1;
		$rel = $2;
		$ver = $3;
	} elsif($dep=~/^[^ ]*$/) {
		$pname = $dep;
	}
	if(!exists $packages{$pname}) {
		if(exists($virtuals{$pname})) {
			my $prov;

			debug_print "${ws}$pname is a pure virtual package; checking possibilities\n";
			foreach $prov(@{$virtuals{$pname}{Provider}}) {
				my $satisfied;
				my $dw;
				($satisfied, $dw) = check_depends($ws . " ", $prov, %$done_yet);
				if($satisfied) {
					return 1, undef;
				}
			}
			debug_print "${ws}no package providing $pname is installable\n";
		}
		debug_print "${ws}$pname is not available in any version\n";
		return 0, $pname;
	} else {
		debug_print "${ws}$pname has version " . $packages{$pname}{Version} . "\n";
	}
	if(defined $rel && defined $ver) {
		my @cmd;

		debug_print "${ws}checking versioned dependency...\n";
		@cmd = qw/dpkg --compare-versions/;
		push @cmd, ($packages{$pname}{Version}, $rel, $ver);
		system(@cmd);
		if($?) {
			debug_print "${ws}version " . $packages{$pname}{Version} . " of package $pname does not satisfy constraint $rel $ver\n";
			if($rel eq "=") {
				$rel = ">=";
			}
			return 0, "$pname ($rel $ver)";
		}
		debug_print "${ws}ok\n";
	}
	if(!exists($packages{$pname}{Depends})) {
		debug_print "${ws}ok: $dep\n";
		return 1, undef;
	} else {
		debug_print "${ws}$pname Depends: " . $packages{$pname}{Depends} . "\n";
	}
	@deps = split(/,/, $packages{$pname}{Depends});
	foreach $dep_part(@deps) {
		my $dw;
		if($dep_part=~/\|/) {
			my $firstdw=undef;
			debug_print "${ws}found alternative dependencies $dep_part\n";
			foreach $alt(split(/\|/, $dep_part)) {
				debug_print "${ws}trying alternative $alt:\n";
				($satisfied, $dw) = check_depends($ws . "|", $alt, %$done_yet);
				last if $satisfied;
				if(!defined($firstdw)) {
					$firstdw=$dw;
				}
			}
			if(!$satisfied) {
				debug_print "${ws}none of the alternatives was installable\n";
				return 0, $firstdw;
			}
		} else {
			($satisfied, $dw) = check_depends($ws . "|", $dep_part, %$done_yet);
			if(!$satisfied) {
				return 0, $dw;
			}
		}
	}
	debug_print "${ws}ok: $dep\n";
	return 1, undef;
}

if(defined $ARGV[0]) {
	$debug = shift;
}

while(<>) {
	my %hash;
	my $retval;
	my $dw;

	chomp;
	($retval, $dw) = check_depends("", $_, %hash);
	if($retval) {
		print "everything is a-ok\n";
	} else {
		print "dep-wait $dw\n";
	}
}