#!/usr/bin/perl -w
#
# Program:  GenerateReport.pl
#
# Synopsis: Summarize a big log file into a table of values, commonly used for
#           testing.  This can generate either a plaintext table, HTML table,
#           or Latex table, depending on whether the -html or -latex options are
#           specified.
#
#           This script reads a report description file to specify the fields
#           and descriptions for the columns of interest.  In reads the raw log
#           input from stdin and writes the table to stdout.
#
# Syntax:   GenerateReport.pl [-html] [-latex] [-graphs] [-csv] <ReportDesc>
#                    < Input > Output
#

# Default values for arguments
my $HTML = 0;
my $LATEX = 0;
my $GRAPHS = 0;
my $CSV = 0;

# Parse arguments...
while ($_ = $ARGV[0], /^[-+]/) {
  shift;
  last if /^--$/;  # Stop processing arguments on --

  # List command line options here...
  if (/^-html$/)   { $HTML = 1; next; }
  if (/^-latex$/)  { $LATEX = 1; next; }
  if (/^-graphs$/) { $GRAPHS = 1; next; }
  if (/^-csv$/)    { $CSV = 1; next; }

  print "Unknown option: $_ : ignoring!\n";
}

#
# Parameters which may be overriden by the report description file.
#

# The column to sort by, to be overridden as necessary by the report description
my $SortCol = 0;
my $SortReverse = 0;
my $SortNumeric = 0;   # Sort numerically or textually?

# If the report wants us to trim repeated path prefixes off of the start of the
# strings in the first column of the report, we can do that.
my $TrimRepeatedPrefix = 0;
my $TrimAllDirectories = 0;

# Helper functions which may be called by the report description files...
sub SumCols {
  my ($Cols, $Col, $NumRows) = @_;
  $Val = 0;
  while ($NumRows) {
    $Col--; $NumRows--;
    $Val += $Cols->[$Col] if ($Cols->[$Col] ne "*");
  }
  return $Val;
}

sub AddColumns {
  my ($Cols, $Col, @Indices) = @_;
  my $result = 0;

  foreach $Idx (@Indices) {
    if ($Cols->[$Col+$Idx] ne "*") {
      $result += $Cols->[$Col+$Idx];
    }
  }

  return $result;
}

# Check command line arguments...
die "Must specify a report description option" if (scalar(@ARGV) < 1);

# Read file input in one big gulp...
undef $/;

# Read raw data file and split it up into records.  Each benchmarks starts with
# a line with a >>> prefix
#
my @Records = split />>> ========= /, <STDIN>;

# Delete the first "entry" which is really stuff printed prior to starting the
# first test.
shift @Records;

# Read and eval the report description file now.  This defines the Fields array
# and may potentially modify some of our global settings like the sort key.
#
my $ReportFN = $ARGV[0];
#print "Reading report description from $ReportFN\n";
open(REPORTDESC, $ReportFN) or
  die "Couldn't open report description '$ReportFN'!";

my @LatexColumns;  # Filled in by report if it supports Latex mode
my %LatexColumnFormat;  # Filled in by report if supports latex mode
my @Graphs;        # Filled in by the report if supports graph mode

# Fill in all of the fields from the report description
my @Fields = eval <REPORTDESC>;


#
# Read data into the table of values...
#
my @Values;
foreach $Record (@Records) {
  my @RowValues;
  my $Col = 0;
  for $Row (@Fields) {
    my $Val = "*";
    if (scalar(@$Row)) {            # An actual value to read?
      if (ref ($Row->[1])) {        # Code to be executed?
        $Val = &{$Row->[1]}(\@RowValues, $Col);
      } else {                      # Field to be read...
        $Record =~ m/$Row->[1]/;
        if (!defined($1)) {
          $Val = "*";
        } else {
          # If there is a formatting function, run it now...
          $Val = $1;
          if (scalar(@$Row) > 2) {
            $Val = &{$Row->[2]}($Val);
          }
        }
      }
    } else {                        # Just add a seperator...
      $Val = "|";
    }

    push @RowValues, $Val;
    $Col++;
  }

  my $Assert = "";
  if ($Record =~ m/Assertion/) {
    # If an assertion failure occured, print it out.
    $Assert = sprintf "\n\t\t\t%s", (grep /Assertion/, (split "\n", $Record));
  }
  push @RowValues, $Assert if (!$HTML);
  push @Values, [@RowValues];
}


# If the report wants it, we can trim excess cruft off of the beginning of the
# first column (which is often a path).
if ($TrimRepeatedPrefix and scalar(@Values)) {
  OuterLoop: while (1) {
    # Figure out what the first path prefix is:
    $Values[0]->[0] =~ m|^([^/]*/).|;
    last OuterLoop if (!defined($1));

    # Now that we have the prefix, check to see if all of the entries in the
    # table start with this prefix.
    foreach $Row (@Values) {
      last OuterLoop if ((substr $Row->[0], 0, length $1) ne $1);
    }

    # If we get here, then all of the entries have the prefix.  Remove it now.
    foreach $Row (@Values) {
      $Row->[0] = substr $Row->[0], length $1;
    }
  }
}

# If the report wants it, we can trim of all of the directories part of the
# first column.
if ($TrimAllDirectories and scalar(@Values)) {
  foreach $Row (@Values) {
    $Row->[0] =~ s|^.*/||g;
  }
}


#
# Sort table now...
#
if ($SortNumeric) {
  @Values = sort { $a->[$SortCol] <=> $b->[$SortCol] } @Values;
} else {
  @Values = sort { $a->[$SortCol] cmp $b->[$SortCol] } @Values;
}
@Values = reverse @Values if ($SortReverse);

#
# Condense the header into an easier to access array...
#
my @Header;
for $Row (@Fields) {
  if (scalar(@$Row)) {   # Non-empty row?
    push @Header, $Row->[0];
  } else {               # Empty row, just add seperator
    push @Header, "|";
  }
}

if ($HTML) {
  sub printCell {
    my $Str = shift;
    if ($Str eq '|') {
      print "<td bgcolor='black' width='1'></td>";
    } else {
      #print "<td><table border='0' cellspacing='0' cellpadding='3'><tr><td>$Str</td></tr></table></td>\n";
      print "<td>$Str</td>\n";
    }; "";
  }
  sub printLine {
#    print "<td bgcolor='" . ($_[0] ? "#DDDDDD" : "#AAAAAA") . "' width=1>\n";
  }

  print "<table border='0' cellspacing='0' cellpadding='0'>\n";
  print "<tr bgcolor=#FFCC99>\n";
  map {
    #print "<td bgcolor='#DDAA77' width='1'></td>";
    $_ = "<center><b><a href=\"#$_\">$_</a></b></center>"
      if $_ ne "|"; printCell $_
  } @Header;
  #print "<td bgcolor='#DDAA77' width='1'></td>";
  print "\n</tr><tr bgcolor='black' height=1>";
  #print "<td height=1></td>" x (2*@Header+1);
  print "</tr>\n";
  my $RowCount = 0;
  foreach $Row (@Values) {
    my $IsWhite;
    $IsWhite = ++$RowCount <= 2;
    print "<tr bgcolor='" . ($IsWhite ? "white" : "#CCCCCC") . "'>\n";
    $RowCount = 0 if ($RowCount > 3);
    map { printLine($IsWhite); printCell $_ } @$Row;
    printLine($IsWhite);
    print "\n</tr>\n";
  }
  print "\n</table>\n";
} elsif ($GRAPHS) {      # Graph output...
  print "Generating gnuplot data files:\n";
  my $GraphNo = 0;
  foreach $Graph (@Graphs) {
    my @Graph = @$Graph;
    my $Type = shift @Graph;
    die "Only scatter graphs supported right now, not '$Type'!"
      if ($Type ne "scatter");

    my $Filename = shift @Graph;

    print "Writing '$Filename'...\n";
    open (FILE, ">$Filename") or die ("Could not open file '$Filename'!");

    my ($XCol, $YCol) = @Graph;
    foreach $Row (@Values) {
      print FILE $$Row[$XCol] . "\t" . $$Row[$YCol] . "\n";
    }
    close FILE;
    ++$GraphNo;
  }

} else {
  # Add the header for the report to the table after sorting...
  unshift @Values, [@Header];

  #
  # Figure out how wide each field should be...
  #
  my @FieldWidths = (0) x scalar(@Fields);
  foreach $Value (@Values) {
    for ($i = 0; $i < @$Value-1; $i++) {
      if (length($$Value[$i]) > $FieldWidths[$i]) {
        $FieldWidths[$i] = length($$Value[$i])
      }
    }
  }

  if ($LATEX) {
    #
    # Print out the latexified table...
    #
    shift @Values;  # Don't print the header...

    # Make sure the benchmark name field is wide enough for any aliases.
    foreach $Name (@LatexRowMapOrder) {
      $FieldWidths[0] = length $Name if (length($Name) > $FieldWidths[0]);
    }

    # Print out benchmarks listed in the LatexRowMapOrder
    for ($i = 0; $i < @LatexRowMapOrder; $i += 2) {
      my $Name = $LatexRowMapOrder[$i];
      if ($Name eq '-') {
        print "\\hline\n";
      } else {
        # Output benchmark name...
        printf "%-$FieldWidths[0]s", $LatexRowMapOrder[$i+1];

        # Find the row that this benchmark name corresponds to...
        foreach $Row (@Values) {
          if ($Row->[0] eq $Name) {
            for $ColNum (@LatexColumns) {
              # Print a seperator...
              my $Val = $Row->[$ColNum];
              if (exists $LatexColumnFormat{$ColNum}) {
                # If a column format routine has been specified, run it now...
                $Val = &{$LatexColumnFormat{$ColNum}}($Val);
              }

              # Escape illegal latex characters
              $Val =~ s/([%#])/\\$1/g;

              printf " & %-$FieldWidths[$ColNum]s", $Val;
            }
            goto Done;
          }
        }
        print "UNKNOWN Benchmark name: " . $Name;
      Done:
        print "\\\\\n";
      }
    }
  } elsif ($CSV && scalar(@LatexRowMapOrder)) {
    #
    # Print out the table as csv in the row-order specified by LatexRowMapOrder
    #
    for ($i = 0; $i < @LatexRowMapOrder; $i += 2) {
      my $Name = $LatexRowMapOrder[$i];
      if ($Name eq '-') {
        print "----\n";
      } else {
        # Output benchmark name.
        printf "$LatexRowMapOrder[$i+1]";

        # Find the row that this benchmark name corresponds to.
        foreach $Row (@Values) {
          if ($Row->[0] eq $Name) {
            for ($j = 1; $j < @$Row-1; $j++) {
              print ",$$Row[$j]";
            }
            goto Done;
          }
        }
        print "UNKNOWN Benchmark name: " . $Name;
      Done:
        print "\\\\\n";
      }
    }

  } elsif ($CSV) {
    #
    # Print out the table as csv
    #
    foreach $Value (@Values) {
      printf "$$Value[0]";
      for ($i = 1; $i < @$Value-1; $i++) {
        print ",$$Value[$i]" if ($$Value[$i] ne "|");
      }
      print "\n";
    }
  } else {
    #
    # Print out the table in plaintext format now...
    #
    foreach $Value (@Values) {
      for ($i = 0; $i < @$Value-1; $i++) {
        printf "%-$FieldWidths[$i]s ", $$Value[$i];
      }
      
      # Print the assertion message if existant...
      print "$$Value[@$Value-1]\n";
    }
  }
}