#! /usr/bin/env perl

# -*- Mode:perl ; -*-

#

# This file converts a coverate data file, produced by the simple coverage

# package, into an html file showing the covered and uncovered parts of the 

# code.

#

# The format of the simple coverage package data is

#  routine \t nargs \t #calls \t sourcefile \t first-line \t last-line \n

# sorted by routine name and number of arguments.

#

# NOT YET WRITTEN

# This program reads the data file; then takes each different source file

# and creates a simple HTML version, using color to accent uncovered and

# covered code

#

# First step:

#    read file.  Save data as

#    %SourceFiles{ name } => internal hash name

#    %internalhashname{ firstline } => "lastline:routine:argcount:ncall"

#

# Then we can sort on the keys and the use that for "next line with covered"

#

# Reading the source code, we check each

#     COVERAGE_BEGIN/END

# for a corresponding entry in the data (in internalhashname).  Surround

# the block with pale green or red if covered or uncovered.

#    

sub ReadCovData {

    my $filename = $_[0];

    my $srccnt = 0;

    open FD, "<$filename" || die "Could not open coverage file $filename\n";

    while (<FD>) {

	chomp;

	my ($routine,$argcnt,$callcnt,$srcfile,$firstline,$lastline) = 

	    split(/\t/,$_);

	if (!defined($SourceFiles{$srcfile})) {

	    $srccnt++;

	    $srchash = "srchash$srccnt";

	    $SourceFiles{$srcfile} = $srchash;

	}

	else {

	    $srchash = $SourceFiles{$srcfile};

	}

	$$srchash{$firstline} = "$lastline\t$routine\t$argcnt\t$callcnt";

    }

    close FD;

}

# For debugging

sub DebugWriteCovData {

    foreach my $srcfile (keys(%SourceFiles)) {

	my $srchash = $SourceFiles{$srcfile};

	print "srchash = $srchash\n";

	foreach my $line (sort(keys(%$srchash))) {

	    print "$line\t$$srchash{$line}\n";

	}

    }

}

# Read a source file and annotate it based on the information in the

# srchash

#

# There are three states for the annoted file:

#   nocode  - not within a coverage block

#   incov   - within AND covered

#   uncov   - within and NOT covered

#

%annotecolors = ( "nocode" => "white",

		  "incov" => "lightgreen",

		  "uncov" => "red",

		  );

# Save routine => file:line

%coveredRoutines = ();

%uncoveredRoutines = ();

sub ReadAndAnnoteSrcfile {

    my $srcfile = $_[0];

    my $srchash = $_[1];   # *name* of the source hash

    my $annotefile = $_[2];

    my $linecount = 0;

    my $state = "nocode", $newstate;

    my $bgcolor, $newcolor;

    $bgcolor = $annotecolors{$state};

    open FD, "<$srcfile" || die "Cannot open source file $srcfile\n";

    open OUTFD, ">$annotefile" || die "Cannot open annotation file $annotefile\n";

    &WriteHTMLHeader( OUTFD, "Coverage file for $srcfile" );

    print OUTFD "
";

    while (<FD>) {

	$linecount ++;

	if (/COVERAGE_START\(([^,]*),([^\)]*)\)/) {

	    my $routine = $1;

	    my $argcnt  = $2;

	    my $rname = "$routine-$argcnt";

	    if (defined($$srchash{$linecount})) {

		$newstate = "incov";

		$coveredRoutines{$rname}   = "$srcfile:$linecount";

	    }

	    else {

		$newstate = "uncov";

		$uncoveredRoutines{$rname} = "$srcfile:$linecount";

	    }

	}

	elsif (/COVERAGE_END/) {

	    $newstate = "nocode";

	    print OUTFD &HTMLify( $_ );

	}

	if ($newstate eq $state) {

	    print OUTFD &HTMLify( $_ );

	}

	else {

	    # State transitions happen at either the beginning or the

	    # If at the end, the line has already been output.

	    print OUTFD "\n";

	    $state = $newstate;

	    $bgcolor = $annotecolors{$state};

	    print OUTFD "
";

	    if ($newstate ne "nocode") {

		print OUTFD &HTMLify( $_ );

	    }

	}

    }

    # Finish off the last table.

    print OUTFD "\n";

    close FD;

    &WriteHTMLTrailer( OUTFD );

    close OUTFD;

}

# Summary report

# TODO : compare the routines found to a master list of all routines.

# generate a third list of unseen routines

$maxcol = 4;

sub CoverageSummary {

    my ($filename) = @_;

    my $col;

    my %unseenRoutines = %allRoutines;

    open FD, ">$filename" || die "Cannot open summary file $filename\n";

    &WriteHTMLHeader( FD, "Coverage Summary" );

    print FD "
Covered routines
\n";

    print FD "";

    $col = 1;

    foreach $name (sort(keys(%coveredRoutines))) {

	if ($col == 1) { print FD ""; }

	my ($routine,$argcnt) = split(/-/,$name);

	print FD "$routine";

	if (defined($unseenRoutines{$routine})) {

	    delete $unseenRoutines{$routine};

	}

	if ($col++ == $maxcol) {$col = 1; print FD "\n"; }

    }

    while ($col != 1) {

	print FD "";

	if ($col++ == $maxcol) {$col = 1; print FD "\n"; }

    }

    print FD "\n";

    print FD "
Uncovered routines
\n";

    print FD "";

    $col = 1;

    foreach $name (sort(keys(%uncoveredRoutines))) {

	if ($col == 1) { print FD ""; }

	my ($routine,$argcnt) = split(/-/,$name);

	my $where = $uncoveredRoutines{$name};

	$where =~ s/.*\///;

	print FD "$routine($where)";

	if ($col++ == $maxcol) {$col = 1; print FD "\n"; }

	if (defined($unseenRoutines{$routine})) {

	    delete $unseenRoutines{$routine};

	}

    }

    while ($col != 1) {

	print FD "";

	if ($col++ == $maxcol) {$col = 1; print FD "\n"; }

    }

    print FD "\n";

    print FD "
Unseen routines
\n";

    print FD "";

    $col = 1;

    foreach $name (sort(keys(%unseenRoutines))) {

	if ($col == 1) { print FD ""; }

	my $routine = $name;

	print FD "$routine";

	if ($col++ == $maxcol) {$col = 1; print FD "\n"; }

    }

    while ($col != 1) {

	print FD "";

	if ($col++ == $maxcol) {$col = 1; print FD "\n"; }

    }

    print FD "\n";

    &WriteHTMLTrailer( FD );

    close FD;

}

%coveredRoutines = ();

%uncoveredRoutines = ();

%allRoutines = ();   # Not yet used

sub ReadAllList {

    my $filename = $_[0];

    open FD, "<$filename" || return 0;

    while (<FD>) {

	chomp;

	s/\r//;

	$allRoutines{$_} = 1;

    }

    close FD;

}

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

sub WriteHTMLHeader {

    my ($FD,$title) = @_;

    print $FD "<HTML>\n<HEAD>\n<TITLE>$title</TITLE></HEAD>\n";

    print $FD "<BODY BGCOLOR=\"FFFFFF\">\n";

}

sub WriteHTMLTrailer {

    my $FD = $_[0];

    print $FD "</BODY>\n</HTML>\n";

}

# HTMLify

# Take an input line and make it value HTML

sub HTMLify {

    my $line = $_[0];

    $line =~ s/\&/--AMP--/g;

    $line =~ s/>/>/g;

    $line =~ s/</</g;

    $line =~ s/--AMP--/&/g;

    return $line;

}

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

#

# Temp for testing

&ReadAllList( "mpi.dat" );

# Remove those deprecated MPI routines that are not in the C++ binding

# FIXME: Check that C++ binding does not include these

foreach my $oldname ("Type_ub", "Type_lb", "Attr_delete", "Attr_get", 

		     "Attr_put", "Keyval_free", "Keyval_create", 

		     "Errhandler_get", "Errhandler_set", 

                     "Errhandler_create", "Address", "Type_struct", 

                     "Type_extent", "Type_hvector", "Type_hindexed" ) {

    delete $allRoutines{$oldname};

}

&ReadCovData( "cov.dat" );

# Generate the output

foreach $srcfile (keys(%SourceFiles)) {

    my $srchash = $SourceFiles{$srcfile};

    my $annotefile;

    $annotefile = $srcfile;

    # Still needed: A way to update the directory paths.  This

    # simply removes -all- directories.  We may instead

    # want a way to remove a prefix only

    $annotefile =~ s/.*\///g;

    $annotefile .= ".htm";

    print "annote file = $annotefile\n";

    &ReadAndAnnoteSrcfile( $srcfile, $srchash, $annotefile );

}

&CoverageSummary( "cov.sum.htm" );