#!/usr/bin/perl
#
# Lintian HTML reporting tool -- Create Lintian web reports
#
# Copyright (C) 1998 by Christian Schwarz and Richard Braakman
#
# This program is free software.  It is distributed under the terms of
# the GNU General Public License as published by the Free Software
# Foundation; either version 2 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, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.

# Maximum number of identical tags per package:
$max_tags = 8;

$debug = 0;

# Read configuration
require './config';

# Import perl libraries
require "$LINTIAN_ROOT/lib/util.pl";
require "$LINTIAN_ROOT/lib/read_taginfo.pl";
require "$LINTIAN_ROOT/lib/read_pkglists.pl";

# Determine Lintian version
chomp($LINTIAN_VERSION = `$LINTIAN_ROOT/frontend/lintian --print-version`);

read_tag_info('html');

# Determine timestamp
chop($timestamp = `date -u --rfc-822`);
chop($mirror_timestamp = `cat $ARCHIVE/timestamp.txt`);

# Footer for each html page:
$close_text = <<"EOT_EOT_EOT";
<HR>
<FONT SIZE="-1">Please send all comments about these web pages to
<A href="mailto:lintian-maint\@debian.org">Richard Braakman</A>.<P>
Page last updated: $timestamp</FONT>
</BODY></HTML>
EOT_EOT_EOT

# Read configuration file
read_bin_list();
read_src_list();
get_bin_src_ref();

# Create output directories
mkdir($HTML_TMP_DIR,0777)
    or die "cannot create output directory $HTML_TMP_DIR: $!";

# process input
while (<>) {
    chop;
    next unless /^([EWXOI]): (\S+)( \S+)?: (\S+)/;
    my ($code, $pkg, $type, $tag) = ($1, $2, $3, $4);
    my $src;

    if ($code eq 'E') {
	$num_errors++;
    } elsif ($code eq 'W') {
	$num_warnings++;
    } elsif ($code eq 'X') {
	$num_experimental++;
    } elsif ($code eq 'O') {
	$num_overridden++;
	next;
    } elsif ($code eq 'I') {
	next;
    }

    if ($type eq ' source') {
	$src = $pkg;
	unless (exists $source_info{$pkg}) {
	    print STDERR "error: source package $pkg not listed!\n";
	}
    } else {
	$src = $bin_src_ref{$pkg};
	unless ($src) {
	    print STDERR "error: source for package $pkg not found!\n";
	    $src = $pkg;
	}
    }

    if (not exists $source_info{$src}) {
	# work around:
	$source_info{$src}->{'maintainer'} = 
	    $binary_info{$pkg}->{'maintainer'} || '(unknown)';
	$source_info{$src}->{'version'} = $binary_info{$pkg}->{'version'};
    }
  
    push(@{$by_src{$src}},$_);
    push(@{$by_tag{$tag}},$_);
}

open_maintainer_index();
read_bug_file("$LINTIAN_ROOT/reporting/bug.status");

# Create per-maintainer list
for $src (sort by_maint keys %by_src) {
    my @tags;

    set_maintainer($source_info{$src}->{'maintainer'});
    new_src_package($src, $source_info{$src}->{'version'});

    for (sort by_tag @{$by_src{$src}}) {
	my ($code, $pkg, $type, $tag, $rest) =
	    /^(\S): (\S+)( \S+)?: (\S+)(.*)/;
	$rest = quotehtml($rest);

	if ($pkg ne $lastpkg and $type ne ' source') {
	    $num_binpkg++;
	    drop_anchor($pkg, "");
	}
	if ($tag ne $lasttag or $pkg ne $lastpkg) {
	    output_chunk(\@tags) if @tags;
	    undef @tags;

	    my $b = bug_number("$pkg: $tag");
	    $rest .= " [" . make_bugref($b) . "]" if $b;
	}
	$lastpkg = $pkg; $lasttag = $tag;

	$tag = make_tagref($tag);
	push(@tags,"$code: $pkg$type: $tag$rest\n");
    }

    output_chunk(\@tags) if @tags;
    undef @tags;
}

close_maintainer();
close_maintainer_index();

# Create tag pages
open_tag_index();
for $tag (sort keys %by_tag) {
    my $lastpkg;
    my $tag_pkgs = 0;

    open_tag_file($tag);

    for (sort @{$by_tag{$tag}}) {
	my ($code, $pkg, $type, $tag, $rest) =
	    /^(\S): (\S+)( \S+)?: (\S+)(.*)/;
	$rest = quotehtml($rest);

	if ($pkg ne $lastpkg) {
	    if (@tags) {
		$tag_pkgs++;
		output_chunk(\@tags);
		undef @tags;
	    }

	    my $b = bug_number("$pkg: $tag");
	    $rest .= " [" . make_bugref($b) . "]" if $b;
	}
	$lastpkg = $pkg;

	$pkg = make_anchor($pkg);
	push(@tags,"$code: $pkg$type: $tag$rest\n");
    }

    if (@tags) {
	$tag_pkgs++;
	output_chunk(\@tags);
	undef @tags;
    }

    close_tag_file($tag);
    list_tag($tag, $#{$by_tag{$tag}} + 1, $tag_pkgs);
}
close_tag_index();

# Create per-package list
my %package_lists;
for $p (sort keys %anchor) {
    my $c = uc substr($p,0,1);
    push (@{$package_lists{$c}}, make_anchor($p));
}

for $c (sort keys %package_lists) {
    my $list = join(', ', @{$package_lists{$c}});
    $list = "<H1>$c</H1>\n<BLOCKQUOTE>\n$list</BLOCKQUOTE><P>\n";
    if ($c le 'F') {
	push(@list1, $list);
    } elsif ($c le 'L') {
	push(@list2, $list);
    } elsif ($c le 'R') {
	push(@list3, $list);
    } elsif ($c le 'Z') {
	push(@list4, $list);
    }
}

output_packages(\@list1,'packages_1.html','0-9, A-F');
output_packages(\@list2,'packages_2.html','G-L');
output_packages(\@list3,'packages_3.html','M-R');
output_packages(\@list4,'packages_4.html','S-Z');

# Read old statistics file
if (-f $statistics_file) {
    ($old_stat) = read_dpkg_control($statistics_file);
}

# Calculate changes
$delta_num_maint = sprintf "%+d",$num_maint-$old_stat->{'maintainers'};
$delta_num_srcpkg = sprintf "%+d",$num_srcpkg-$old_stat->{'source-packages'};
$delta_num_binpkg = sprintf "%+d",$num_binpkg-$old_stat->{'binary-packages'};
$delta_num_warnings = sprintf "%+d",$num_warnings-$old_stat->{'warnings'};
$delta_num_errors = sprintf "%+d",$num_errors-$old_stat->{'errors'};
$delta_num_experimental = sprintf "%+d",$num_experimental-$old_stat->{'experimental'};
$delta_num_overridden = sprintf "%+d",$num_overridden-$old_stat->{'overridden'};

# update statistics file
my $stat;
$stat->{'last-updated'} = $timestamp;
$stat->{'mirror-timestamp'} = $mirror_timestamp;
$stat->{'maintainers'} = $num_maint;
$stat->{'source-packages'} = $num_srcpkg;
$stat->{'binary-packages'} = $num_binpkg;
$stat->{'warnings'} = $num_warnings;
$stat->{'errors'} = $num_errors;
$stat->{'experimental'} = $num_experimental;
$stat->{'overridden'} = $num_overridden;
$stat->{'lintian-version'} = $LINTIAN_VERSION;
open(OUT,">$statistics_file")
    or die "cannot open statistics file $statistics_file for writing: $!";
for $k (keys %$stat) {
  printf OUT "%s: %s\n",$k,$stat->{$k};
}
close(OUT);

# create index page
open(OUT,">$HTML_TMP_DIR/report-index.html")
    or die "cannot open index page $HTML_TMP_DIR/report-index.html for writing: $!";
print OUT <<"EOT_EOT_EOT";
<HTML><HEAD><TITLE>Home Page of Lintian</TITLE></HEAD>
<BODY background="bg.gif">
<CENTER>
<IMG src="logo.gif" alt="Lintian" width=300 height=200><BR>
<STRONG>Welcome to Lintian's Home Page!</STRONG><P>
<HR width=100>
</CENTER>
<P>

<H1>Background Information</H1>
<H3><A href="manual/index.html">Lintian's User Manual</A></H3>
<H3><A href="ftp://ftp.debian.org/debian/hamm/hamm/binary-all/devel/">Getting Lintian</A></H3>
<BLOCKQUOTE>
Lintian is part of the <A href="http://www.debian.org/">Debian GNU/Linux</A>
distribution.  You can get the lintian package directly from
<A href="ftp://ftp.debian.org/debian/dists/unstable/main/binary-all/devel/">ftp.debian.org</A> or any
<A href="ftp://ftp.debian.org/debian/README.mirrors">mirror</A>.
</BLOCKQUOTE>

<H1>Lintian Reports</H1>
<H3><A href="reports/maintainers.html">Sorted by maintainers</A></H3>
<H3><A href="reports/tags.html">Sorted by tag types</A></H3>
<H3><A href="reports/packages_1.html">Sorted by packages</A></H3>
<BLOCKQUOTE>
<A href="reports/packages_1.html">0-9, A-F</A> |
<A href="reports/packages_2.html">G-L</A> |
<A href="reports/packages_3.html">M-R</A> |
<A href="reports/packages_4.html">S-Z</A>
</BLOCKQUOTE>
<P>
<H3>Statistics:</H3>
<BLOCKQUOTE>
<TABLE>
<TR><TD>Last updated:<TD>$timestamp
<TR><TD>Archive timestamp:<TD>$mirror_timestamp
<TR><TD>Maintainers listed:<TD>$num_maint ($delta_num_maint)
<TR><TD>Source packages listed:<TD>$num_srcpkg ($delta_num_srcpkg)
<TR><TD>Binary packages listed:<TD>$num_binpkg ($delta_num_binpkg)
<TR><TD>Warnings:<TD>$num_warnings ($delta_num_warnings)
<TR><TD>Errors:<TD>$num_errors ($delta_num_errors)
<TR><TD>Experimental tags:<TD>$num_experimental ($delta_num_experimental)
<TR><TD>Overridden tags:<TD>$num_overridden ($delta_num_overridden)
<TR><TD>Lintian version:<TD>$LINTIAN_VERSION
</TABLE>
</BLOCKQUOTE>
(The numbers in parentheses describe the changes since the last Lintian
report, published on $old_stat->{'last-updated'}.)
<P>
<H1>Other Reports</H1>
<H3><A href="reports/depcheck.html">Dependency problem reports</A></H3>
A list of package dependencies that cannot be satisfied, for each architecture:
<A href="reports/depcheck.html#i386">i386</A>,
<A href="reports/depcheck.html#alpha">alpha</A>,
<A href="reports/depcheck.html#m68k">m68k</A>,
<A href="reports/depcheck.html#powerpc">powerpc</A>,
<A href="reports/depcheck.html#sparc">sparc</A>,
<A href="reports/depcheck.html#arm">arm</A>,
<A href="reports/depcheck.html#hurd-i386">hurd-i386</A>.
$close_text
EOT_EOT_EOT
close(OUT);

exit 0;

# -------------------------------

sub open_maintainer_index {
    open(I,">$HTML_TMP_DIR/maintainers.html") or die "$!";
    print I "<html><head><title>Lintian report, sorted by maintainers</title></head>\n";
    print I "<body>\n";
    print I "<h1>Lintian report, sorted by maintainers</h1>\n";
}

sub close_maintainer_index {
    print I $close_text;
    close(I);
}

sub list_maintainer {
    print I "\n<A href=\"$_[0]\">$_[1]</A><P>\n";
    $num_maint++;
}

# -------------------------------

sub open_tag_index {
    open(T,">$HTML_TMP_DIR/tags.html") or die "$!";
    print T "<HTML><HEAD><TITLE>Lintian report, sorted by tags</TITLE></HEAD>\n";
    print T "<BODY>\n";
    print T "<H1>Lintian report, sorted by tags</H1>\n";
}

sub close_tag_index {
    print T $close_text;
    close(T);
}

sub list_tag {
    my ($ts, $ps);

    $ts = 's' if $_[1] != 1;
    $ps = 's' if $_[2] != 1;
    print T "\n" . make_tagref($_[0]) . " ($_[2] package$ps, $_[1] tag$ts)<P>\n";
}

# -------------------------------

my $maint;
my $maint_file;

sub open_maintainer {
    return if $_[0] eq $maint_file;
    close_maintainer();

    $maint_file = $_[0];
    open(P,">$HTML_TMP_DIR/$maint_file") or die "$!";
    
    $t = quotehtml($maint);

    print P "<html><head><title>Lintian report for $t</title></head>\n";
    print P "<body>\n";
    print P "<h2>Lintian report for</h2>\n";
    print P "<h1>$t</h1>\n";

    list_maintainer($maint_file, $t);
}

sub set_maintainer {
    return if $_[0] eq $maint;

    $maint = $_[0];

    my $file = $maint;
    if ($file) {
	$file =~ s/^(.+)\<.*$/$1/;
	$file =~ tr/A-Za-z0-9_.,/_/c;
	$file =~ s/^_//g;
	$file =~ s/_$//g;

	$file = "m$file.html";
    } else {
	$file = "munsorted.html";
    }

    open_maintainer($file);
}

sub drop_anchor {
    my ($anch, $text) = @_;
    my $key = $anch;

    if (exists $anchor{$key}) {
	print P $text;
    } else {
	$anch =~ tr/-/_/;  # dashes don't work correctly in anchors
	print P "<A name=\"$anch\">$text</A>";

	$anchor{$key} = "$maint_file#$anch";
    }
}

sub make_anchor {
    my $key = shift;
    if ($anchor{$key}) {
	return "<A href=\"$anchor{$key}\">$key</A>";
    } else {
	return $key;
    }
}
    
sub close_maintainer {
    return if not $maint_file;

    print P $close_text;
    close(P);

    undef $maint_file;
}

# -------------------------------

sub new_src_package {
    my ($src, $ver) = @_;

    print P "\n<p> <hr> <p> <h2>";
    drop_anchor($src, "Source package: $src ($ver)");
    print P "</h2><p>\n";

    $num_srcpkg++;
}

# -------------------------------

sub open_tag_file {
    $tag = shift;

    open(P,">$HTML_TMP_DIR/T$tag.html") or die "$!";
    print P "<HTML><HEAD><TITLE>Lintian report for $tag</TITLE></HEAD>\n";
    print P "<BODY>\n";
    print P "<H2>Lintian report for</H2>\n";
    print P "<H1>$tag</H1>\n";

    # print explanation about tag, if available
    if ($tag_info{$tag}) {
	print P "<P><BLOCKQUOTE>\n";
	print P wrap_paragraphs('HTML', '',$tag_info{$tag}),"\n";
	print P "</BLOCKQUOTE><P>\n";
    } else {
	print STDERR "Can't find info for tag $tag.\n";
    }

    print P "<HR>\n";
}

sub close_tag_file {
    print P $close_text;
    close(P);
}

sub make_tagref {
    return "<A href=\"T$_[0].html\">$_[0]</A>";
}

# -------------------------------

sub output_chunk {
    my ($pbuf) = @_;

    my $count = $#$pbuf+1;
    if ($count > $max_tags) {
	splice(@$pbuf,$max_tags-1);
	push(@$pbuf, sprintf("   ... reported %d more times\n",
			     $count-($max_tags-1)));
    }

    print P "<PRE>\n  " . join('  ', @$pbuf) . "</PRE>\n";
}

sub output_packages {
    my ($l,$f,$r) = @_;

    open(I,">$HTML_TMP_DIR/$f") or die "$!";
    print I "<HTML><HEAD><TITLE>Lintian report, sorted by packages ($r)</TITLE></HEAD>\n";
    print I "<BODY>\n";
    print I "<H1>Lintian report, sorted by packages ($r)</H1>\n";
    print I "<A href=\"packages_1.html\">0-9, A-F</A> | <A href=\"packages_2.html\">G-L</A> | <A href=\"packages_3.html\">M-R</A> | <A href=\"packages_4.html\">S-Z</A><P>\n";

    print I @$l;

    print I $close_text;
    close(I);
}

# -------------------------------

my %bugs;

sub read_bug_file {
    undef %bugs;
    open(B,$_[0]) or die "cannot open file $_[0] for reading: $!";
    while (<B>) {
	chop;
	next if /^\s*$/;
	/^\#(\d+):\s+(.*\S)\s*$/ or die "syntax error in $_[0]: $_";
	$bugs{$2} = $1;
    }
    close(B);
}

sub bug_number {
    return $bugs{$_[0]};
}

sub make_bugref {
    my $bugnum = shift;
    my $bugdir = substr($bugnum, 0, 2);

    return "<A href=\"http://www.debian.org/Bugs/db/$bugdir/$bugnum.html\">"
	. "\#$bugnum</A>";
}

# -------------------------------

sub by_maint {
  $source_info{$a}->{'maintainer'} cmp $source_info{$b}->{'maintainer'};
}

sub by_tag {
  substr($a,3) cmp substr($b,3);
}

sub quotehtml {
    $_ = $_[0] . '';
    s/&/\&amp;/g;
    s/</\&lt;/g;
    s/>/\&gt;/g;
    return $_;
}
