#!/usr/bin/perl

#  emdebuild -- Emdebian version of debuild
#
# Checks if a package is emdebianised and runs em_make if not.
# Otherwise, updates emdebian-rules.patch,
# rebuilds the package using dpkg-buildpackage -sa -rfakeroot -a$arch
# and generates a debuild-style build log.
#
#  Copyright 2006-2008 Neil Williams <codehelp@debian.org>
#  Copyright 1998-2006 Craig Small <csmall@debian.org>
#  Copyright 1999-2003 Julian Gilbey <jdg@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/>.
#

# note: running debian/rules alone is unsupported due to the cross-build.

# Most debuild options are not supported - in particular, lintian and linda are not
# supported.

use Carp;
use Cwd;
use Debian::Debhelper::Dh_Lib;
use Debian::DpkgCross;
use Emdebian::Tools;
use Dpkg::Deps;
use File::HomeDir;
use Text::Diff;
use Text::Wrap;
use Term::ANSIColor qw(:constants);
use strict;
use warnings;
use vars qw/@packages $username $email $date $native $emdebvers $emN
$addsource $progname $arch $verbose @options $dpkg_extra $conf $home
$changes $ourversion $emvers $increment $source $vers $svnci $dosign
$onlysvn *BUILD *OLDOUT *OLDERR %archtable $numchecks $host 
$wraplibtool $checkdeps /;

$ourversion = &tools_version();
$progname = basename($0);

# workaround a bug in Debhelper::Dh_Lib #478719
if (defined &inhibit_log)
{
	&inhibit_log;
}

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

Usage:
 emdebuild [-a|--arch ARCH] [-n|--next] [--svn] [--sign] [-v|--verbose] [-q|--quiet]
 emdebuild [--svn-only] [-v|--verbose] [-q|--quiet]
 emdebuild --build-dep
 emdebuild -?|-h|--help|--version

Options:
 -a|--arch ARCH:      set architecture (default: defined by dpkg-cross)
 -n|--next:           Increment the emdebian version before building.
    --svn:            Build package and commit changes to emdebian patches
                       to emdebian SVN if successful (requires developer access).
    --svn-only:       Commit changes to emdebian patches to emdebian SVN.
    --sign:           Use 'debsign' on the .changes file.
 -v|--verbose:        Increase verbosity (max: 3)
 -q|--quiet:          Reduce verbosity.
 -?|-h|--help:        print this usage message and exit
 --version:           print this usage message and exit

emdebuild is the emdebian version of debuild. After a Debian
package has been 'emdebianised' with em_make, emdebuild provides
a convenient wrapper around dpkg-buildpackage.

emdebuild needs to be run in the source directory of the package.

By default, emdebuild cross-builds the package for the dpkg-cross
default architecture. Specify other architectures with -a|--arch.
Ensure the current toolchain is installed for the chosen architecture.

Only automated builds would normally use --quiet, most users are
advised to use --verbose.

If the source is prepared using 'emsource', changes to the emdebian
patch files can be committed to emdebian svn using the --svn option.

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

$verbose = 1;
$increment = 0;
$numchecks = 0;
$checkdeps = 0;
my $dpkg_opts_var = 'DEBUILD_DPKG_BUILDPACKAGE_OPTS';
my $dpkg_options = " nodocs nocheck";
$svnci = "false";
# This is NOT the apt-cross or dpkg-cross dir, just for .devscripts.
$home = File::HomeDir->my_home;
$home = cwd if (!$home);
&read_config();
$arch = &get_architecture();
$addsource = "";
$dosign = "false";
$onlysvn = "false";

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion;
		exit( 0 );
	}
	elsif (/^(--build-dep|--build-deps)$/) {
		$checkdeps = 1;
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(-n|--next)$/) {
		$increment = 1;
	}
	elsif (/^(--svn)$/) {
		$svnci = "true";
	}
	elsif (/^(--sign)$/) {
		$dosign = "true";
	}
	elsif (/^(--svn-only)$/) {
		$onlysvn = "true";
	}
	else
	{
		&usageversion();
		die RED, "unrecognised option:  $_.", RESET . "\n";
	}
}

my $target_gnu_type = &check_arch($arch) if (defined $arch);
if ((not defined $arch)||($arch eq "")||(not defined $target_gnu_type))
{
	warn (RED, "\n$progname: Cannot determine the architecture to build.", RESET, "\n\n");
	&usageversion;
	exit (1);
}
if ($checkdeps > 0)
{
		&crossbuilddeps;
		exit (0);
}
$host = `dpkg-architecture -qDEB_HOST_ARCH_CPU`;
$host =~ s/_/-/;
chomp($host);

my @config_files = ('/etc/devscripts.conf', "$home/.devscripts");
$dpkg_extra = "";
foreach $conf (@config_files)
{
	my $val;
	next if (! -f $conf);
	print CYAN, "Reading devscripts configuration in $conf.\n", RESET if ($verbose >= 3);
	open (CONF, $conf) or warn "Cannot read $conf: $!\n";
	@options=<CONF>;
	close CONF;
	foreach $val (@options)
	{
		if ($val =~ /^$dpkg_opts_var="(.*)"\n$/)
		{
			$dpkg_extra .= " " . $1;
		}
	}
}

print CYAN, "Checking for debian/control\n", RESET if ($verbose >= 2);
&check_emdebian_control;
&init;
@packages = getpackages();
die (RED, "Unable to identify main package using debhelper!", RESET, "\n")
	unless $dh{MAINPACKAGE};
$native = isnative($dh{MAINPACKAGE});
my $package = $dh{MAINPACKAGE};
my %archchk=();
open (CONTROL, 'debian/control') or die ("Cannot read debian/control: $!\n");
while (<CONTROL>) {
	chomp;
	s/\s+$//;
	$archchk{$arch}++ if (/^Architecture:.*$arch.*$/);
	$archchk{$arch}++ if (/^Architecture:\sany$/);
}
close (CONTROL);
warn (RED, "$progname: Warning. '$package' provides no '$arch' packages.",RESET,"\n")
	if (not defined $archchk{$arch});

my $cachefile = "emdebian-${target_gnu_type}.cache.patch";
if ($onlysvn eq "true")
{
	# exit the working directory first.
	chdir ("../") if ( -f "debian/control");
	# cannot pass $build here - determining the build log filename
	# may involve changing the patch files or emdebian version.
	# globbing may be unreliable.
	&handle_svn('',$cachefile);
	exit;
}
my $parse = `parsechangelog`;
$parse =~ /Source: (.*)\n/;
$source = $1;
$source = $dh{MAINPACKAGE} if (!$source);
$parse =~ /(Version: .*)\n/;
my $deb_version = $1;
print GREEN, "Building '$source' for $arch on $host.\n", RESET if ($verbose >= 1);

$emvers = &extract_emdebversion($deb_version);
if ($increment)
{
	print GREEN, "Incrementing emdebian version.\n", RESET if ($verbose >= 2);
	$vers = emdeb_versionstring("next");
	system "debchange -p -v $vers \"New emdebian release.\"";
	$parse = `parsechangelog`;
	$parse =~ /(Version: .*)\n/;
	$deb_version = $1;
	$emvers = &extract_emdebversion($deb_version);
}
if ($emvers eq "")
{
	# run em_make via the emdebian-tools package.
	my $maker = ($verbose >= 2) ? "em_make -v -a $arch" : "em_make -a $arch";
	( -f "/usr/bin/em_make") ? system "$maker" :
		die (RED, "Please run em_make before emdebuild.", RESET, "\n");
	$parse = `parsechangelog`;
	$parse =~ /(Version: .*)\n/;
	$deb_version = $1;
	$emvers = &extract_emdebversion($deb_version);
}
if ($emvers eq "em1")
{
	my $orig_msg = "New emdebian release detected, using '-sa' to include .orig.tar.gz\n";
	print GREEN, wrap('','',$orig_msg), RESET if ($verbose >=2);
	$addsource = '-sa';
}

# update the patches to reflect any manual changes.
# this includes copying patches added to debian/patches
&create_patches($source);

# ensure any hand-edited cache file is preserved - debian/rules will need it.
if (-f "${target_gnu_type}.cache")
{
	print CYAN, "Protecting cache file ${target_gnu_type}.cache . . \n", RESET if ($verbose >=2);
	my $file = "${target_gnu_type}.cache";
	# protect the cache file
	chmod 0444, $file;
	my $cwd = cwd;
	my $working = basename($cwd);
	chdir ("../$source.old/");
	# ensure the patch works from an empty cache file in .old
	open (CPY, ">$file") or die "Cannot write ../$source.old/$file: $!";
	close CPY;
	chdir ("../");
	my $diff = diff "$source.old/$file", "$working/$file", { STYLE => "Unified" };
	open (PATCHFILE, ">emdebian-$file.patch") or warn ("Cannot open emdebian-$file.patch : $!\n");
	print PATCHFILE $diff;
	close (PATCHFILE);
	chdir ("$cwd");
	print GREEN, "$file backed up to ../$source.old/\n", RESET if ($verbose >=2);
}

$emvers = &emdeb_versionstring("next") if ($increment);
$emvers = &emdeb_versionstring("") if (!$increment);
$changes = "${source}_${emvers}_${arch}.changes\n";
# noepoch = version without epoch and colon
my $noepoch = "";
if ($emvers =~ /^[0-9]?:.*/)
{
	$emvers =~ /^[0-9]?:(.*)/;
	$noepoch = $1;
	$changes = "${source}_${noepoch}_${arch}.changes\n";
}
my $build="${source}_${emvers}_${arch}.build";
print CYAN, "Logging build messages to ../$build\n", RESET if ($verbose >= 2);

print GREEN, "Workarounds in use are:\n", RESET if ($verbose >= 2);
my $crossprefix = &check_arch($arch);
my $crossbin;
# setup gccross here.
# A little explanation. This is needed only for linking internal
# libraries within the package. PKG_CONFIG_LIBDIR deals with the rest.
# This is now an opt-in with [X-]Build-Cross-Libtool: yes
$wraplibtool = 0;
if (-f "debian/xcontrol") {
	open (CONTROL, 'debian/xcontrol') or die ("Cannot read debian/xcontrol: $!\n");
	while (<CONTROL>) {
		chomp;
		s/\s+$//;
		$wraplibtool = 1 if (/^[X-]+Build-Cross-Libtool:\s*yes/);
	}
	close (CONTROL);
}
if ($wraplibtool == 1)
{
	my $dpkgcrosspath = "/usr/share/dpkg-cross/bin";
	$crossbin = `mktemp -d -t gccross.XXXXXXXXXX`;
	chomp($crossbin);
	print RED, wrap ('','',"Warning! LIB WORKAROUND in use. Using gccross symlinks ".
	"in $crossbin. See emdebuild (1).\n"), RESET if ($verbose >= 1);
	print CYAN, wrap ('','', "Remove 'X-Build-Cross-Libtool: yes' from 'debian/xcontrol'."
		. "when '$source' is fixed. See emdebuild (1)."), RESET . "\n" if ($verbose >= 2);
	my $path = $ENV{PATH};
	$ENV{PATH} = "$dpkgcrosspath:$path";
	my @pdirs = split (/:/, $ENV{PATH});
	foreach my $d (@pdirs)
	{
		next if (-l "$d");
		my @pathfiles = ();
		next unless ( -d $d);
		opendir (PDIR, $d) or warn ("unable to read $d");
		@pathfiles=grep(!/^\.\.?$/, readdir PDIR);
		closedir (PDIR);
		foreach my $file (@pathfiles)
		{
			next if ("$file" eq "gccross");
			next if ( not -x "$d/$file");
			next if ( -z "$d/$file");
			next if ( -d "$d/$file");
			if ($file =~ /^$crossprefix\-(gcc|cpp|c\+\+|g\+\+|cc|CC)(\-[.0-9]+)*/)
			{
				print GREEN, "symlinking $file to gccross\n", RESET if ($verbose >= 3);
				system ("ln -s $dpkgcrosspath/gccross $crossbin/$file\n")
			}
		}
	}
	$path = $ENV{PATH};
	$ENV{PATH} = "$crossbin:$path:/usr/$crossprefix/bin/";
}
print GREEN, "PATH reset to $ENV{PATH}\n", RESET
	if (($verbose >= 2) and ($wraplibtool == 1));

# remove only once dpkg-cross config files migrate into dpkg-dev.
$ENV{CONFIG_SITE}="/etc/dpkg-cross/cross-config.$arch";
system ("dpkg-architecture -a$arch");
unlink ("debian/files") if (-f "debian/files");
# Always create .build logs, emulate how debuild works
# dpkg-buildpackage doesn't log by default!
# from debuild:
# Start by duping STDOUT and STDERR
open OLDOUT, ">&STDOUT" or croak "cannot duplicate stdout: $!\n";
open OLDERR, ">&STDERR" or croak "cannot duplicate stderr: $!\n";
open BUILD, "| tee ../$build" or croak "could not open pipe to tee $build: $!";
close STDOUT;
close STDERR;
open STDOUT, ">&BUILD" or croak "cannot reopen stdout: $!";
open STDERR, ">&BUILD" or croak "cannot reopen stderr: $!";
# prepare the dpkg-buildpackage command and environment
my $cmd .= "DEB_BUILD_OPTIONS='$dpkg_options' nice -n 7 dpkg-buildpackage ";
$cmd .= "-a$arch $addsource -rfakeroot -d $dpkg_extra -uc -us\n";
my $msg = "Building ${source} ${emvers} for ${arch} with $cmd";
print CYAN, wrap('','',$msg), RESET if ($verbose >= 2);
# build the package here:
my $exitval = 0;
# comment out the next line for quick debugging.
$exitval = system "$cmd";
$exitval = $exitval >> 8 if ($exitval > 0);
# return things to normal before aborting with any dpkg errors
close STDOUT;
close STDERR;
close BUILD;
open STDOUT, ">&OLDOUT";
open STDERR, ">&OLDERR";
`rm -rf $crossbin` if ((defined $crossbin) and ($wraplibtool == 1));
system ("embug --failed") if ($exitval);
exit ($exitval) if ($exitval > 0);

chmod 0644, "${target_gnu_type}.cache" if (-f "${target_gnu_type}.cache");

# Create tdebs
system ("em_installtdeb -a $arch") if ($dosign eq "true");
system ("em_installtdeb -a $arch --no-sign") if ($dosign ne "true");
my $allow = "--allow-root";
print GREEN, "Running lintian checks for Emdebian only.\n", RESET;
system ("lintian $allow --color auto -ioC em ../$changes");
if ($? != 0)
{
	# the embug flag is removed manually when lintian, newer and patches are all fixed.
	system ("embug --lintian");
	die "\n" ;
}
my $tdebchg = "${source}_${emvers}tdeb_$arch.changes";
# lintian errors in TDebs are not fatal.
system ("lintian $allow --color auto -iC em ../$tdebchg") if (-f "../$tdebchg");
print GREEN, "Finished running lintian.\n", RESET;

open (CHG, "../$changes") or die ("FAILED: unable to read ../$changes: $!\n");
open (BUILD, ">>../$build") or die ("Cannot append .changes to .build: $!\n");
print BUILD "\n";
# add test results to build log too.
print BUILD "$numchecks checks successful.\n" if ($numchecks > 1);
print BUILD "One check successful.\n" if ($numchecks == 1);
my $dir = cwd;
$dir .= "/../$changes";
print (GREEN, "Changes file: " . &Cwd::realpath($dir), RESET);
while(<CHG>) {
	print $_;
	print BUILD $_;
}
print GREEN, "\nSuccessful build.\n", RESET;
print GREEN, "Build directory: " . cwd . "/" , RESET, "\n\n";
print BUILD "\nSuccessful build.\n\n";
close BUILD;
close CHG;

chdir ("../");
system "debsign $changes" if ($dosign eq "true");
&handle_svn($build, $cachefile) if ($svnci eq "true");
chomp($changes);
my $manual_check = "Please check the package manually before uploading. e.g.\n";
$manual_check .= "'debc -a $arch ../${changes}'\n'deb-gview ../${changes}'.\n";
print CYAN, $manual_check, RESET if ($verbose >= 2);
exit 0;

sub handle_svn
{
	my $cachefile = $_[1];
	my @patchfiles = glob ('emdebian-*-locale-*.patch');
	my $locpatch = join (" ", @patchfiles);
	my $svndel = scalar @patchfiles;
	if ($svndel > 0)
	{
		print GREEN, "Removing $svndel emlocale patches\n", RESET
			if ($verbose >= 1);
		`svn -q revert ./$locpatch`;
		`svn -q remove ./$locpatch`;
		`svn -q ci -m "Automated removal of locale patches" ./$locpatch`;
	}
	# if machine_variant has been used, skip committing to SVN
	return if (-f "../machine-patch.stamp");
	@patchfiles = ();
	# Include all remaining patch files.
	print CYAN, "Checking in emdebian patch files . . \n", RESET if ($verbose >= 1);
	@patchfiles = glob ('emdebian-*.patch');
	my @debpatch = glob ('debian-patch*');
	push @patchfiles, @debpatch;
	my @svnadds=();
	my @svncommits=();
	my @remd = `svn status . | grep !`;
	my @remlist=();
	foreach my $f (@remd)
	{
		$f =~ s/ //g;
		$f =~ s/!//;
		chomp ($f);
		push @remlist, $f;
	}
	`svn -q remove @remlist` if @remlist;
	`svn -q ci -m "Automated removal" @remlist` if @remlist;
	my $status = `svn status . | grep ?`;
	foreach my $f (@patchfiles)
	{
		push (@svnadds, $f) if $status =~ /\Q$f\E/;
	}
	$status = `svn status .`;
	foreach my $f (@patchfiles)
	{
		push (@svncommits, $f) if $status =~ /\Q$f\E/;
	}
	my $addnum = scalar @svnadds;
	my $commitnum = scalar @svncommits;
	if (@svnadds)
	{
		print GREEN, "Adding $addnum patch files to SVN . . \n", RESET if ($verbose == 1);
		print GREEN, "Adding patch files: ", @svnadds, "\n", RESET if ($verbose >= 2);
		my $add = join(' ', @svnadds);
		system ("svn -q add $add");
	}
	if (@svncommits)
	{
		print GREEN, "Commit $commitnum patch files into SVN . . \n", RESET if ($verbose == 1);
		print GREEN, "Committing patch files: ", join(' ', @svncommits), "\n", RESET if ($verbose >= 2);
		system ("svn ci -q -m \"automated patch file checkin\" @svncommits");
	}
	return;
}

sub crossbuilddeps
{
	my @line = ();
	print CYAN, "Checking for debian/control\n", RESET if ($verbose >= 2);
	&check_emdebian_control;
	print CYAN, wrap('','',"Checking for buildtime cross dependencies ".
		"in 'debian/xcontrol'.\n"), RESET if ($verbose >= 2);
	unless (-f "debian/xcontrol")
	{
		print CYAN, "No xcontrol file. Nothing to do.\n", RESET if ($verbose >= 1);
		return;
	}
	open (XC, "<debian/xcontrol");
	my @xc=<XC>;
	close (XC);
	# allow multi-lines
	my $str = join ("", @xc);
	$str =~ s/\n / /g;
	$str =~ s/  / /g;
	my @long = split ("\n", $str);
	my @unmet = ();
	foreach my $dep (@long)
	{
		# allow xcontrol to contain more than just what we need.
		# support the old format until debian-xcontrol can handle
		# Homepage and Uploaders etc.
		if ($dep =~ /^Build-Cross-Depends: /)
		{
			$dep =~ s/^Build-Cross-Depends: //i;
		}
		elsif ($dep =~ /^Build-Depends: /)
		{
			$dep =~ s/^Build-Depends: //i;
		}
		# Could handle Build-Conflicts but not supported, yet,
		# see dpkg-checkbuilddeps.pl in dpkg : $dep->get_evaluation($facts).
		else { next; }
		# assume nothing is installed, ever. (apt-cross will check that.)
		my $facts = Dpkg::Deps::KnownFacts->new();
		my $dep_list = Dpkg::Deps::parse($dep, reduce_arch => 0);
		$dep_list->simplify_deps($facts);
		unless ($dep_list->is_empty()) {
			@unmet = $dep_list->get_deps();
		}
		foreach my $depref (@unmet)
		{
			# handle OR architecture lists (may be incomplete)
			if ($depref->isa('Dpkg::Deps::OR'))
			{
				my $or = $$depref{'list'};
				next if not defined ($or);
				my $ordep="";
				foreach my $orpkg (@$or)
				{
					my $rel = $$orpkg{'package'};
					if ($rel =~ /\Qnot\E/)
					{
						$rel =~ s/\Qnot+\E//;
						# $ordep contains the alternative - skip it if not for us.
						next if $target_gnu_type !~ /$rel/;
						push @line, $ordep;
					}
					$ordep .= " $rel";
				}
				push @line, $ordep;
			}
			next unless (defined $$depref{'package'});
			push @line, $$depref{'package'};
		}
	}
	return unless (@line);
	my $depstr = join(" ", sort @line);
	my $v = "";
	$v = " -v" if ($verbose >= 2);
	$v = " -q" if ($verbose < 1);
	my $val = &get_primary;
	my $mirror = "";
 	$mirror = " -m ftp://$val/debian" if (defined $val);
	print GREEN, wrap('','',"Installing: $depstr with apt-cross${v}${mirror}.\n"), RESET
		if ($verbose >= 1);
	print CYAN, "Enter your sudo password if prompted.\n", RESET if ($verbose >= 2);
	system ("apt-cross -a $arch $v $mirror -i $depstr");
	# clean up in case some .debs are left over.
	opendir (DEBS, ".") or return;
	my @files=grep(/^.*\.deb$/,readdir DEBS);
	closedir (DEBS);
	foreach my $debf (@files)
	{
		unlink $debf;
	}
}