#!/usr/bin/perl
#
#  emsource -- get Debian source, create and apply emdebian patches
#  Copyright (C) 2007-2008  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/>.
#

# Uses config::auto for the user's preferred working directory.
# use apt-get source to get the package, calls dpkg-source -x for us.
# checkout the emdebian changes, if any, from:
# http://buildd.emdebian.org/repos/source/target/trunk/$package/trunk/
# check for $package/ from the output of:
# svn list http://buildd.emdebian.org/repos/source/target/trunk/
# if exists, checkout the patches - use debconf setting for username to commit.
# ready for emdebuild which can modify the patches for the next release.

use Cwd;
use Config::Auto;
use File::HomeDir;
use File::Basename;
use Text::Wrap;
use Debian::DpkgCross;
use Cache::Apt::Package;
use Cache::Apt::Config;
use Cache::Apt::Lookup;
use Emdebian::Tools;
use Term::ANSIColor qw(:constants);
use strict;
use warnings;

use vars qw/$username $verbose $our_version $home $dpkg_cross_dir
$cfile $workdir $package $retval $svnadd $svnlogin $progname $suite
$indexchar $clog $debver $cleanup $msg $v $src $arch $autobuild $next
$newversion $chrootbuild $findonly $stats $builddep $patchdir
$machine $variant $machine_path $machine_done /;

$progname = basename($0);
$our_version = &tools_version();
$verbose = 1;
$cleanup = 0;
$autobuild = 0;
$findonly = 0;
$builddep = 0;
$machine_done = 0;
$stats = 0;
$chrootbuild = 0;
$next = 0;
# tracks whether debian/changelog applies cleanly
$newversion = 0;
$username = "";
$suite = &get_targetsuite;
# svnadd == 0 if package exists in svn, 1 if files need to be added.
$svnadd = 1;
&read_config();
$arch = &get_architecture();
$home = File::HomeDir->my_home;
$dpkg_cross_dir = &get_aptcross_dir();

sub usageversion {
	print(STDERR <<END)
$progname version $our_version

Usage:
 $progname [-u USERNAME] [-a ARCH] [-m NAME] [-V NAME] [-v] [-q] PACKAGE
 $progname [-a ARCH] [--build-dep] [-m NAME] [-V NAME] [--machine-path PATH] [-v] [-q] -b PACKAGE
 $progname [-a ARCH] [-m NAME] [-V NAME] [--machine-path PATH] [-v] [-q] -c PACKAGE
 $progname [-a ARCH] [-m NAME] [-V NAME] [--machine-path PATH] [-v] [-q] -p PACKAGE
 $progname [-a ARCH] [-v] [-q] --where PACKAGE
 $progname [-a ARCH] [-v] [-q] --status PACKAGE
 $progname -?|-h|--help|--version

Commands:
 -c|--clean PACKAGE:  clean up the source tree for PACKAGE
 -b|--build PACKAGE:  Attempt an automated build of PACKAGE using emdebuild
 -p|--chroot PACKAGE: Attempt an automated build of PACKAGE using empdebuild
    --where PACKAGE:  Echo the path to the Emdebian build for PACKAGE and exit
    --status PACKAGE: Print a brief summary of the package build status and exit

Options:
 -a|--arch ARCH:          Set architecture (default: defined by dpkg-cross)
 -u|--username:           Your username to commit to Emdebian SVN, if any.
    --build-dep:          Pass --build-dep option to emdebuild. Requires -b.
 -m|--machine NAME:       Specify a machine name for customisation hooks
 -V|--variant NAME:       Specify a machine variant name for customisation hooks.
                          Requires -m.
    --machine-path PATH:  Specify the root of the path to replace the '\$WORK/machine'
                          default. Requires -m.
 -v|--verbose:            Be verbose (repeat for more verbosity)
 -q|--quiet:              Be quiet [default]
 -?|-h|--help:            Print this usage message and exit
 --version:               Print this usage message and exit

$progname combines the functionality of 'apt-get source' and
'svn checkout' to maintain a record of Emdebian changes to
Debian packages. Changes can be committed back to Emdebian
SVN after a successful build using 'emdebuild --svn'.

User-specific configuration values in ~/.dpkg-cross/emsource,
override any debconf default in /etc/emsource.conf. If no
preferred working directory is set, $progname unpacks the requested
package to a new subdirectory in the current working directory.

Automated builds should only be attempted when updating an existing
Emdebian package. Most Debian packages will fail to build first time
without manual changes to the emdebian patch files.

If a username is neither set in the configuration file nor supplied
using -u | --username, $progname will use anonymous svn and
modifications to the emdebian patches (by emdebuild) should be
contributed back to Emdebian via other means.

Machine:variant customisation uses patches stored (or accessible via)
your Emdebian working directory, configured via debconf. Patches
are only used when -m is used. If -V is omitted, the 'default' variant
is assumed. The full path to the patches is constructed from the default
root path ('\$WORK/machine/'), the machine-variant path ('\$machine/\$variant/')
and the package path ('\$initial_char/\$package_name/') - similar
to the path used in repositories and by $progname. Use --machine-path to
change the default root path - the rest of the patch path is unchanged.

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

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit (0);
	}
	elsif (/^(--where|--where-is)$/) {
		$findonly = 1;
	}
	elsif (/^(--status)$/) {
		$stats = 1;
	}
	elsif (/^(--build-dep)$/) {
		$builddep = 1;
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-c|--clean)$/) {
		$cleanup++;
	}
	elsif (/^(-b|--build)$/) {
		$autobuild++;
		$cleanup++;
	}
	elsif (/^(-p|--chroot)$/) {
		$chrootbuild++;
		$cleanup++;
	}
	elsif (/^(-u|--username)$/) {
		$username = shift(@ARGV);
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(-m|--machine)$/) {
		$machine = shift(@ARGV);
	}
	elsif (/^(-V|--variant)$/) {
		$variant = shift(@ARGV);
	}
	elsif (/^(--machine-path)$/) {
		$machine_path = shift(@ARGV);
	}
	else
	{
		&usageversion();
		die RED, "unrecognised option:  $_.", RESET . "\n";
	}
}

if (! $ARGV[0])
{
	&usageversion;
	print RED, "Please specify a package to download and patch.\n\n", RESET;
	exit (1);
}

my $target_gnu_type = &check_cache_arch($arch);
if ((not defined $arch)||($arch eq "")||(not defined $target_gnu_type))
{
	&usageversion;
	$msg = "\n$progname: Cannot determine the architecture to build";
	$msg .= " and no default architecture found.";
	$msg .= " Please use '$progname --arch ARCH'.\n";
	die RED, wrap('','',$msg), RESET, "\n";
}

my $quiet = "";
$quiet = "-q" if ($verbose < 1);
$package = $ARGV[0];
&set_verbose($verbose);
&set_suite($suite);
my $config = &init_cache($verbose);
my $val = &get_primary;
&set_mirror("ftp://$val/debian") if (defined $val);

# check apt-cross is up to date
print CYAN, "Checking the apt-cross cache is up to date for $arch.\n", RESET if ($verbose >= 1);
&check_update($verbose);

# check user input and convert to a source package name if not already.
$package = &check_package($package);
die "\n" if ($package eq "");
($indexchar)=split(//, $package);
my $dir = $src . "-" . $v;

&where_is if ($findonly > 0);
&show_stats if ($stats > 0);

# make this go away with libsvn-perl eventually.
$msg = "$progname: please install 'subversion' before using $progname.\n";
die RED, $msg, RESET if (! -x "/usr/bin/svn");

# read emsource config file.
$workdir = &get_workdir;
$workdir = "/" if ($workdir eq "");
$msg = &check_workdir($workdir);
die RED, $msg, RESET if ($msg ne "");
chdir ("$workdir") if ($workdir ne ".");
print CYAN, "Working directory: '" . cwd . "'\n", RESET if ($verbose >= 2);
$username = &get_username if ($username eq "");
# only unstable builds should be committed to SVN or uploaded.
# see emsource (1)
$username = "" if (($suite ne "unstable") && ($suite ne "sid"));

# handle developer vs anonymous SVN access
$svnlogin = "svn+ssh://" . $username .
	"\@buildd.emdebian.org/var/emdebian/svn/current/target/trunk/"   if ($username ne "");
$svnlogin = "http://buildd.emdebian.org/repos/current/target/trunk/" if ($username eq "");

# Possible calls:
# 1: Completely new build. svnadd = 1, no patch files exist locally or in SVN.
# 2. Partial data exists in SVN. (if one developer has started but failed and someone else tries.)
#		only an empty directory tree exists in SVN. add patch files upon successful build. svnadd=0
# 3. Existing build, no fresh package upstream. abort. (patch files exist and SVN exists). svnadd=0
# 4. Existing build, new upstream package. Remove .old and restart as new. svnadd=0
# Note: do not remove .svn without also (re)moving ../trunk and using svn update!

print CYAN, "Checking for existing emdebian patches\n", RESET if ($verbose >= 1);
# need the login here because we don't necessarily have a working directory yet.
my $svncheck = `svn --non-interactive list $svnlogin/$indexchar/ 2>/dev/null`;
$svnadd = 0 if ($svncheck =~ /\Q$package\E\//);

# now check out the svn, if any
if ($svnadd == 0)
{
	print CYAN, "Checking out working copies of existing emdebian patches\n", RESET
		if ($verbose >= 2);
	# existing co ignores ./trunk which is created when adding a new package
	# so keep all packages together.
	mkdir ("trunk") if (! -d "trunk");
	mkdir ("trunk/$indexchar") if (! -d "trunk/$indexchar");
	chdir ("trunk/$indexchar");
	# create a local working copy
	system ("svn co --non-interactive $quiet ${svnlogin}${indexchar}/${package}");
	# now change to the package trunk
	chdir ("$package/trunk");
}
else
{
	print GREEN, "Adding new package '$package' to emdebian SVN.\n", RESET
		if (($verbose >= 2) && ($username ne ""));
	system ("svn co --non-interactive $quiet -N ${svnlogin}");
	chdir ("trunk");
	system ("svn co --non-interactive $quiet -N ${svnlogin}/$indexchar");
	mkdir ("$indexchar/$package");
	mkdir ("$indexchar/$package/trunk");
	mkdir ("$indexchar/$package/branches");
	mkdir ("$indexchar/$package/tags");
	system ("svn add --non-interactive $quiet $indexchar/$package") if ($username ne "");
	# this doesn't ignore all built files, just the main ones
	# unfortunately, svn doesn't have an 'ignore-except'
	# whilst retaining an ability to add new files (like a new cache file).
	# Using propset also *replaces* existing settings, so it has to be used
	# here and not later. (svn isn't easy to automate sometimes.) :-(
	# some packages will still need manual svn propedit commands.
	# note that packages beginning with e have no ignore property set - needs manual intervention.
	system ("svn propset --non-interactive svn:ignore \"${indexchar}*\" $indexchar/$package/trunk/")
		if (($username ne "") && ($indexchar ne "e"));
	system ("svn ci --non-interactive $quiet -m \"automated $progname checkin of empty tree\" $indexchar/$package")
		if ($username ne "");
	chdir ("$indexchar/$package/trunk");
}

my $top = cwd;

if ($cleanup > 0)
{
	$dir = &catch_no_dir if(! -d "$dir");
	if (! -d $dir)
	{
		print GREEN, wrap('','',"$progname: refreshing source directory ".
		"'$top/$dir' for $package."), RESET, "\n";
		chdir ("$top");
		$retval = 0;
		$retval = system ("apt-get source $package");
		exit($retval) if ($retval != 0);
	}
	chdir ("$dir");
	&emcleanup($package);
	print CYAN, wrap('','',"\nCleaned and emdebianised source tree for '$package' exists at\n"),"'$top/$dir'\n", RESET;
	# look in the configured alternative tree for more patches.
	if ($autobuild > 0)
	{
		chdir ("$top/$dir");
		if ($builddep > 0)
		{
			print CYAN, "Installing build dependencies with apt-get\n", RESET
				if ($verbose >= 1);
			print GREEN, "Enter your sudo password if prompted.\n", RESET if ($verbose >= 2);
			system ("sudo apt-get -y build-dep $package");
			print CYAN, "Installing cross dependencies with emdebuild -a $arch --build-dep\n", RESET
				if ($verbose >= 1);
			my $quiet = "";
			$quiet = "-q" if ($verbose < 1);
			system ("emdebuild -a $arch $quiet --build-dep");
		}
		print GREEN, "Attempting an automatic build for $arch\n", RESET
			if ($verbose >= 1);
		my $n = "";
		# run emdebuild and die if it dies.
		$n="-n" if ($next > 0);
		my $retval = system ("emdebuild $n -a $arch");
		# if emdebuild fails, emsource -b needs to just die.
		$retval = $retval >> 8 if ($retval != 0);
		exit ($retval);
	}
	if ($chrootbuild > 0)
	{
		chdir ("$top/$dir");
		print GREEN, "Attempting an automatic chroot build.\n", RESET if ($verbose >= 1);
		my $retval = system ("nice -n 7 sudo empdebuild --arch $arch --build");
		exit (($retval >> 8));
	}
	print CYAN, wrap('','',"Change to this directory before running 'emdebuild' or".
		" 'sudo empdebuild --arch $arch --build'\n"), RESET if ($verbose >= 2);
	print "\n";
	exit(0);
}

print CYAN, "Checking for existing build tree in $dir.\n", RESET if ($verbose >= 2);
# check first in case there is already an emdebianised build tree here.
# leave it alone if it is up to date.
# A refreshed Debian version will have the same source DIRECTORY so CHECK!
# no source has been downloaded, yet.
if ( -d "$dir")
{
	chdir ("$dir");
	$clog = `parsechangelog --format dpkg | grep Version`;
	$clog =~ /^Version: (.*)$/;
	$debver = $1;
	my $retver = "";
	$retver = &extract_emdebversion($clog);
	my $msg = "\n$progname: Error. Source exists but no emdebian version found!\n";
	die (RED, $msg, RESET) if ($retver eq "");
	print "emdebian version = $retver\n" if ($verbose >=2);
	$clog =~ s/$retver//;
	chomp ($clog);
	if ($clog =~ /^Version: (.*)$/)
	{
		my $check=$1;
		# 1. the source directory exists, 2. the emdebian patch files exist and have been applied
		# 3. the Debian package is the same version as the emdebianised tree - Abort.
		$msg="\n$progname: $src version $check has already been emdebianised - nothing to do. ";
		$msg .= "Emdebianised source tree for '$package' exists at '$top/$dir' ";
		$msg .= "Change to this directory before running 'emdebuild'\n" if ($verbose >= 2);
		die (RED, wrap('','',$msg), RESET, "\n") if ("${check}$retver" eq $debver);
		# if we get here, the debian version does not match the emdebian version.
		# need to move this $dir and the emdebian patch files then start afresh.
		# new debian version => em1 emdebian version string.
		# reprepro won't complain as long as the md5sum of the .orig.tar.gz is the same.
		chdir ("../");
		$msg = "$progname has detected a fresh Debian release: $v. The old emdebianised tree ";
		$msg .= "for emdebian version ${v}${retver} will be moved to ../branches/${dir} for later reference. ";
		$msg .= "You should delete ../branches/${dir} if it is no longer needed. It will be overwritten if ";
		$msg .= "$progname is called again.\n";
		$msg .= "Proceeding to clean the trunk directory.\n";
		print RED, wrap('', '', $msg), RESET;
		system ("rm -rf ${dir}.tmp") if (-d "${dir}.tmp");
		system ("rm -rf ../branches/${dir}") if (-d "../branches/${dir}");
		# remove the old pristine debian files, prepare for a new package.
		system ("rm -rf ${src}.old") if (-d "${src}.old");
		system ("mv $dir ../branches/${dir}");
		# With an updated upstream, any existing emdebian patch files will be overridden anyway
		unlink ("../emdebian-changelog.patch");
		unlink ("../emdebian-control.patch");
		unlink ("../emdebian-rules.patch");
		# we now have a fresh location for the new tree.
	}
	else
	{
		$msg = "\n$progname: Error. Unable to compare emdebian and debian version strings!\n";
		die (RED, $msg, RESET);
	}
}
# no build tree exists for the current Debian version, check for svn patches, get source then apply.
chdir ("$top");
print GREEN, wrap('','',"No unpacked source directory for Debian version $v,".
	" getting Debian source\n"), RESET if ($verbose >= 2);
$retval = system ("apt-get $quiet source $package");
exit($retval) if ($retval != 0);
# catch errors where package-version does not match the unpacked directory name.
$dir = &catch_no_dir if(! -d "$dir");
chdir ("$dir");
&prepare_pristine($package);

# there is always a changelog patch
if (-f "../emdebian-changelog.patch")
{
	print CYAN, "Emdebianising source tree. Applying patches from SVN.\n", RESET
		if ($verbose >= 2);
	&apply_patches;
	opendir (PATCHES, "../") or die (RED, "Unable to open parent directory.", RESET, "\n");
	# patches intended for debian/patches use the names: debian-patch-$file
	my @patchfiles=grep(/^debian-patch-.*$/, readdir PATCHES);
	closedir (PATCHES);
	foreach my $patch (@patchfiles)
	{
		$patch =~ s/^debian-patch-//;
		my $patchdir;
		if (-d "debian/patches-applied")
		{
			$patchdir = "debian/patches-applied";
		}
		else
		{
			$patchdir = "debian/patches";
		}
		mkdir $patchdir unless (-d $patchdir);
		open (PATCH, "../debian-patch-$patch") or
			warn (RED, "Cannot open debian-patch-$patch : $!", RESET, "\n");
		my @p=<PATCH>;
		close (PATCH);
		print GREEN, "Restoring debian patch: $patch\n", RESET;
		open (DPATCH, ">$patchdir/$patch") or
			warn (RED, "Cannot write debian patch: $!", RESET, "\n");
		print DPATCH @p;
		close (DPATCH);
	}
}
else
{
	# Need to manage patch files that are no longer created or which are newly added. FIXME
	# intention is that a fresh tree - including a new upstream version needs to have em_make run.
	print CYAN, "Emdebianising source tree\n", RESET if ($verbose >= 2);
	system ("em_make $quiet --forceold --arch $arch");
}
if ($svnadd == 1)
{
	chdir("../");
	if (($verbose >= 2) && ($username ne ""))
	{
		my $msg = "Placing initial emdebian patch files under SVN version control. ";
		$msg .= "Completed patch files can be checked into Emdebian SVN ";
		$msg .= " using 'emdebuild --svn' or individually using 'svn ci <file>'.\n";
		print GREEN, wrap('','', $msg), RESET;
		system ("svn add --non-interactive $quiet emdebian-changelog.patch emdebian-rules.patch emdebian-control.patch") if ($username ne "");
	}
	chdir("$dir");
}
print CYAN, wrap('','',"\nEmdebianised source tree for '$package' exists at '$top/$dir'\n"), RESET;
print CYAN, wrap('','',"Change to this directory before running 'emdebuild' or 'sudo empdebuild --build'\n"), RESET
	if ($verbose >= 2);
print "\n";

exit (0);

sub cleanup_vers
{
	my $t = $_[0];
	return undef if (not defined($t));
	$t =~ s/^[0-9]*\://;
	$t =~ s/\-.*$//;
	return $t;
}

sub try_patch ($$)
{
	$patchdir = shift;
	my $patchfile = shift;
	my $reverse_sym = "";
	my $reverse = 0;
	print CYAN, "Trying a dry-run for ${patchdir}${patchfile}\n", RESET
		if ($verbose >= 2);
	$retval = 0;
	$retval = system ("patch --dry-run -p1 $reverse_sym < $patchdir/$patchfile >/dev/null");
	if ($retval == 256)
	{
		$reverse_sym = "-R";
		$reverse = 1;
	}
	$retval = system ("patch --dry-run -p1 $reverse_sym < $patchdir/$patchfile >/dev/null");
	$reverse = -1 if ($retval == 256);
	return $reverse;
}

sub check_package
{
	&setup_config;
	my $pkgchk = $_[0];
	my $emp = AptCrossPackage->new();
	$emp->Package($pkgchk);
	my $apt_cross_dir = &get_cachedir;
	$suite = &get_targetsuite;
#	&use_hostsources;
	my $config = &init_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($config);
		utime(time, time, "$apt_cross_dir/.aptupdate-stamp-$suite-host")
			or ( open(F, ">$apt_cross_dir/.aptupdate-stamp-$suite-host") && close F )
	}
	$emp = &srclookup($pkgchk);
	$emp = &binlookup($pkgchk) if (not defined $emp);
	if (defined $emp)
	{
		my $vers = $emp->{Version};
		$v = &cleanup_vers($vers);
		$src = (defined $emp->{SourcePkg}) ? $emp->{SourcePkg} : $emp->{Package};
		print CYAN, "Using $src as source package for $package ($v)\n", RESET if ($verbose >= 2);
		my $bins = $emp->{Binaries};
		my %archlist=();
		foreach my $bin_chk (@$bins)
		{
			my $bemp = AptCrossPackage->new();
			$bemp->Package($bin_chk);
			$bemp = &lookup_pkg($bemp);
			next unless (defined $$bemp->Architecture);
			$archlist{$$bemp->Architecture}++;
		}
		warn (RED, wrap('','',"$progname: Warning. '$pkgchk' provides no packages for '$arch' " .
			"or '$pkgchk' could be a new package that is not yet available for '$arch'."),
			RESET,"\n") if (not defined ($archlist{$arch}));
		# ensure the source package is returned.
		return $src;
	}
	my $msg = "Unable to locate source for package '$_[0]' - please check the spelling of the package name. ";
	$msg .= "Consider using 'dpkg -S $_[0]' to identify the source package if the spelling is correct.\n";
	print RED, wrap('','', $msg), RESET
		if ($verbose >= 1);
	return "";
}

sub catch_no_dir
{
	opendir(DIR, ".") or die (RED, "Cannot find or open $dir: $!", RESET);
	my @dirs=readdir(DIR);
	closedir(DIR);
	foreach my $f (@dirs)
	{
		if ((-d $f) && ($f =~ /^\Q$package\E/) && ($f !~ /\.old$/) && (-d "$f/debian"))
		{
			$dir = $f;
		}
	}
	return $dir;
}

sub apply_patches()
{
	$patchdir = shift;
	$patchdir = "../" if (not defined $patchdir);
	# emdebian patch files use the names: emdebian-$file.patch
	opendir (PATCHES, "$patchdir") or die ("Unable to open parent directory.\n");
	my @patchfiles=grep(/^emdebian-.*\.patch$/, readdir PATCHES);
	closedir (PATCHES);
	foreach my $patch (sort @patchfiles)
	{
		my $reverse = &try_patch($patchdir, $patch);
		if ($reverse == -1)
		{
			warn (RED, "Skipping $patch, unable to apply it.", RESET, "\n");
			if ($patch =~ /^emdebian-changelog.patch$/)
			{
				if ($autobuild > 0)
				{
					print GREEN, "Using 'emdebuild -n' to refresh the changelog patch\n"
						, RESET;
					# need to output something about the version being attempted here.
					$clog = `parsechangelog --format dpkg | grep Version`;
					$clog =~ s/^Version: (.*)$/$1/;
					chomp ($clog);
					# If the changelog patch fails to apply, assume a new version em1
					print RED, "$progname: Attempted version: ${clog}em1\n", RESET;
				}
				$next = 1;
			}
			else
			{
				# flag this package as having out of date patches.
				system ("embug -o");
				# do not autobuild if patches have failed.
				exit (1) if ($autobuild > 0);
			}
			next;
		}
		if ($reverse == 1)
		{
			warn (RED, "$patch has already been applied, skipping", RESET, "\n");
			next;
		}
		print GREEN, "Applying $patch\n", RESET if ($verbose >= 2);
		$patch =~ /^emdebian-(.*)\.patch$/;
		my $tidy = $1;
		$newversion = 1 if ($patch =~ /^emdebian-changelog.patch$/);
		$retval = 0;
		$retval = system ("patch -p1 < $patchdir/$patch");
		print RED, "patch reported an error for $patchdir/$patch.\n", RESET if ($retval != 0);
		# tidy up after the patch command.
		unlink "debian/$tidy.orig" if ( -f "debian/$tidy.orig");
		unlink "debian/$tidy.rej" if ( -f "debian/$tidy.rej");
	}
	# now repeat for machine variant patches
	return if ($machine_done > 0);
	&machine_variant;
}

sub machine_variant
{
	# outline support for machine/variant patching.
	return if (not defined $machine);
	return if ($machine_done > 0);
	$variant = 'default' if (not defined $variant);
	# progress marker
	print GREEN, "Checking for customised patches for $machine:$variant\n", RESET;
	if (not defined $machine_path)
	{
		$workdir = &get_workdir;
		$workdir = "/" if ($workdir eq "");
	}
	else
	{
		$workdir = $machine_path;
	}
	$msg = &check_workdir($workdir);
	die RED, $msg, RESET if ($msg ne "");
	$patchdir = "${workdir}/machine/$machine/$variant/${indexchar}/${package}/";
	$patchdir =~ s://:/:g;
	print CYAN, "Patch directory: '$patchdir'\n", RESET if ($verbose >= 2);
	$machine_done = 1;
	&apply_patches($patchdir) if (-d $patchdir);
	# stamp file to prevent emdebuild committing machine-specific changes
	# to Emdebian SVN.
	open (STAMP, ">../machine-patch.stamp")
		or die (RED,"Unable to write stamp file",RESET,".\n");
	print STAMP "$machine:$variant\n";
	close (STAMP);
}

# attempt to unwind a damaged/borked or otherwise bust emsource directory.
sub emcleanup ()
{
	my $cwd = cwd;
	print CYAN, "Cleaning $cwd:\n", RESET if ($verbose >= 1);
	# need to remove ../trunk and run svn update from there or barff if there is no ../trunk
	if (! -d "../.svn")
	{
		my $msg = "No .svn directory found, no ../../trunk/ - cannot clean up $dir for $package";
		$msg .= "You may have to put the Debian source into a safe directory and ";
		$msg .="then remove ../../trunk before rerunning '$progname $package'.";
		die (RED, wrap('','',"$msg\n"), RESET)
			if ( ! -d "../../trunk");
	}
	# remove the stamp file for machine_variant, if any
	unlink ("../machine-patch.stamp") if (-f "../machine-patch.stamp");
	system ("rm -f ../emdebian*.patch");
	system ("rm -f ../debian-patch*");
	my $v = ($verbose >= 1) ? "" : "-q";
	system ("svn update --non-interactive $v ../");
	# remove .old, remove and replace source
	system ("rm -rf ../$package.old") if (-d "../$package.old");
	chdir ("../");
	system ("rm -rf ./$dir") if((-d "./$dir") && ("$dir" ne ""));
	$retval = system ("apt-get source $package");
	exit($retval) if ($retval != 0);
	# in case a new upstream release has changed the directory name.
	$cwd = &catch_no_dir;
	chdir ($cwd);
	&prepare_pristine($package);
	print CYAN, "Emdebianising source tree. Applying patches from SVN.\n", RESET
		if ($verbose >= 2);
	&apply_patches();
	opendir (PATCHES, "../") or die (RED, "Unable to open parent directory.", RESET, "\n");
	# patches intended for debian/patches use the names: debian-patch-$file
	my @patchfiles=grep(/^debian-patch-.*$/, readdir PATCHES);
	closedir (PATCHES);
	foreach my $patch (sort @patchfiles)
	{
		$patch =~ s/^debian-patch-//;
		mkdir "debian/patches" unless (-d "debian/patches");
		open (PATCH, "../debian-patch-$patch") or
			warn (RED, "Cannot open debian-patch-$patch : $!", RESET, "\n");
		my @p=<PATCH>;
		close (PATCH);
		print GREEN, "Restoring debian patch: $patch\n", RESET;
		open (DPATCH, ">debian/patches/$patch") or
			warn (RED, "Cannot write debian patch: $!", RESET, "\n");
		print DPATCH @p;
		close (DPATCH);
		# add this patch to the patch series, if one is in use
		`echo $patch >> debian/patches/series` 
			if (( -f "debian/patches/series" ) && ($patch !~ /^series$/));
	}
}

sub where_is ()
{
	$workdir = &get_workdir;
	$workdir = "/" if ($workdir eq "");
	$msg = &check_workdir($workdir);
	die RED, $msg, RESET if ($msg ne "");
	print CYAN, "Working directory: '$workdir'\n", RESET if ($verbose >= 2);
	my $where = "$workdir/trunk/$indexchar/$src/trunk/$dir/";
	$where =~ s://:/:;
	if ( ! -d $where)
	{
		chdir ("$workdir/trunk/$indexchar/$src/trunk");
		$dir = &catch_no_dir;
		$where = "$workdir/trunk/$indexchar/$src/trunk/$dir/";
		$where =~ s://:/:;
		if ( ! -d $where)
		{
			print RED, "Cannot find '$where'.\n", RESET;
			print GREEN, wrap('','', "$package exists in Debian but does not appear" .
				" to have been built on this machine yet. Try '$progname $package'\n"), RESET
				if ($verbose >= 2);
			exit (0);
		}
	}
	print GREEN, "$package is located in: '$where'", RESET, "\n";
	exit (0);
}

sub show_stats ()
{
	$workdir = &get_workdir;
	$workdir = "/" if ($workdir eq "");
	$msg = &check_workdir($workdir);
	die RED, $msg, RESET if ($msg ne "");
	print CYAN, "Working directory: '$workdir'\n", RESET if ($verbose >= 2);
	my $where = "$workdir/trunk/$indexchar/$src/trunk/";
	$where =~ s://:/:;
	if ( ! -d $where)
	{
		print RED, "Cannot find '$where'.\n", RESET;
		print GREEN, wrap('','', "$package exists in Debian but does not appear" .
			" to have been built on this machine yet. " . "Try '$progname $package'\n"), RESET if ($verbose >= 2);
		exit (0);
	}
	print CYAN, "Checking status of $src in $where\n", RESET if ($verbose >= 1);
	my $empatches = `find $where -name emdebian\\*.patch | grep -c emdebian.*\.patch`;
	chomp($empatches);
	print GREEN, "$empatches emdebian patch files\n", RESET;
	my $debpatches = `find $where -name debian-patch\\*.patch | grep -c debian-patch.*\.patch`;
	chomp($debpatches);
	if (($debpatches == 0) or ($debpatches > 1)) { print CYAN, "$debpatches debian patch files\n", RESET; }
	else { print CYAN, "$debpatches debian patch file\n", RESET; }
	# trunk == emdebuild pbuilder/result == empdebuild
	my @locations = qw: trunk pbuilder/result:;
	foreach my $loc (@locations)
	{
		$where = "$workdir/${loc}/$indexchar/$src/trunk/";
		$where =~ s://:/:;
		next if (! -d $where);
		print CYAN, "\nChecking emdebuild status in $where\n", RESET
			if ($loc =~ /^trunk$/);
		print CYAN, "\nChecking empdebuild status\n", RESET if ($loc =~ /^pbuilder\/result$/);
		$where =~ s://:/:;
		my @all = `find "$where" -name "${src}_*_${arch}.build"`;
		my @embuild = `find "$where" -name "${src}_${v}*_${arch}.build"`;
		if (scalar @embuild == 1)
		{
			print GREEN, "build log:\n", RESET;
			my $state = `tail $where/${src}_${v}*_${arch}.build`;
			print RED, "\t${src} (${v}) FAILED to cross build for $arch.\n", RESET
				if ($state =~ /dpkg-buildpackage: failure/)
		}
		print GREEN, "build logs:\n", RESET
			if ((scalar @embuild == 0) and (scalar @all == 0));
		print RED, "$package may be out of date.\n", RESET
			if ((scalar @embuild == 0) and (scalar @all > 0));
		print GREEN, "build logs:\n", RESET if (scalar @embuild >1);
		foreach my $l (@embuild)
		{
			$l =~ /\Q${src}_${v}\E(.*)_${arch}.build/;
			my $emver = $1;
			$emver =~ s/^\-//;
			print "${where}${src}_${v}-${emver}_${arch}.build\n";
		}
		my @emchanges = `find "$where" -name "${src}_${v}*_${arch}.changes"`;
		print GREEN, ".changes:\n", RESET if (@emchanges);
		my $latest_v = 0;
		my $latest_c;
		foreach my $l (@emchanges)
		{
			chomp($l);
			$l =~ /\Q${src}_${v}\E(.*)_${arch}.changes/;
			my $emver = $1;
			$emver =~ s/^\-//;
			my $lv = $emver;
			$lv =~ s/[^0-9]//g;
			if ($lv > $latest_v)
			{
				$latest_v = $lv;
				$latest_c = $l;
			}
			print "$l";
			if (( -e "/usr/bin/gpg") and ($verbose >= 2))
			{
				`gpg --verify $l 2>/dev/null`;
				if ( $? == 0)
				{
					print "\n";
					system ("gpg --verify $l");
				}
				else { print GREEN, " unsigned.", RESET; }
			}
			print "\n";
		}
		if ((defined $latest_c) and ($loc eq "trunk"))
		{
			# run lintian
			chomp($latest_c);
			print GREEN, "Running lintian checks for Emdebian only.\n", RESET;
			print GREEN, wrap ('','',"Checking only the most recent .changes file:".
				" '$latest_c'\n"), RESET if ($verbose >= 2);
			system ("lintian --color auto -C em $latest_c");
			system ("embug --lintian -p $src") if ($? != 0);
			print GREEN, "Finished running lintian.\n", RESET;
		}
		my @emupload = `find "$where" -name "${src}_${v}*_${arch}.upload"`;
		my %repository=();
		print GREEN, ".upload:\n", RESET if (@emupload);
		foreach my $l (@emupload)
		{
			$l =~ /\Q${src}_${v}\E(.*)_${arch}.upload/;
			my $emver = $1;
			my $upcount = 0;
			my $upfile = "${where}${src}_${v}${emver}_${arch}.upload";
			print "$upfile\n";
			if ((defined $emver) and ( -f "$upfile"))
			{
				$emver =~ s/^\-//;
				open (UP, "$upfile");
				my @repo=<UP>;
				close (UP);
				foreach my $rep (@repo)
				{
					$rep =~ /\s(\S+)\.$/;
					$repository{$1}++;
					$upcount++;
				}
				print CYAN, "$upcount files uploaded to " . join(", ", keys (%repository));
				my @about = stat "$upfile";
				# read the ctime of the .upload file
				print " on " . scalar localtime($about[10]) . " for ${v}${emver}\n", RESET;
			}
		}
	}
	if  (-f "/usr/bin/emrecent")
	{
		$where = "$workdir/trunk/$indexchar/$src/trunk/";
		$where =~ s://:/:;
		print CYAN, "Checking for error logs in $where", RESET,"\n";
		if (-f "${where}emrecent_error.log")
		{
			open (LOG, "${where}emrecent_error.log")
				or die ("Cannot open error log. $!\n");
			my @log=<LOG>;
			close (LOG);
			print RED, @log, RESET;
			print GREEN, wrap('','',"If these errors have been resolved, delete ".
			"the '${where}emrecent_error.log' file.\n"), RESET;
		}
	}
	print CYAN, "Checking bug status",RESET,"\n";
	# read embug data.
	my $bugs = &bug_config;
	if (not defined $bugs->{$package})
	{
		print GREEN, "No open cross-building bugs for $package\n", RESET;
	}
	elsif ($bugs->{$package} eq "")
	{
		print GREEN, "$package is flagged but no bug has been reported.", RESET, "\n";
	}
	else
	{
		my $number = $bugs->{$package};
		my $rr = (ref($number) eq 'ARRAY') ? join(' #', @$number) : $number;
		print GREEN, "$package has an open cross-building bug report: $rr\n", RESET;
		$rr = (ref($number) eq 'ARRAY') ? join("\nhttp://bugs.debian.org/", @$number) : $number;
		print GREEN, "http://bugs.debian.org/$rr\n", RESET;
	}
	my $config = &target_config();
	if (defined $config->{"$package"})
	{
		print RED, "Emdebian patches for $package are out of date.\n", RESET
			if ($config->{"$package"} eq "patches");
		print RED, "$package FAILED to build.\n", RESET
			if ($config->{"$package"} eq "failed");
		print RED, wrap('','',"$package is waiting for a dependency - see ".
		"above.\n"), RESET
			if ($config->{"$package"} eq "waiting");
	}
	exit (0);
}