#!/usr/bin/perl

#  embug : Track cross-building bugs from within package builds.
#  Copyright (C) 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/>.

use Cwd;
use Text::Wrap;
use Config::Auto;
use File::Basename;
use Emdebian::Tools;
use Text::FormatTable;
use Cache::Apt::Lookup;
use Debian::DpkgCross;
use Dpkg::Control;
# Adds dependency on libsoap-lite-perl but this is already recommended
# by devscripts.
use SOAP::Lite;
use Term::ANSIColor qw(:constants);
use strict;
use warnings;
use vars qw( $our_version $verbose $apt_cross_dir $progname $soap $usertag %buglist
 $bugs $package $flag $number $mode $list $control $source $listing $lintian);

$our_version = &tools_version;
$verbose = 1;
$listing = 0;
$progname = basename($0);
&read_config();
$apt_cross_dir = &get_aptcross_dir;

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

Usage:
 $progname [-v|--verbose] [-q|--quiet] [-p|--package] -f|--flag
 $progname [-v|--verbose] [-q|--quiet] [-p|--package] -r|--remove
 $progname [-v|--verbose] [-q|--quiet] [-p|--package] -g|--get-number
 $progname [-v|--verbose] [-q|--quiet] [-p|--package] -o|--outdated
 $progname [-v|--verbose] [-q|--quiet] [-p|--package] -d|--debian
 $progname [-v|--verbose] [-q|--quiet] [-p|--package] -w|--waiting
 $progname [-v|--verbose] [-q|--quiet] --prepare
 $progname [-v|--verbose] [-q|--quiet] -l|--list
 $progname [-v|--verbose] [-q|--quiet]    --list-bugs
 $progname [-v|--verbose] [-q|--quiet]    --list-newer
 $progname [-v|--verbose] [-q|--quiet] -u|--update
 $progname [-v|--verbose] [-q|--quiet] -m|--missing
 $progname -?|-h|--help|--version

Commands:
 -f|--flag:          Flag this package as needing a bug report.
 -g|--get-number:    Get the bug number of the report filed for this package.
 -l|--list:          List all known bug report numbers, with package names,
                      and packages with newer versions or outdated patches.
    --list-bugs:     List only the bug report numbers with package names.
    --list-newer:    List only packages with newer versions, outdated patches
                      or needing an update due to a failed lintian check.
 -m|--missing:       List all flagged packages without bug reports.
 -r|--remove:        Remove the flag if no bug report has been filed.
 -u|--update:        Update the list of known cross-building bugs
                      by querying bugs.debian.org.
 -o|--outdated:      Record that the Emdebian SVN patches are out of date.
 -d|--debian:        Record that the Emdebian package is older than the Debian package.
 -w|--waiting:       Record that the Emdebian package is waiting for another package.
    --lintian:       Record that the Emdebian package has failed a lintian test.
    --failed:        Record that the Emdebian package failed to build.
    --prepare:       Create a temporary directory suitable for patch creation
                      and testing.
 -?|-h|--help:       Print this usage message and exit
 --version:          Print this usage message and exit

 Options:
 -p|--package:        Specify the source package name instead of looking in
                       debian/control.
 -v|--verbose:        be verbose (repeat for more verbosity)
 -q|--quiet:          be quiet [default]

 $progname assumes that each source package only has one bug
 tagged with the 'crossbuilt' usertag for user 'codehelp\@debian.org'.

Package flags have a fixed priority:
Lowest:   Newer in Debian          embug -d
          Patches failed           embug -o
Highest:  Lintian errors           embug --lintian

Virtual:  Fails to crossbuild.     embug --failed

"Failed" is only set if the patches are up to date, otherwise most
packages listed as "Failed" would just be failed patches. "Failed" also
replaces "lintian" if the patches are up to date.

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

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit( 0 );
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-p|--package)$/) {
		$package = shift(@ARGV);
	}
	elsif (/^(-o|--outdated)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'record';
	}
	elsif (/^(-g|--get-number)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'get';
	}
	elsif (/^(-f|--flag)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'flag';
	}
	elsif (/^(-u|--update)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'update';
	}
	elsif (/^(-d|--debian)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'debian';
	}
	elsif (/^(-l|--list)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'list';
		$listing = 1;
	}
	elsif (/^(--list-bugs)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'list';
		$listing = 2;
	}
	elsif (/^(-l|--list-newer)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'list';
		$listing = 3;
	}
	elsif (/^(-m|--missing)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'missing';
	}
	elsif (/^(-r|--remove)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'remove';
	}
	elsif (/^(--prepare)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'prepare';
	}
	elsif (/^(--lintian)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'lintian';
	}
	elsif (/^(--failed)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'failed';
	}
	elsif (/^(-w|--waiting)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = 'waiting';
	}
	else {
		die RED, "$progname: Unknown option $_.", RESET, "\n";
	}
}

if (not defined $mode)
{
	print (RED, "$progname: At least one command must be specified.", RESET, "\n");
	&usageversion;
	exit (1);
}

&get     if ($mode eq "get");
&flag    if ($mode eq "flag");
&list    if ($mode eq "list");
&missing if ($mode eq "missing");
&update  if ($mode eq "update");
&remove  if ($mode eq "remove");
&prepare if ($mode eq "prepare");
&record  if ($mode eq "record");
&debian  if ($mode eq "debian");
&lintian if ($mode eq "lintian");
&failed  if ($mode eq "failed");
&waiting if ($mode eq "waiting");
exit (0);

# if package is defined, it must have come from the user.
# just run that passed ~/.apt-cross/embug

sub get_package
{
	if (not defined $package)
	{
		print CYAN, "Checking for debian/control\n", RESET if ($verbose >= 2);
		until (-f "debian/control")
		{
			chdir ".." or die "Cannot change directory ../ $!";
			if (cwd() eq '/')
			{
				die (RED, wrap('','',"$progname: Cannot find debian/control" .
				" anywhere!\nUse --package if you are not in the source code tree."),
				RESET, "\n");
			}
		}
		$control = Dpkg::Control->new();
		$package = $control->get_source()->{Source};
	}
	print GREEN, "Using source package: $package\n", RESET if ($verbose >= 2);
	return $package;
}

# flag
# append source package name to a file in ~/.apt-cross/ (embug)

sub flag
{
	my $config = &bug_config();
	&get_package;
	print GREEN, "Flagging $package\n", RESET if ($verbose >= 1);
	$config->{$package}="";
	&write_config($config);
}

sub debian
{
	my $config = &target_config();
	&get_package;
	# lowest priority - don't overwrite other flags.
	return if (defined $config->{$package});
	print GREEN, wrap('','',"Recording that Debian has a newer version of ",
		"'$package'.\n"), RESET if ($verbose >= 1);
	$config->{$package}="debian";
	&write_target_config($config);
}

sub lintian
{
	my $config = &target_config();
	&get_package;
	print GREEN, wrap('','',"Recording that '$package' has failed a lintian check",
		"\n"), RESET if ($verbose >= 1);
	$config->{$package}="lintian";
	&write_target_config($config);
}

sub failed
{
	my $config = &target_config();
	&get_package;
	# overwrite any flags but only if patches are up to date.
	if ((defined ($config->{$package})) and 
		($config->{$package} eq "patches"))
		{
			print RED, wrap('','',"Package failed to build but patches are ".
			"marked as out of date. Ignoring build failure.\n"), RESET
			if ($verbose >= 1);
			return;
		}
	print GREEN, wrap('','',"Recording that the package failed to build.\n"), RESET
		if ($verbose >= 1);
	$config->{$package}="failed";
	&write_target_config($config);
}
# record that the Emdebian SVN patches are out of date
sub record
{
	my $config = &target_config();
	&get_package;
	# don't overwrite higher flags
	return if ((defined $config->{$package}) and ($config->{$package} eq "lintian"));
	print GREEN, wrap('','',"Recording that the Emdebian SVN patches are ",
		"out of date for $package.\n"), RESET if ($verbose >= 1);
	$config->{$package}="patches";
	&write_target_config($config);
}

# remove source package name from the file in ~/.apt-cross/ (embug)
sub remove
{
	my $config = &bug_config();
	&get_package;
	my $number = $config->{"$package"} if (defined $config->{"$package"});
	if (not defined $number)
	{
		print GREEN, "No cross-building bugs for $package\n", RESET
			if ($verbose >= 1);
	}
	elsif ($number eq "")
	{
		print GREEN, "Removing flag for $package\n", RESET if ($verbose >= 1);
		undef ($config->{$package});
	}
	&write_config($config);
	$config = &target_config();
	my $status = $config->{"$package"} if (defined $config->{"$package"});
	return if (not defined $status);
	print GREEN, "Removing flag for $package\n", RESET if ($verbose >= 1);
	undef ($config->{$package});
	&write_target_config($config);
}

# list
# call list from ~/.apt-cross/embug and output
sub list
{
	my $config = &bug_config();
	print GREEN, scalar keys %$config, " open crossbuilt bugs.", RESET, "\n";
	my $table = Text::FormatTable->new('30l 50l');
	$table->head("Package", "Bug #");
	$table->rule('=');
	foreach my $pkg (sort keys %$config)
	{
		my $r = $config->{$pkg};
		my $rr = (ref($r) eq 'ARRAY') ? join(', ', @$r) : $r;
		$table->row("$pkg ", $rr);
	}
	print $table->render(20) if (($listing == 1) or ($listing == 2));
	$config = &target_config();
	return unless $config;
	print "\n\n";
	undef $table;
	$table = Text::FormatTable->new('30l 20l 20l 20l');
	$table->head("Package", "Lintian", "Patches", "Debian");
	$table->rule('=');
	foreach my $pkg (sort keys %$config)
	{
		my $s = $config->{$pkg};
		my $d = $s =~ /debian/  ? "Newer in Debian" : "";
		my $p = $s =~ /patches/ ? "Patches failed"  : "";
		$p  =  $s  =~ /failed/  ? "Failed to build" : $p;
		my $l = $s =~ /lintian/ ? "Lintian errors"  : "";
		if ($s =~ /waiting/)
		{
			$d = "emdebcheck wait";
			$l = "";
			$p = "";
		}
		$table->row("$pkg ", $l, $p, $d);
	}
	print $table->render(20) if (($listing == 1) or ($listing == 3));
}

sub missing
{
	my $config = &bug_config();
	my @list=();
	my @fail=();
	my $c = 0;
	foreach my $pkg (sort keys %$config)
	{
		push @list, $pkg if ($config->{$pkg} eq "");
		push @fail, $pkg if ($config->{$pkg} eq "patches");
	}
	return if ((!@list) and (!@fail));
	print RED, "Packages flagged but with no bug report.", RESET, "\n";
	foreach my $pkg (sort @list)
	{
		$c++;
		print "$c: ".CYAN."$pkg", RESET, "\n";
	}
	print RED, "Packages with out of date patches.", RESET, "\n";
	foreach my $pkg (sort @fail)
	{
		$c++;
		print "$c: ".CYAN."$pkg", RESET, "\n";
	}
}

# update
# call SOAP, add bug numbers to names from ~/.apt-cross/embug if listed in SOAP.
sub update
{
	my $config;
	my $cfile = $apt_cross_dir . "/embug";
	# read existing data
	if (-f $cfile)
	{
		open (CFILE, "$cfile") or
			die (RED, "$progname: cannot read config file: $!",RESET,"\n");
		$config = Config::Auto::parse("$cfile", format => "colon");
		close (CFILE);
	}
	$soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://bugs.debian.org/cgi-bin/soap.cgi');
	$usertag = $soap->get_usertag('codehelp@debian.org')->result();
	my $nums = $usertag->{'crossbuilt'};
	my $buildnums = $usertag->{'buildd.emdebian.org'};
	push @$nums, @$buildnums;
	foreach my $b (sort @$nums)
	{
		my $stats = $soap->get_status($b)->result->{$b};
		my $pkg = ($stats->{'package'});
		my $str = $config->{$pkg};
		if ($stats->{'done'})
		{
			# unset flags if a real bug has been closed.
			print GREEN, "$progname: $b, filed against $pkg, has been closed.\n",
				RESET if ($verbose >= 1);
			$str =~ s/$b// if (defined $str);
			$config->{$pkg} = $str;
			next;
		}
		# overlay the real bug data, space separated.
		$str .= " $b";
		$str =~ s/\s\s+/ /g;
		$config->{$pkg} = $str;
		print "setting $b for $pkg\n" if ($verbose >= 3);
	}
	# remove duplicates
	print "processing bug numbers\n" if ($verbose >= 1);
	my %list = ();
	foreach my $p (keys %$config)
	{
		my %seen=();
		# ignore missing flags
		next unless (defined $config->{$p});
		my @split = split (" ", $config->{$p});
		foreach my $bugnumber (@split)
		{
			print "checking $bugnumber for $p\n" if ($verbose >= 2);
			print ". " if ($verbose == 1);
			next if (defined $seen{$bugnumber});
			$seen{$bugnumber}++;
			$list{$p}.=" $bugnumber";
		}
	}
	print "\n" if ($verbose == 1);
	foreach my $l (keys %list)
	{
		$config->{$l} = $list{$l};
	}
	&write_config($config);
}

sub write_config
{
	my $config = shift;
	if (not defined $config)
	{
		print "no defined config.\n";
		return;
	}
	my $cfile = $apt_cross_dir . "/embug";
	open (CFILE, ">$cfile") or
		die (RED, "$progname: cannot write config file: $!",RESET,"\n");
	foreach my $pkg (sort keys %$config)
	{
		# write $pkg and $b to CFILE
		print CFILE "$pkg: " . $config->{$pkg} . "\n" if (defined $config->{$pkg});
	}
	close (CFILE);
}

# get
# Read ~/.apt-cross/embug. print status of this package.

sub get
{
	&get_package;
	my $config = &bug_config();
	$number = $config->{"$package"} if (defined $config->{"$package"});
	if (not defined $number)
	{
		print GREEN, "No cross-building bugs for $package\n", RESET;
	}
	elsif ($number eq "")
	{
		print GREEN, "$package is flagged but no bug has been reported.\n", RESET;
	}
	else
	{
		my $rr = (ref($number) eq 'ARRAY') ? join(' #', @$number) : $number;
		print GREEN, "Bug: #$rr\n", RESET;
		$rr = (ref($number) eq 'ARRAY') ? join("\nhttp://bugs.debian.org/", @$number) : $number;
		print GREEN, "http://bugs.debian.org/$rr\n", RESET;
	}
	$config = &target_config();
	$number = $config->{"$package"} if (defined $config->{"$package"});
	if ($number eq "patches")
	{
		print GREEN, "Emdebian patches for $package are out of date.\n", RESET;
	}
	my $s = $config->{$package};
	my $d = $s =~ /debian/  ? "Newer in Debian " : "";
	my $p = $s =~ /patches/ ? "Patches failed "  : "";
	$p  =  $s  =~ /failed/  ? "Failed to build " : $p;
	my $l = $s =~ /lintian/ ? "Lintian errors "  : "";
	my $w = $s =~ /waiting/ ? "Waiting for dependency " : "";
	print RED, "$package : ", $l, $p, $d, $w, "\n", RESET;
}

sub waiting
{
	my $config = &target_config();
	&get_package;
	# don't overwrite higher flags
	return if ((defined $config->{$package}) and ($config->{$package} eq "lintian"));
	return if ((defined $config->{$package}) and ($config->{$package} eq "failed"));
	print GREEN, wrap('','',"Recording that $package is waiting for another dependency.\n"), RESET if ($verbose >= 1);
	$config->{$package}="waiting";
	&write_target_config($config);
}

# idea: copy the source into ../../branches/bug/,
# unpack and copy the emdebian patch files

sub prepare
{
	&get_package;
	my $check_package;
	# we might be in a different package - check.
	if (-f "debian/control")
	{
		my $control = Dpkg::Control->new();
		$check_package = $control->get_source()->{Source};
		if ($check_package ne $package)
		{
			my ($indexchar)=split(//, $package);
			my $workdir = &get_workdir;
			$workdir = "/" if ($workdir eq "");
			my $msg = &check_workdir($workdir);
			die RED, $msg, RESET if ($msg ne "");
			my $chkdir = "$workdir/trunk/$indexchar/$package/trunk/";
			die (RED,"Unable to find $chkdir for $package",RESET,"\n") 
				unless (-d $chkdir);
			system ("emsource --where $package");
			die (RED,wrap('','', "The current directory is for '$check_package'. ".
			"Please change to the above directory ".
			"for '$package' and run $progname --prepare again."),RESET,"\n");
		}
	}
	&check_emdebian_control;
	my $cwd = basename(cwd);
	my $base = $cwd;
	$base =~ s/-([0-9])/.$1/g;
	$base =~ s/\+/\\+/g;
	print "$base\n";
	opendir (SRC, "../") or die ("Cannot open parent directory! $!\n");
	my @possible = grep(/^$base.*$/, readdir (SRC));
	closedir (SRC);
	my @dsc = ();
	my @orig = ();
	my @diff = ();
	foreach my $file (@possible)
	{
		push @dsc, $file if (($file =~ /^$base.*\.dsc$/) and
			($file !~ /tdeb/));
		push @orig, $file if ($file =~ /^$base.*\.tar\.gz/);
		push @diff, $file if ($file =~ /^$base.*\.diff\.gz$/);
	}
	my $dir = `mktemp -d ../../branches/bugXXXXXX`;
	chomp($dir);
	foreach my $d (@dsc)
	{
		`cp ../$d $dir/` unless (-d "../$d");
	}
	foreach my $o (@orig)
	{
		`cp ../$o $dir/` unless (-d "../$o");
	}
	foreach my $f (@diff)
	{
		`cp ../$f $dir/` unless (-d "../$f");
	}
	chdir ($dir);
	foreach my $s (@dsc)
	{
		if ($s =~ /^$base.*em([0-9])\.dsc$/)
		{
			system ("dpkg-source -x $s");
			system ("mv $cwd $cwd.emdebian") if (-d $cwd);
			system ("mv ${cwd}em${1} ${cwd}.emdebian") if (-d "${cwd}em${1}");
		}
		else
		{
			system ("dpkg-source -x $s");
			system ("mv $cwd $cwd.debian");
		}
	}
	print GREEN, "\n$progname: prepared source is in $dir\n", RESET;
	system ("ls -l") if ($verbose >= 1);
	print CYAN, "\n$progname: $cwd is ready for patch creation.\n" .
		"e.g. 'cd $dir ; meld $cwd.debian/debian/rules $cwd.emdebian/debian/rules'\n",
		RESET if ($verbose >= 1);
}