#!/usr/bin/perl

use strict;
use warnings;

use CGI qw( :standard :xhtml start_table end_table);
use URI::Escape;

print start_html( "Debian QA: New packages in Sarge" );

print h1( "<a id=\"top\">New packages in Sarge</a>" );

my $intro = <<EOH;
The following list shows all source packages that weren\'t included
in woody but are currently part of testing (and thus of sarge).
The goal is to take a closer look at all these package and investigate
if they are really releasable at all before we include them in a stable
Debian release for the first time.
EOH

print p( $intro );

open PKG_LIST, '<', "stable-testing.diff" or die "E: couldn't open diff: $!";

my @pkgs = <PKG_LIST>;
my %pkgs;

sub uc_num {
    my $str = $_[0];
    $str =~ s/\d/0/go;
    return uc $str;
}

foreach (@pkgs) {
	chomp;
	$pkgs{uc_num substr($_, 0, 1)}{$_} = [];
}

close PKG_LIST or warn;

open STAT_LIST, '<', "stable-testing.status" or die "E: couldn't open status: $!";

my @p_stats = <STAT_LIST>;

foreach my $p_stat (@p_stats) {
    chomp $p_stat;
    my @stats = split /\s+/, $p_stat;
    if (@stats > 1) {
#	print STDERR "D: stats found for $stats[0]\n";
	my $pkg = shift @stats;
	if (exists $pkgs{uc_num substr($pkg, 0, 1)}{$pkg}) {
	    push @{$pkgs{uc_num substr($pkg, 0, 1)}{$pkg}}, @stats;
	}
    }
}

close STAT_LIST or warn;

sub red {
    return "<span style=\"color:red\">@_</span>";
}
sub yellow {
    return "<span style=\"color:yellow\">@_</span>";
}
sub green {
    return "<span style=\"color:green\">@_</span>";
}
sub td_red {
    return "<td style=\"background:red\">@_</td>";
}
sub td_yellow {
    return "<td style=\"background:yellow\">@_</td>";
}
sub td_green {
    return "<td style=\"background:green\">@_</td>";
}

print "<p>";
foreach (0, 'A' .. 'Z') {
    print a( { -href=>"#$_" }, "[$_]" ). "&nbsp;";
}
print "</p>";

sub pkg_line {
    my ($pkg, $u_pkg) = @_;
    return a( { -href=>"http://packages.debian.org/src:$u_pkg" }, $pkg ).
	" ".a( { -href=>"http://packages.qa.debian.org/$u_pkg" }, "[pts]" ).
	" ".a( { -href=>"http://bugs.debian.org/src:$u_pkg" }, "[bugs]" );
}

my %stats = ( pkgs => 0,
	      ok => 0,
	      unknown => 0,
	      bad => 0 );
foreach my $l (sort keys %pkgs) {
    print h2( "<a id=\"$l\" href=\"#top\">$l</a>" );
    print start_table( { -style=>"width:100%" } );
    print "<colgroup>".
	"<col style=\"width:25%\" /><col style=\"width:80%\" />".
	"</colgroup>";
    print Tr( th( [ "Package", "Status" ] ) ) ."\n";
    foreach my $pkg (sort keys %{$pkgs{$l}}) {
	$stats{pkgs}++;
	my $u_pkg = uri_escape( $pkg );
	my @stats = @{$pkgs{$l}{$pkg}};
	my $stat = 50;
	if (@stats) {
	    foreach (@stats) {
		if (/d-i/io) {
		    $_ = td_green( a( { -href=>"http://www.debian.org/devel/debian-installer/" }, "d-i" ) );
		    $stat += 25;
		}
		if (/ok(?:\((.+)\))/io) {
		    $_ = td_green( "ok by $1");
		    $stat += 50;
		}
	    }
	} else {
	    $stats[0] = td_yellow( "unknown" );
	}
	if ($stat < 26) {
	    $pkg = td_red( pkg_line( $pkg, $u_pkg ) );
	    $stats{bad}++;
	} elsif ( $stat < 75 ) {
	    $pkg = td_yellow( pkg_line( $pkg, $u_pkg ) );
	    $stats{unknown}++;
	} else {
	    $pkg = td_green( pkg_line( $pkg, $u_pkg ) );
	    $stats{ok}++;
	}
	print Tr( $pkg .td( table( Tr( "@stats" ) ) ) ) ."\n";
    }
    print Tr( th( [ "Package", "Status" ] ) ) ."\n";
    print end_table;
}

print hr;

print h2( "Statistics" );

print start_table;
print Tr( td( [ "Packages in good state", $stats{ok} ] ) );
print Tr( td( [ "Packages in unknown state", $stats{unknown} ] ) );
print Tr( td( [ "Packages in bad state", $stats{bad} ] ) );
print Tr( td( [ "Total number of new packages", $stats{pkgs} ] ) );
print end_table;
    
print hr;

print p( "Generated: ".gmtime()." UTC");
print p( "Comments and questions to ". a( { -href=>"mailto:djpig\@debian.org" }, "djpig\@debian.org" ) );

print end_html;