#!/usr/bin/perl
#
#  apt-cross -- apt support for cross compiling
#  Copyright (C) 2006  Wookey <wookey@debian.org>
#  Copyright (C) 2006  Hector Oron <hector.oron@gmail.com>
#  Copyright (C) 2006-2009  Neil Williams <codehelp@debian.org>
#
#  This package is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 3 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

use Cwd;
use File::Basename;
use LWP::Simple;
use LWP::Simple qw($ua);
use Cache::Apt::Lookup;
use Cache::Apt::Config;
use Cache::Apt::Package;
use Debian::DpkgCross;
use Class::Struct;
use File::HomeDir;
use Data::Dumper;
use Digest::MD5;
use Term::ProgressBar;
use strict;
use warnings;
use vars qw ($file $archivename $verbose $deb $package $suite
$source $mirror $apt_cross_dir @source_list $debsize %debs $debcache
$arch %package_list $result $mtime $time_now $m $check @contents $dir
@dirs @touch $print $dpkg_cmd $retval $mode $progname $host_config
$APTCROSSVERSION $home @install_list $pkg %exclude
%seen $simulate $host_config $config $skip_installed $num $old
%newpkg %upgrade $keep_temp %user_list $download_count );

$APTCROSSVERSION = &get_cache_apt_version;
$progname = &basename($0);
$apt_cross_dir = &get_aptcross_dir;
if (not -d $apt_cross_dir) {
	mkdir $apt_cross_dir or die ("Cannot create $apt_cross_dir: $!\n");
}

sub showversion {
	print(STDERR <<END)
apt-cross version $APTCROSSVERSION

END
	or die "$progname: failed to write version: $!\n";
}

sub showusage {
	print(STDERR <<END)
apt-cross version $APTCROSSVERSION

Usage:
 apt-cross [-x|--exclude] [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] -i|--install <packages...>
 apt-cross [-x|--exclude] [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] [-f|--force] -b|--build <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] [-f|--force] -g|--get <packages...>
 apt-cross [-a|--arch ARCH] -r|--remove|--purge <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] -s|--show <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] -l|--list <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] -u|--update
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] -c|--check

Commands:
 -i|--install PACKAGE ... :         get, build and install a list of packages.
 -b|--build PACKAGE ... :           get and build a list of packages.
 -g|--get PACKAGE ... :             get a list of packages for the default or
                                     specified architecture.
 -r|--remove|--purge PACKAGE ... :  Remove the cross-built package using dpkg
 -s|--show PACKAGE :                Show the package information for the 
                                     specified cross-built package
 -l|--list :                        List all cross-built package names
 -u|--update :                      Force the per-user arch-specific cache 
                                     to be updated.
 -c|--check :                       Check if the per-user arch-specific cache
                                     needs an update, update it if necessary.
    --clean-lists :                 Force the per-user package lists to 
                                     be updated.

Options:
 -a|--arch ARCH:        set architecture (default: defined in configuration file)
 -S|--suite SUITE:      set the Debian suite (stable, testing, unstable [default])
 -m|--mirror MIRROR:    set the Debian mirror to use to retrieve packages
                         (default: first usable apt source)
 -x|--exclude PACKAGE:  exclude a specific package from the dependency list.
 -n|--simulate          Show the calculated list of cross packages needing to
                         be installed without installing. Requires -i.
 -k|--keep-temp         Keep the temporary archives downloaded as cross 
                         dependencies. Requires -i.
 -f|--force:            Download and rebuild the ARCH package even if the
                         cross package is already installed at the same version.
 -v|--verbose:          be verbose
 -q|--quiet:            be quiet
 -?|-h|--help:          print the version, usage and long help message then exit.
    --version:          print the version and exit.
    --usage:            print the version and usage information, then exit

END
	or die "$progname: failed to write usage: $!\n";
}

sub showhelp {
	print(STDERR <<END)
apt-cross provides apt functionality for getting, building and installing
libraries and header files for cross-compiling using dpkg-cross. apt-cross
will search for and download missing dependencies of the requested package
before making the requested package and dependencies available for
installation via dpkg-cross.

apt-cross is intended to make it easier to locate, download, install and
update your cross-compiling libraries, directly from the Debian archives.

apt-cross is not intended to handle applications or Architecture: all packages
like foo-common or libfoo-common. apt-cross can download and build the cross-
compiling version of those packages but does not install them - you can do that
with dpkg-cross -A if necessary but not all such packages can be installed in
that way.

By default, apt-cross uses your /etc/apt/sources.list or
/etc/apt/sources.list.d/*to find the latest debian package file for the
architecture specified (default is the dpkg-cross default) and in the suite
specified (default is unstable). Alternatively, you can specify a different
mirror. Downloaded files can be passed to dpkg-cross using the -b or -i
commands to apt-cross. If the local file is missing or out of date, a new one
will be downloaded automatically.

To force an update of the cache, use apt-cross --update. Note that all sources
for this suite on this arch will be removed before the package cache is updated.
If /etc/apt/sources.list or /etc/apt/sources.list.d/* does not contain a source
for this suite, the updated cache for this suite will be empty. Use -m|--mirror
to specify a source to be added to whatever sources are available for this
suite in /etc/apt/sources.list or /etc/apt/sources.list.d/*.

END
	or die "$progname: failed to write usage: $!\n";
}

# read in dpkg-cross default arch
&read_config();
$arch = &get_architecture();
%exclude=();
%seen=();
%user_list=();
$mode = "";
$verbose = 1;
$suite = &get_suite;
$keep_temp = 0;
$skip_installed = 1;
%package_list = qw//;
$retval = 0;

my @rotor = qw ( - \ | / );
my $rotorcount = 0;
$simulate = 0;

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help)$/) {
		&showusage;
		&showhelp;
		exit( 0 );
	}
	elsif (/^(--version)$/) {
		&showversion;
		exit( 0 );
	}
	elsif (/^(--usage)$/) {
		&showusage;
		exit( 0 );
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-n|--simulate)$/) {
		$simulate = 1;
	}
	elsif (/^(-f|--force)$/) {
		$skip_installed = 0;
	}
	elsif (/^(-k|--keep-temp)$/) {
		$keep_temp = 1;
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(-S|--suite)$/) {
		$suite = shift(@ARGV);
	}
	elsif (/^(-m|--mirror)$/) {
		$mirror = shift(@ARGV);
	}
	elsif (/^(-i|--install)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "install";
	}
	elsif (/^(-g|--get)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "get";
	}
	elsif (/^(-r|--remove|--purge)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "remove";
	}
	elsif (/^(-s|--show)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "status";
	}
	elsif (/^(-l|--list)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "list";
	}
	elsif (/^(-b|--build)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "build";
	}
	elsif (/^(-u|--update)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "update";
	}
	elsif (/^(--clean-lists)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "cleanlists";
	}
	elsif (/^(-c|--check)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "check";
	}
	elsif (/^(-x|--exclude)$/) {
		$exclude{shift(@ARGV)}++;
	}
	else {
		&showusage;
		die "$progname: Unknown option $_.\n";
	}
}
&set_verbose ($verbose);
&set_mirror ($mirror) if (defined $mirror);
my $list = &Cache::Apt::Lookup::prepare_sources_list;
my %m=();
foreach my $s (@$list)
{
	chomp ($s);
	$m{$suite}++ if ($s =~ /$suite/);
}
if (not exists $m{$suite} and not defined $mirror)
{
	system ("echo \"ERROR: Empty sources list! Check the output of ".
	"'apt-cache policy' and make sure '$suite' is included".
	" in your apt sources lists.\n\"|fold -s");
	print join ("\n", @$list) . "\n\n" if ($verbose >= 2);
	exit 4;
}
&set_suite ($suite);
&check_arch($arch) if (defined ($arch));
# extra call needed so that Cache::Apt::* does not have to depend
# on Debian::DpkgCross
&check_cache_arch($arch) if (defined ($arch));
# called after a mode has been set to check the rest of ARGV.
sub check_args
{
	$_=shift;
	if ((/^(-i|--install)$/) || (/^(-g|--get)$/)   || (/^(-r|--remove|--purge)$/) ||
		(/^(-s|--status)$/)  || (/^(-l|--list)$/)  || (/^(-b|--build)$/) ||
		(/^(-u|--update)$/)  || (/^(-c|--check)$/) || (/^(--clean-lists)$/)) {
		if ($mode) {
			&showusage;
			die "$progname: Only one action can be specified! mode=$mode\n";
		}
	}
	if ($simulate && $mode ne "install") {
		&showusage;
		die "$progname: --simulate requires --install\n";
	}
}

&setup();

if ((!defined($arch)) || ($arch eq ""))
{
	print "\n";
	print "$progname: Unable to identify a default architecture for cross-building.\n";
	print "please use '$progname --arch ...' or set a dpkg-cross default architecture\n";
	print "using debconf: 'sudo dpkg-reconfigure dpkg-cross'\n\n";
	die ("No default architecture, --arch not used.");
}

$config = &init_cache($verbose);

if (!$mode || (!@ARGV && $mode ne "list" && $mode ne "update"
	&& $mode ne "check" && $mode ne "cleanlists")) {
	&showusage;
	die "$progname: Too few arguments.\n"
}

for my $pkg (@ARGV)
{
	$user_list{$pkg}++;
}

if ($mode eq "get") {
	&cross_get;
	&download_arch_packages;
	exit 0;
}

if ($mode eq "check") {
	&check_update($verbose);
	exit 0;
}

if ($mode eq "update")
{
	&force_update;
	exit 0;
}

if ($mode eq "cleanlists")
{
	my $dir = &get_aptcross_dir();
	system ("rm -f $dir/$suite/lists/*");
	&force_update;
	exit 0;
}

if ($mode eq "status")
{
	&show_cross;
	exit 0;
}

elsif ($mode eq "list") {
	&setup_config;
	&update_sources;
	# more like apt-cache pkgnames for cross-compiled packages
	my @list = `apt-cache -o Apt::Architecture=$arch pkgnames 2>/dev/null`;
	@list = sort (@list);
	foreach $pkg (@list)
	{
		chomp ($pkg);
		if (!($pkg =~ /$arch-cross$/)) { next; }
		print "$pkg\n";
	}
}

elsif ($mode eq "remove") {
	$dpkg_cmd = "--purge";
	my $cmdline = "sudo dpkg $dpkg_cmd " . join( " ", map( rewrite_pkg_name($_), @ARGV ));
	print "Calling $cmdline\n" if $verbose >= 2;
	system( $cmdline );
	$retval = $? >> 8;
	exit $retval;
}

elsif ($mode eq "install") {
	# Checks to see if the install has already been done
	&cross_get;
	# %user_list is the command line list of packages
	%user_list = %package_list;
	# add dependencies to the %package_list
	&check_depends;
	# check the dependencies added
	&check_depends;
	&summarize_depends;
}

elsif ($mode eq "build") {
	&cross_get;
	&download_arch_packages;
	&request_build;
}

exit 0;

sub show_cross
{
	&setup_config;
	&update_sources;
	$host_config = &init_host_cache($verbose);
	#start by downloading sources, but only if not already done this 24hrs
	my $mtime = (stat ("$apt_cross_dir/.aptupdate-stamp-$suite-host"))[9];
	$mtime = 0 if (!defined($mtime));
	my $time_now = time();
	if ($time_now - $mtime > 86400) {
		print "Updating apt-cache for host\n" if ($verbose >= 2);
		&cache_update($host_config);
		utime(time, time, "$apt_cross_dir/.aptupdate-stamp-$suite-host")
			or ( open(F, ">$apt_cross_dir/.aptupdate-stamp-$suite-host") && close F )
	}
	foreach $pkg (@ARGV)
	{
		&check_args($pkg);
		$pkg = &rewrite_pkg_name($pkg);
		print "Checking for $pkg in apt cache.\n" if ($verbose >= 2);
		my $check = &binlookup($pkg);
		print Dumper ($check) if ($verbose >= 4);
		if (!defined($check))
		{
			# if apt-cache cannot find a package, then the -cross
			# version is not available from a repository, it may have
			# been installed by apt-cross so try dpkg-query -s
			print "$pkg was not found in any repository.\n" if ($verbose >= 3);
			print "Checking for $pkg in dpkg lists.\n" if ($verbose >= 2);
			my $retval = system ("dpkg-query -s $pkg 2>/dev/null");
			print "$progname: Unable to find $pkg.\n" if ($retval);
		}
		my $emp = new AptCrossPackage;
		$emp->Distribution($suite);
		$emp->Architecture($arch);
		$emp->Package($pkg);
		$emp = &lookup_pkg($emp);
		print Dumper($emp) if ($verbose >= 4);
		&output_pkg ($emp);
	}
}

# get details of the cross package.
sub cross_get
{
	&setup_config;
	&update_sources;
	my $config = &init_cache($verbose);
	$print = "Arch:     $arch\nSuite:    $suite\n";
	for my $pkg (keys %user_list)
	{
		&check_args($pkg);
		my $check = &binlookup($pkg);
		print Dumper($check) if ($verbose >= 4);
		if (!defined($check))
		{
			print $print if ($verbose >= 3);
			warn ("$progname is unable to locate package: '$pkg' - skipping\n");
			next;
		}
		my $emp = new AptCrossPackage;
		$emp->Distribution($suite);
		$emp->Architecture($arch);
		$emp->Package($pkg);
		$emp = &lookup_pkg($emp);
		print Dumper($emp) if ($verbose >= 4);
		# hash: key is package name, value is .deb filename (later)
		$package_list{$pkg}=$emp;
		$print .= "Package:  $pkg\n";
		&check_installed($pkg, $$emp->Version);
	}
	print $print if (($verbose >= 3) && (defined($pkg)));
}

sub identify_sources
{
	my %hash=();
	my @list=();
	# collate all available/configured sources into one list
	if (-e "/etc/apt/sources.list") {
		open (SOURCES, "/etc/apt/sources.list") or die "cannot open apt sources list. $!";
		while(<SOURCES>) {
			my $src = $_;
			chomp($src);
			next if ($src =~ /^#/);
			$src =~ s/\n//g;
			$hash{$1}++ if ($src =~ /deb (.*) $suite/);
		}
		close (SOURCES);
	}
	if (-d "/etc/apt/sources.list.d/") {
		opendir (FILES, "/etc/apt/sources.list.d/")
			|| die "cannot open apt sources.list directory $!";
		my @files = grep(!/^\.\.?$/, readdir FILES);
		foreach my $f (@files) {
			next if ($f =~ /\.ucf-old$/);
			open (SOURCES, "/etc/apt/sources.list.d/$f") or
				die "cannot open /etc/apt/sources.list.d/$f $!";
			while(<SOURCES>) {
				my $src = $_;
				chomp($src);
				next if ($src =~ /^#/);
				$src =~ s/\n//g;
				$hash{$1}++ if ($src =~ /deb (.*) $suite/);
			}
			close (SOURCES);
		}
		closedir (FILES);
	}
	@list = sort keys %hash;
	return \@list;
}

sub lwpprogress
{
	my $url = shift;
	my $errcode;
	my $uri = URI->new($url);
	my $path = $uri->path;
	my $output = 0;
	my $target_is_set = 0;
	my $next_so_far = 0;
	$path =~ s{.*/}{};
	return unless length $path;
	# md5sum already checked so if it exists, it's borked.
	unlink ($path) if -e $path;
	open my $outhandle, ">", $path or die "Cannot create $path: $!";
	if ($verbose < 1)
	{
		$errcode = $ua->get ($url,":content_cb" => sub {
			my ($chunk, $response, $protocol) = @_;
			print {$outhandle} $chunk;
		});
	}
	else
	{
		my $title = $download_count." to download";
		my $bar = Term::ProgressBar->new({ name => $title, count => 1024, ETA => 'linear'});
		$errcode = $ua->get ($url,":content_cb" => sub {
			my ($chunk, $response, $protocol) = @_;
			unless ($target_is_set) {
				if (my $cl = $response->content_length) {
					$bar->target($cl);
					$target_is_set = 1;
				} else {
					$bar->target($output + 2 * length $chunk);
				}
			}
			$output += length $chunk;
			print {$outhandle} $chunk;
			if ($output >= $next_so_far) {
				$next_so_far = $bar->update($output);
			}
		});
		$bar->target($output);
		$bar->update($output);
	}
	print "Server Error: " . $errcode->message . "\n"
		if ((is_error($errcode->code)) and ($verbose >= 1));
	close ($outhandle);
	$download_count--;
	return $errcode->code;
}

sub download_arch_packages
{
	my $uri;
	my $prefix;
	my $path;
	my $server;
	my %dwn_list=();
	$config = &init_cache($verbose);
	# prepare a string for apt that includes all the options
	# to only download matches from the apt-cross cache.
	my $str = &set_download_mode($config);
	print "modified cache: $str\n" . Dumper($config) if ($verbose >= 4);
	$prefix = &identify_sources;
	$server = pop @$prefix;
	for my $pkg (keys %package_list)
	{
		if (defined $exclude{$pkg})
		{
			print "Excluding $pkg from download.\n" if ($verbose >= 3);
			next;
		}
		my $emp = $package_list{$pkg};
		$path = $$emp->Filename;
		if (not defined $path)
		{
			print "No path to filename for '$pkg' - skipping download.\n"
				if ($verbose >= 4);
			next;
		}
		$file = basename($path);
		# check installed - allow a force routine for chroots
		if ($skip_installed > 0)
		{
			my $package = $$emp->Package;
			my $arch = $$emp->Architecture;
			my $version = $$emp->Version;
			my $installed = `dpkg-query -W -f='\${Status}' ${package}-${arch}-cross 2>/dev/null`;
			my $check_vers = `dpkg-query -W -f='\${Version}' ${package}-${arch}-cross 2>/dev/null`;
			print "Checking if $package ($version) is installed . . ." if ($verbose >= 3);
			if (($installed eq "install ok installed") && ($check_vers eq $version))
			{
				print " yes.\n" if ($verbose >= 3);
				print "$package-$arch-cross ($version) is already installed.\n" if ($verbose >= 1);
				next;
			}
			print " no.\n" if ($verbose >= 3);
		}
		$debs{$file} = $pkg;
		if (-e $file)
		{
			my $ctx = Digest::MD5->new;
			open (LOCAL, "$file") || die "cannot open local file $!";
			$ctx->addfile(*LOCAL);
			close (LOCAL);
			unlink $file if ($ctx->hexdigest ne $$emp->FileMD5Hash);
			next $file if ($ctx->hexdigest eq $$emp->FileMD5Hash);
		}
		elsif (-e "/var/cache/apt/archives/$file")
		{
			my $ctx = Digest::MD5->new;
			open (LOCAL, "/var/cache/apt/archives/$file") or die "cannot open cached file $!";
			$ctx->addfile(*LOCAL);
			close (LOCAL);
			if ($ctx->hexdigest eq $$emp->FileMD5Hash)
			{
				print "$file exists in the apt cache, skipping download.\n" if ($verbose >= 2);
				open (LOCAL, ">$file") || die "cannot open local file $!";
				open (CACHE, "</var/cache/apt/archives/$file") || die "cannot open cache file $!";
				print LOCAL <CACHE>;
				close (CACHE);
				close (LOCAL);
				next;
			}
		}
		if (-e $file)
		{
			my $ctx = Digest::MD5->new;
			open (LOCAL, "./$file") or die "cannot open ./file $!";
			$ctx->addfile(*LOCAL);
			close (LOCAL);
			if ($ctx->hexdigest eq $$emp->FileMD5Hash)
			{
				print "File '$file' already exists " .
				"with the same MD5sum, skipping download.\n" if ($verbose >= 2);
				next;
			}
		}
		my $str = $config->{main}->{'config_str'};
		# use apt-get to create the filename because this (should)
		# allow URI's to a CDROM etc. Unfortunately, apt-get includes
		# the uri's for all the dependencies too. :-(
		print "apt-get $str install $pkg\n" if ($verbose >= 3);
		my @list = `apt-get $str install $pkg`;
		foreach my $line (@list)
		{
			$line =~ /\'(.*\.deb)\'/;
			my $p = $1;
			my $version = $$emp->Version;
			# strip the epoch from the version for this test.
			$version =~ s/[0-9]://;
			my $a = $$emp->Architecture;
			# only retrieve the uri we need
			$uri = $p if ($p =~ /^.*\Q${pkg}_${version}\E_${a}\.deb$/);
		}
		if (not defined($uri))
		{
			print "apt methods failed for $file, falling back to direct cache path.\n";
			$uri = (defined $server) ? $server."/".$path : $mirror."/".$path;
			print "Trying: path=$uri\n" if ($verbose >= 2);
		}
		$dwn_list{$pkg}=$uri;
		print "Filename: $file\n" if ($verbose >= 2);
		print "FullPath: $uri\n" if ($verbose >= 3);
	}
	$download_count = scalar keys %dwn_list;
	while (($pkg, $uri) = each (%dwn_list))
	{
		$deb = lwpprogress($uri);
		while (is_error($deb) and (scalar @$prefix > 0))
		{
			$server = pop @$prefix;
			$uri = $server . $path;
			print "Trying: path=$uri\n" if ($verbose >= 2);
			$deb = lwpprogress($uri);
		}
		if (is_error($deb))
		{
			warn "$progname: Error. Failed to locate $pkg.\n";
			next;
		}
	}
}

sub request_install
{
	my $count = keys %debs;
	if ($count == 0) { return; }
	my $x_list = "";
	foreach my $cmd (keys %exclude)
	{
		$x_list .= "-X $cmd ";
	}
	print "Converting $count packages:\n" if $verbose >= 3;
	foreach $package ( keys %debs ) {
		if ($package eq "") { next; }
		if (not -r $package) {
			warn "$progname: cannot access $package: $!\n";
			next;
		}
		if ($skip_installed > 0)
		{
			$pkg = $debs{$package};
			my $emp = $package_list{$pkg};
			my $name = $$emp->Package;
			my $arch = $$emp->Architecture;
			my $version = $$emp->Version;
			my $installed = `dpkg-query -W -f='\${Status}' ${package}-${arch}-cross 2>/dev/null`;
			my $check_vers = `dpkg-query -W -f='\${Version}' ${package}-${arch}-cross 2>/dev/null`;
			print "Checking if $package ($version) is installed . . ." if ($verbose >= 3);
			if (($installed eq "install ok installed") && ($check_vers eq $version))
			{
				print " yes.\n" if ($verbose >= 3);
				print "$package-$arch-cross ($version) is already installed.\n" if ($verbose >= 1);
				next;
			}
			print " no.\n" if ($verbose >= 3);
		}
		push @install_list, $package;
	}
	my $list = join ' ', @install_list;
	if ($list eq "") { return; }
	my $k = ($keep_temp > 0) ? " -k" : "";
	# if a build method becomes available from Debian::DpkgCross or
	# Dpkg::*, use that and drop dependency on dpkg-cross itself.
	if ($verbose >= 3) {
		print "Calling 'dpkg-cross $x_list $k -v -A -i --arch $arch' for $list\n";
		$result = system ("sudo dpkg-cross $x_list $k -v -A -i --arch $arch $list");
	} else {
		$result = system ("sudo dpkg-cross $x_list $k -i -A --arch $arch $list");
	}
	return if ($result);
	return if ($keep_temp > 0);
	# remove downloaded file now that it is installed.
	print ("Removing temporary archives\n") if ($verbose == 1);
	foreach my $file (@install_list)
	{
		print ("Success. Removing temporary archive: $file\n") if ($verbose >= 2);
		unlink ($file);
	}
}

sub request_build
{
	my $count = keys %debs;
	if ($count == 0) { return; }
	my $x_list = "";
	# add any exclusions specified by the user.
	foreach my $cmd (keys %exclude)
	{
		$x_list .= "-X $cmd ";
	}
	foreach $package ( keys %debs ) {
		if ($package eq "") { next; }
		if (not -r $package) {
			warn "$progname: cannot access $package: $!\n";
			next;
		}
		print "checking $package dependencies . . . \n" if ($verbose >= 2);
		# this could be a package that is otherwise unknown to both
		# apt and dpkg so we cannot use dpkg-query or nc here.
		my $pkg = `dpkg -I $package | grep Package`;
		$pkg =~ /Package: (.*)/;
		my $name = $1;
		chomp($name);
		my $emp = new AptCrossPackage;
		$emp->Distribution($suite);
		$emp->Architecture($arch);
		$emp->Package($name);
		&lookup_pkg($emp);
		print Dumper ($emp) if ($verbose >= 4);
		my $depend = $emp->Depends;
		foreach my $d (@$depend)
		{
			my $n = $$d->Package;
			my $p = new AptCrossPackage;
			$p->Distribution($suite);
			$p->Architecture($arch);
			$p->Package($n);
			&lookup_pkg($p);
			# add exclusions for ALL architecture-independent dependencies.
			if ($p->Architecture eq "all")
			{
				print "Skipping Arch:all dependency $n.\n" if ($verbose >= 3);
				$exclude{$n}++;
			}
			my $test = $p->Depends;
			foreach my $td (@$test)
			{
				# last chance to remove conflicts.
				$exclude{$n}++ if ($$td->Type =~ /^Conflicts$/);
			}
			undef $p;
		}
		foreach my $X (keys %exclude)
		{
			$X =~ s/ //g;
			$x_list .= "-X $X " if ((defined $X) and ($X =~ /^.+$/));
		}
		if ($verbose >= 2) {
			print "Calling 'dpkg-cross $x_list -v -b -A --arch $arch' for $package\n";
			$result = `dpkg-cross $x_list -v -b -A --arch $arch $package`;
			print $result;
		} else {
			$result = `dpkg-cross $x_list -b -A --arch $arch $package`;
		}
	}
}

sub check_installed
{
	my $check_package = shift;
	my $vers = shift;
	return 1 if (($skip_installed == 0) and (defined $user_list{$check_package}));
	my $exists = `dpkg-query -W -f=' \${Package} \(\${Version}\)' $check_package-$arch-cross 2>/dev/null`;
	if ($exists eq " $check_package-$arch-cross ($vers)")
	{
		print "$check_package-$arch-cross is installed ($vers)\n" if ($verbose >= 2);
		delete $package_list{$check_package};
		return 1;
	}
	if ($exists =~ /\((.+)\)/)
	{
		$upgrade{$check_package}++;
		print " ($1) installed " if ($verbose >= 2);
	}
	else
	{
		$newpkg{$check_package}++;
	}
	return 0;
}

sub check_conflicts
{
	# dep_type contains the package to check
	# dep_pkg contains the package which depends on the one being checked.
	# bug: should check the dependencies of dep_type to prevent 
	# orphan packages.
	my $dep_type = shift;
	my $dep_pkg = shift;
	# get the other details for dep_type as dep_data
	my $dep_data = new AptCrossPackage;
	$dep_data->Distribution($suite);
	$dep_data->Architecture($arch);
	$dep_data->Package($$dep_type->Package);
	&lookup_pkg($dep_data);
	if (($$dep_type->Type =~ /^Conflicts$/) and 
		((defined $dep_data->Version) and (defined $$dep_type->VersionLimit)))
	{
		my $limit = $$dep_type->Operator . " " . $$dep_type->VersionLimit;
		# e.g. libglib2.0-0 conflicts with libpango1.0-0 (<< 1.11)
		print $$dep_pkg->Package . " conflicts with ".$$dep_type->Package 
			." ($limit)\n" if ($verbose >= 2);
		my $val = 0;
		# Compare package version A with B, returning a negative value if A
		# is an earlier version than B, zero if the same or a positive value
		# if A is later. A = $$dep_pkg->Version B=limit
		# conflict with earlier than limit == negative value.
		# conflict with later than limit == positive value.
		$val = 1 if (($limit =~ /^>>/) or ($limit =~ /^>=/));
		$val = -1 if (($limit =~ /^<</) or ($limit =~ /^<=/));
		my $non_epoch = $dep_data->Version;
		$non_epoch =~ s/^[0-9]://;
		my $compare = &ver_compare($non_epoch, $limit);
		# packages should not use Conflicts: foo (== 1.2.3-1)
		warn ("$progname: malformed version limit?\nConflicts: ".
			$$dep_type->Package." ($limit).\n") if ($val == 0);
		if ($verbose >= 3)
		{
			print "We have " . $dep_data->Package . " (";
			print $dep_data->Version . " ) vs " . $$dep_type->Package;
			print " (" .  $limit . ").\n" . "ver_compare(";
			print $dep_data->Version." $limit) = $compare\n";
		}
		if (($val < 0) and ($compare < 0))
		{
			print $dep_data->Package." (".$dep_data->Version.
				") is newer (which is OK).\n" if ($verbose >= 2);
		}
		else
		{
			print "ver_compare val=$val compare=$compare ".
				$dep_data->Version." $limit\n" if ($verbose >= 4);
			print "Skipping ".$$dep_pkg->Package."\n" if ($verbose >= 2);
			delete $package_list{$$dep_pkg->Package};
			$exclude{$$dep_pkg->Package}++;
		}
	}
	elsif (($$dep_type->Type =~ /^Conflicts$/) and 
		(not defined $$dep_type->VersionLimit))
	{
		print $$dep_pkg->Package . " conflicts with ".$$dep_type->Package ."\n"
			if ($verbose >= 2);
		# if the package was explicitly passed on the command line,
		# drop the other side of the conflict.
		if ((defined $user_list{$$dep_type->Package}) or
			(defined $package_list{$$dep_type->Package}))
		{
			print "Skipping ".$$dep_pkg->Package." due to conflict.\n"
				if ($verbose >= 2);
			delete $package_list{$$dep_pkg->Package};
			$exclude{$$dep_pkg->Package}++;
		}
		else
		{
			print "Skipping ".$$dep_type->Package." due to conflict.\n" 
				if ($verbose >= 2);
			delete $package_list{$$dep_type->Package};
			$exclude{$$dep_type->Package}++;
		}
	}
	undef $dep_data;
}

# conflict resolution and dependency tracing can be complex to debug so
# allow for every omission and every addition to be explained with verbosity
# options. Do not add a 'next' or 'return', add an exclude or delete from
# the %package_list without a 'print "why" if ($verbose >= 3)!
sub find_conflicts
{
	my $main_package = shift;
	if (defined $exclude{$$main_package->Package})
	{
		print "Skipping ".$$main_package->Package." (conflict).\n"
			if ($verbose >= 3);
		return;
	}
	print "processing ".$$main_package->Package." conflicts\n" if ($verbose >= 2);
	my $main_data = new AptCrossPackage;
	$main_data->Distribution($suite);
	$main_data->Architecture($arch);
	$main_data->Package($$main_package->Package);
	&lookup_pkg($main_data);
	my $depend = $main_data->Depends;
	foreach my $dep (reverse @$depend)
	{
		if (($$dep->Type eq "Suggests") or ($$dep->Type eq "Recommends"))
		{
			print "Skipping suggested or recommended dependency".
				$$dep->Package.".\n" if ($verbose >= 4);
			next;
		}
		if ($$dep->Type eq "Replaces")
		{
			print "Skipping ".$$main_package->Package." Replaces ".
				$$dep->Package."\n" if ($verbose >= 4);
			next;
		}
		print $$main_package->Package." ".$$dep->Type ." : " .$$dep->Package."\n"
			if ($verbose >= 3);
		print "Checking ".$$dep->Package." for conflicts\n" if ($verbose >= 3);
		&check_conflicts ($dep, \$main_data);
	}
}

# conflict resolution and dependency tracing can be complex to debug so
# allow for every omission and every addition to be explained with verbosity
# options. Do not add a 'next' or 'return', add an exclude or delete from
# the %package_list without a 'print "why" if ($verbose >= 3)!
sub add_dependencies
{
	my $main_package = shift;

	if (defined $exclude{$$main_package->Package})
	{
		print "Skipping ".$$main_package->Package." - excluded.\n"
			if ($verbose >= 3);
		delete $package_list{$$main_package->Package};
		return;
	}
	print "processing ".$$main_package->Package." dependencies.\n" if ($verbose >= 2);
	my $main_data = new AptCrossPackage;
	$main_data->Distribution($suite);
	$main_data->Architecture($arch);
	$main_data->Package($$main_package->Package);
	&lookup_pkg($main_data);
	my $depend = $main_data->Depends;
	foreach my $dep (@$depend)
	{
		if ($$dep->Type eq "Replaces")
		{
			print "Skipping ".$$main_package->Package." Replaces ".
				$$dep->Package."\n" if ($verbose >= 4);
			undef $seen{$$dep->Package};
			next;
		}
		if (($$dep->Type eq "Suggests") or ($$dep->Type eq "Recommends"))
		{
			print "Skipping suggested or recommended dependency: ".
				$$dep->Package." of ".$$main_package->Package.".\n" if ($verbose >= 4);
			next;
		}
		if ($seen{$$dep->Package})
		{
			print $$dep->Package ." already seen - skipping dependency check.\n"
				if ($verbose >= 4);
			next;
		}
		my $dep_data = new AptCrossPackage;
		$dep_data->Distribution($suite);
		$dep_data->Architecture($arch);
		$dep_data->Package($$dep->Package);
		&lookup_pkg($dep_data);
		if ($verbose >= 2)
		{
			print $$main_package->Package." ".$$dep->Type ." : " .$$dep->Package;
			print " (".$dep_data->Version.")" if (defined $dep_data->Version);
			print "\n";
		}
		if (($dep_data->Architecture eq "all") and ($dep_data->Package !~ /\-dev$/)
			and (not defined $user_list{$dep_data->Package}))
		{
			print $$dep->Package." is Architecture: all - excluding.\n"
				if ($verbose >= 2);
			delete $package_list{$$dep->Package};
			$exclude{$$dep->Package}++;
			undef $dep_data;
			next;
		}
		if (not defined($dep_data->Filename))
		{
			print $$dep->Package." looks like a pseudo package - excluding.\n"
				if ($verbose >= 2);
			delete $package_list{$$dep->Package};
			$exclude{$$dep->Package}++;
			undef $dep_data;
			next;
		}
		if (not defined $dep_data->Version)
		{
			print "No Version found for '".$dep_data->Package."', skipping.\n";
			next;
		}
		if (&check_installed($$dep->Package, $dep_data->Version))
		{
			undef $dep_data;
			delete $package_list{$$dep->Package};
			print $$dep->Package . " is installed already \n" if ($verbose >= 4);
			next;
		}
		if ($$dep->Type eq "Depends")
		{
			print "Adding ".$$dep->Package."\n" if ($verbose >= 2);
			$package_list{$$dep->Package} = \$dep_data;
		}
	}
}

# conflict resolution and dependency tracing can be complex to debug so
# allow for every omission and every addition to be explained with verbosity
# options. Do not add a 'next' or 'return', add an exclude or delete from
# the %package_list without a 'print "why" if ($verbose >= 3)!
sub check_depends
{
	# array of AptCrossPackage variables.
	my @depend = ();
	my $old = scalar keys %package_list;
	my $exists, my $pkg, my $depends;
	my $log = "";
	# %package_list has keys=package names, values=AptCrossPackage
	$old = keys %package_list;
	$rotorcount++;
	$rotorcount = 0 if ($rotorcount > 3);
	print "Checking dependencies: " . $rotor[$rotorcount] . "\r" if ($verbose == 1);
	foreach my $deppkg (keys %package_list)
	{
		chomp ($deppkg);
		$rotorcount++;
		$rotorcount = 0 if ($rotorcount > 3);
		print "Checking dependencies: " . $rotor[$rotorcount] . "\r" if ($verbose == 1);
		if (defined $exclude{$deppkg})
		{
			print "Skipping excluded package: '$deppkg'.\n" if ($verbose >= 3);
			next;
		}
		if ($seen{$deppkg})
		{
			print "Skipping package already seen: '$deppkg'.\n" if ($verbose >= 4);
			next;
		}
		$seen{$deppkg}++;
		my $emp = new AptCrossPackage;
		$emp->Distribution($suite);
		$emp->Architecture($arch);
		$emp->Package($deppkg);
		&lookup_pkg($emp);
		$rotorcount++;
		$rotorcount = 0 if ($rotorcount > 3);
		print "Checking dependencies: " . $rotor[$rotorcount] . "\r" if ($verbose == 1);
		&find_conflicts(\$emp);
		$rotorcount++;
		$rotorcount = 0 if ($rotorcount > 3);
		print "Checking dependencies: " . $rotor[$rotorcount] . "\r" if ($verbose == 1);
		&add_dependencies(\$emp);
		$rotorcount++;
		$rotorcount = 0 if ($rotorcount > 3);
		print "Checking dependencies: " . $rotor[$rotorcount] . "\r" if ($verbose == 1);
	}
	&check_depends if (scalar keys %package_list > $old);
}

sub summarize_depends
{
	my @upgrade=();
	my @newpkg=();
	foreach my $status (sort keys %package_list)
	{
		push @upgrade, $status if (defined $upgrade{$status});
		push @newpkg, $status  if (defined $newpkg{$status});
	}
	# even in quiet mode, simulate needs to output something.
	if (($verbose >= 1) || ($simulate))
	{
		print "The following packages will be UPGRADED:\n ".
			join (' ', @upgrade) . "\n" if (@upgrade);
		print "The following NEW packages will be built and installed:\n ".
			join (' ', @newpkg) . "\n" if (@newpkg);
		print scalar @upgrade . " to be upgraded, ";
		print scalar @newpkg . " to be newly installed.\n";
	}
	return if ($simulate);
	if ($verbose >= 2)
	{
		my @f = keys (%package_list);
		my $s = join (' ' , @f);
		print "Installing: $s\n" if (scalar @f > 0);
	}
	print "Excluding: ".join (' ', sort keys %exclude)."\n" if ($verbose >= 4);
	&download_arch_packages;
	&request_install;
}