#!/usr/bin/perl -w
#
#  deb_compare : Compare toolchain packages using Cache::Apt
#
#  Compare: emdebian/debian (toolchains) for i386, amd64 & powerpc
#
#  One of the remaining issues with this approach is the apparent lack of support
#  for creating a sources.list in memory without needing lots of little files.
#
#  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 Class::Struct;
use Cache::Apt::Lookup;
use Cache::Apt::Config;
use Cache::Apt::Package;
use Data::Dumper;
use Cwd;
use Text::Wrap;
use Text::FormatTable;
use vars qw/ @newer @older @equal $target $toolchain %sources @toolchains
@cross_targets $c @cross_triplet $match %ignore %reports /;
# ignore certain packages (any value is ignored, simply setting a key is sufficient)
%ignore = ( "emdebian-tools" => 1,
			"apt-cross" => 1,
			"dpkg-cross" => 1,
);
# using debian toolchain repository, set $arch = qw/i386 powerpc amd64/ in turn
@toolchains = qw/i386 amd64 powerpc/;
@cross_targets = qw/alpha arm armel hppa m68k mips mipsel ia64 powerpc sparc s390 /;
%reports = ();
$target = 0;
$toolchain = 1;
$c = 0;

foreach my $q (@cross_targets)
{
	my $t = &check_cache_arch($q);
	$cross_triplet{$t} = $q;
	my @g = ();
	$reports{$q} = \@g;
}

my $verbose = 0;
my $arch = "arm" if ($target == 1); # only arm packages are built so far.
$arch = "i386" if ($toolchain == 1);
# need support for tweaking this.
my $suite = "unstable";

&set_verbose ($verbose);
&set_suite($suite);
&check_cache_arch($arch) if (defined ($arch));
my $cache = cwd . "/cache";
mkdir ($cache) or die ("Unable to create the cache directory: $!") if (not -d $cache);
# check for (and create) sources.list file.
# will need more than one file later.
my $force = 0;
$force = 1 if (not -f "$cache/sources.$suite");
open (SOURCE, ">$cache/sources.$suite") or die ("Cannot create sources list: $!");
print SOURCE "deb http://www.emdebian.org/debian/ unstable main\n";
print SOURCE "deb-src http://www.emdebian.org/debian/ unstable main\n";
close (SOURCE);
open (STATUS, ">$cache/status");
close STATUS;
&set_cachedir($cache);
&use_mysources("sources.$suite");
&setup_config;
&force_update if ($force > 0);

&update_sources;
my $config = &init_cache($verbose);
my $iter = &get_cache_iter();
my $pkg;
my @package_names = ();
my %h = ();
my @rotor = qw ( - \ | / );
my @chain = ();
my $rotorcount = 0;

do {
	$pkg = $iter->next;
	$h{$pkg}++ if ($pkg);
} while ($pkg);

@package_names = sort (keys %h);

# array of AptCrossPackage structs, ordered by package name
my @packages = ();

foreach my $p (@package_names)
{
	next if (exists $ignore{$p});
	my $emp = AptCrossPackage->new();
	$emp->Package($p);
	$emp = &lookup_pkg($emp);
	push @packages, $emp;
}

# we don't need the other cache again. Start the host_cache.
unlink ("$cache/sources.$suite");
&use_hostsources;
&setup_config;
&update_sources;
$config = &init_host_cache($verbose);
@older = ();
@newer = ();
@equal = ();

unlink ("$cache/sources.$suite");
my %seen = ();

struct (ChainPackage => {
	"Emdebian" => '$',  # emdebian package name
	"Debian"   => '$',  # debian source package
	"Platform" => '$',  # intended target platform
	"Compare"  => '$',  # result of version comparison
	"DebVer"   => '$',  # the debian version to be updated
	"EmdebVer" => '$',  # current emdebian version.
	"CmpResult" => '$', # value of the version comparison.
});

foreach my $package (@packages)
{
	my $vers = $$package->Version;
	next if (not defined $vers);
	my $name = $$package->Package;
	next if ($seen{$name});
	$seen{$name}++;
	undef ($match);
	$match = $$package->Cross_Architecture . "\n" if (defined($$package->Cross_Architecture));
	$name =~ s/-([^\-]+)-cross$//;
	# the loop is resource-hungry but a simple regexp neither catches
	# all the possible triplets nor omits invalid triplets.
	if (not defined ($match))
	{
		foreach my $triplet (keys %cross_triplet)
		{
			if ($name =~ /\Q-$triplet\E/)
			{
				$name =~ s/\Q-$triplet\E//;
				# there are some special cases but those will have to be ignored.
				$match = $cross_triplet{$triplet};
			}
			$rotorcount++;
			$rotorcount = 0 if ($rotorcount > 3);
			print "Checking packages: " . $rotor[$rotorcount] . "\r" if ($verbose >= 1);
		}
	}
	$host = &srclookup($name);
	next if (not defined $match);
	next if (not defined $host->{'Version'});
	$c++;
	my $cmp = &Cache::Apt::Lookup::ver_compare ($vers, $host->{'Version'});
	my $result = ChainPackage->new();
	$result->Emdebian($$package->Package);
	$result->Debian($name);
	$result->Platform($match);
	$result->DebVer($host->{'Version'});
	$result->EmdebVer($vers);
	$result->CmpResult($cmp);
	my $list_triplet = $reports{$match};
	push (@$list_triplet, \$result);
	push (@older, $result) if ($cmp < 0);
	push (@newer, $result) if ($cmp > 0);
	push (@equal, $result) if ($cmp == 0);
}

# the older text output here will be removed once the HTML is ready.
print "found $c toolchain packages for $arch.\n\n" if ($verbose >= 1);
print "The following packages are older in Emdebian than in Debian:\n" if ($verbose >= 1);
%list=();
foreach my $res (@older)
{
	next if (not defined ($res->Platform));
	$list{$res->Platform} .= $res->Debian . " (" . $res->DebVer . ") ";
}
foreach my $line (sort keys %list)
{
	my @wrap = split(" ", $list{$line});
	print $line . " : ";
	print wrap('','',@wrap);
	print "\n";
}
print "The following packages are newer in Emdebian than in Debian:\n" if ($verbose >= 1);
%list=();
foreach $res (@newer)
{
	next if (not defined ($res->Platform));
	next if (not defined ($res->DebVer));
	$list{$res->Platform} .= $res->Debian . " (" . $res->DebVer . ") ";
}
foreach $line (sort keys %list)
{
	@wrap = split(" ", $list{$line});
	print $line . " : ";
	print wrap('','',@wrap);
	print "\n";
}
print "The following packages are the same version in Emdebian as in Debian:\n" if ($verbose >= 1);
%list=();
foreach $res (@equal)
{
	next if (not defined ($res->Platform));
	next if (not defined ($res->DebVer));
	$list{$res->Platform} .= $res->Debian . " (" . $res->DebVer . ") ";
}
foreach $line (sort keys %list)
{
	@wrap = split(" ", $list{$line});
	print $line . " : ";
	print wrap('','',@wrap);
	print "\n";
}
print "\n";

foreach my $y (sort keys %reports)
{
	print "$y ";
}
print "\n";

# look for new packages

# begin output - may need to change the file locations.

my $output = "/var/emdebian/sqlite/$suite-$arch.html";
open (HTML, ">$output") or die ("Cannot create $output file: $!");
&print_header;
# default user view:
# unavailable could include 'not attempted and not going to be attemtped unless someone asks'
# Users: Availability = 'Yes' | 'Building' | 'Outdated' | 'No'
# The user view would also include each toolchain, currently only "problems" are listed.
print HTML "<title>Cache comparison: Emdebian vs Debian ($suite) {$arch}</title>";
# embanner.html is the HTML snippet between the <title> and the start of
# the main page content (without navbar) - the logo and the banner line.
# edit embanner.html to modify this beautification of the cachecompare HTML.
open (BANNER, "embanner.html") or die ("Cannot find the emdebian banner HTML: $!");
while(defined(my $a=<BANNER>)) { print HTML $a; }
close (BANNER);
print HTML "<div><h1>\n";
print HTML "Emdebian toolchain status: $suite {$arch}";
print HTML "</h1>\n";
print HTML qq%<p>This page is generated automatically to compare packages in the
Emdebian toolchain <b>$suite</b> repository for $arch against upstream Debian $suite.</p>%;
print HTML qq:<table border="1"><colgroup><col width="30%"><col width="30%">\n:;
print HTML qq:<col width="10%"><col width="30%"></colgroup>\n:;
print HTML qq%<tr><td colspan="4"><h2>$arch</h2></td></tr>\n%;

foreach my $target (sort keys %reports)
{
	print HTML qq%<tr><td colspan="4"><h3>%;
	print HTML $target . qq%</h3>\n</td></tr>%;
	my $pkg_list = $reports{$target};
	foreach my $pkgref (@$pkg_list)
	{
		if ($$pkgref->CmpResult == 0)
		{
			print HTML "<tr>\n<td><b>" . $$pkgref->Emdebian . "</b></td>";
			print HTML "\n<td>Source: " . $$pkgref->Debian . "</td>";
			print HTML qq%<td><img src="../Pics/rec.gif" alt="ok"></td><td>&nbsp;</td>\n%;
		}
		if ($$pkgref->CmpResult < 0)
		{
			print HTML "<tr>\n<td><b>" . $$pkgref->Emdebian . "</b></td>";
			print HTML "\n<td><b>" . $$pkgref->EmdebVer . " &lt; " . $$pkgref->DebVer . "</b></td>";
			print HTML qq%<td><img src="../Pics/dep.gif" alt="outdated"></td><td>Outdated</td>\n%;
		}
		if ($$pkgref->CmpResult > 0)
		{
			print HTML "<tr>\n<td><b>" . $$pkgref->Emdebian . "</b></td>";
			print HTML "\n<td><b>" . $$pkgref->EmdebVer . " &gt; " . $$pkgref->DebVer . "</b></td>";
			print HTML qq%<td><img src="../Pics/sug.gif" alt="new"></td><td>Newer</td>\n%;
		}
	}
}

print HTML "</table>\n";
print HTML "<p>Generated on " . `date` . "</p>\n";
print HTML "</div></body></html>\n";
close (HTML);

sub print_header
{
print HTML <<EMHEADER;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en">
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
EMHEADER
}