#!/usr/bin/perl
#
#  buildstatus : Check on the build status of all target packages
#  Copyright (C) 2007  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 Config::Auto;
use File::Basename;
use Emdebian::Tools;
use Text::FormatTable;
use Debian::DpkgCross;
use Term::ANSIColor qw(:constants);
use strict;
use warnings;
use vars qw($our_version $home $dpkg_cross_dir $msg $verbose $workdir $progname
$pager $csv $xml $html $cell1 $cell2 $cell3 $cell4 $line @lines $lintian
@changes);

$our_version = &tools_version;
$verbose = 1;
$progname = basename($0);
&read_config();
my $arch = &get_architecture();
$dpkg_cross_dir = &get_dpkg_cross_dir;

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

Usage:
 $progname [-a|--arch ARCH] [-v|--verbose] [-q|--quiet]
 $progname -?|-h|--help|--version

Commands:
 -p|--pager:          Use sensible-pager [default]
 -c|--csv:            Write comma separated values to stdout
 -x|--xml:            Write XML to stdout
 -w|--html:           Write HTML to stdout
 -l|--lintian:        Run lintian on the latest .changes file

Options:
 -a|--arch ARCH:      set architecture (default: defined by dpkg-cross)
 -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

User-specific configuration values in ~/.apt-cross/emsource,
override any debconf default in /etc/emsource.conf. If no
preferred working directory is set, $progname checks current
working directory.

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

$xml = $csv = $html = $pager = 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 (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(-p|--pager)$/) {
		$pager = 1;
	}
	elsif (/^(-c|--csv)$/) {
		$csv = 1;
	}
	elsif (/^(-x|--xml)$/) {
		$xml = 1;
	}
	elsif (/^(-w|--html)$/) {
		$html = 1;
	}
	elsif (/^(-l|--lintian)$/) {
		$lintian = 1;
	}
	else {
		die RED, "$progname: Unknown option $_.", RESET, "\n";
	}
}

my $target_gnu_type = &check_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";
}

$pager = 1 if (($xml == 0) and ($csv == 0) and ($html == 0));
$csv = 0 if (($xml > 0) or ($html > 0));
$xml = 0 if (($csv > 0) or ($html > 0));
$html = 0 if (($xml > 0) or ($csv > 0));

my $quiet = "";
$quiet = "-q" if ($verbose < 1);

$workdir = &get_workdir;
$workdir = "." if ($workdir eq "");
$msg = &check_workdir($workdir);
die $msg if ($msg ne "");
chdir ("$workdir/trunk") if ($workdir ne ".");
print "Working directory: '" . cwd . "'\n" if ($verbose >= 2);
&lintian if (defined $lintian);

my @alpha = qw/a b c d e f g h i j k l m n o p q r s t u v w x y z/;
my $table = Text::FormatTable->new('24l 20l 18l 18l 18l 20l');
$table->head("Package", "#Patches", "Build", "pbuild", ".changes", "uploaded");
$table->rule('=');
my %complete = ();
foreach my $a (@alpha)
{
	opendir (DH, "$a/") or next;
	my @list = grep(!/^\.\.?$|^\.svn$/, readdir DH);
	closedir(DH);
	foreach my $one (@list)
	{
		opendir (DH, "$a/$one/trunk")
			or die ("Cannot read subdirectory $a/$one/trunk: $!\n");
		my @contents = grep(!/^\.\.?$|^\.svn$/, readdir DH);
		closedir (DH);
		$complete{$one} = \@contents;
	}
}
my $count = 0;
my $logs = 0;
foreach my $pkg (sort keys %complete)
{
	my $files = $complete{$pkg}; # get value
	my ($indexchar)=split(//, $pkg);
	my $patch = 0;
	my $build = "";
	my $pbuild = "";
	my $changes = "";
	my $uploads = "";
	my $emver = "";
	foreach my $f (@$files)
	{
		$emver = "";
		$patch++ if ($f =~ /^emdebian.*\.patch$/);
		$patch++ if ($f =~ /^debian-patch.*\.patch$/);
		if ($f =~ /_(.*)_${arch}\.build/)
		{
			$emver = $1;
			$build .= "\n$emver";
		}
		if ((-f "../pbuilder/result/$indexchar/$pkg/trunk/${pkg}_${emver}_$arch.build")
			and ($f =~ /_${emver}_${arch}\.build/))
		{
			# .changes file can omit the epoch
			my $ch = `find ../pbuilder/result/$indexchar/$pkg/trunk -name \\*${emver}_${arch}.changes`;
			$pbuild .= "\n$emver" if (defined $ch);
		}
		if ($f =~ /_(.*)_.*\.changes/)
		{
			$changes .= "\n$1";
		}
		if ($f =~ /_(.*)_${arch}\.upload$/)
		{
			$f =~ /_(.*)_${arch}\.upload$/;
			my @about = stat "$indexchar/$pkg/trunk/$f";
			# read the ctime of the .upload file
			$uploads = " $1\n" . scalar localtime($about[10]) if (@about);
		}
	}
	if (($pager > 0) or ($html > 0))
	{
		$cell1 = ($patch > 0) ? "$patch patches" : "" ;
		$cell2 = "$build";
		$cell3 = "$changes";
		$cell4 = "$uploads";
		$table->row("$pkg ", $cell1, $cell2, $pbuild, $cell3, $cell4);
		$count++;
		if ($count % 15 == 0)
		{
			$table->rule('=');
			$table->head("Package", "#Patches", "Build", "pbuild", ".changes", "uploaded");
			$table->rule('=');
		}
		else
		{
			$table->rule('-');
		}
	}
	if ($csv > 0)
	{
		$line = "\"$pkg\",\"$build\",\"$changes\",\"$uploads\"";
		$line =~ s/\n/ /g;
		push (@lines, "$line\n");
	}
	if ($xml > 0)
	{
		$cell1 = "    <name>$pkg</name>";
		$cell2 = "<build>$build</build>";
		$cell3 = "<changes>$changes</changes>";
		$cell4 = "<uploads>$uploads</uploads>";
		$cell4 =~ s/uploads> /uploads>/;
		$line = "$cell1 $cell2 $cell3 $cell4";
		$line =~ s/>\n/>/g;
		$line =~ s/\n//g;
		$line =~ s/> </>\n    </g;
		push (@lines, "  <package>\n" . $line . "\n  </package>");
	}
}
if ($pager > 0)
{
	open (SP, "| sensible-pager");
	print SP "Checking the status of all target packages in SVN\n";
	print SP "Using sensible-pager, use 'q' to exit\n\n";
	print SP $table->render(20);
	print SP "$count packages identified.\n";
	close (SP);
}

print join("", @lines) if ($csv > 0);

print "<?xml version=\"1.0\"?>\n<stats>\n" . join("\n", @lines) . "\n</stats>\n"
	if ($xml > 0);

if ($html > 0)
{
	print "<html><head><title>embuildstats - " . localtime() . "</title></head>\n";
	print "<body><h1>Emdebian build statistics</h1>\n";
	print "<pre>\n";
	print $table->render(20);
	print "</pre>\n";
	print "</body></html>\n";
}

sub lintian
{
	my $loc = "trunk";
	print "Working directory: '$workdir/$loc/'\n" if ($verbose >= 1);
	my $where = "$workdir/$loc/";
	$where =~ s://:/:;
	exit (0) if (! -d $where);
	print "Finding .changes files beneath your working directory . . . \n";
	my @emchanges = `find "$where" -maxdepth 4 -name "*.changes"`;
	print "Found " . scalar @emchanges . " .changes files.\n";
	my $pkgs;
	foreach my $changes (@emchanges)
	{
		chomp ($changes);
		next unless $changes =~ m:/[a-z]/(.*)/trunk/:;
		$pkgs->{$1} .= "$changes ";
	}
	my @src = sort keys %$pkgs;
	my $count = scalar @src;
	print "$count source packages to check with lintian....";
	print "(may take some time)" if ($count > 100);
	print "\n";
	my $progress = 0;
	my %checks=();
	foreach my $pkg (@src)
	{
		my $line = $pkgs->{$pkg};
		my @list = split(/ /, $line);
		my %vers=();
		my $latest="";
		foreach my $c (@list)
		{
			next unless $c =~ /_(.*)_${arch}/;
			$vers{$1} = $c;
			foreach my $v (sort keys %vers)
			{
				next if ($v !~ /em[0-9]$/);
				$latest = $v if ($latest eq "");
				`dpkg --compare-versions $latest lt $v`;
				$latest = $v if $? == 0;
			}
# Note to self:
# my $val = &ver_compare($latest, $v);
# print "          &ver_compare ($latest, $v)  = $val\n";
# $latest = $v if ($val < 0);
# or 
# use Dpkg::Version qw(compare_versions);
# return compare_versions($v_p, '<<', $v_q) ? 1 : 0;
# i.e. to get the latest from ver_compare(latest, new), check for
# a negative number to say that latest is an earlier version than new.
			$checks{$pkg} = $vers{$latest};
		}
	}
	foreach my $pkg (sort keys %checks)
	{
		next if ($pkg eq "");
		my $lint = $checks{$pkg};
		$progress++;
		print ("Running lintian for $pkg ($progress of $count)\n");
		system ("lintian -q --color auto -C em $lint");
		if ($? != 0)
		{
			# log this with embug
			system ("embug -q -q --lintian -p $pkg");
		}
	}
	exit (0);
}