GenerateReport.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Program:  GenerateReport.pl
   4 #
   5 # Synopsis: Summarize a big log file into a table of values, commonly used for
   6 #           testing.  This can generate either a plaintext table, HTML table,
   7 #           or Latex table, depending on whether the -html or -latex options are
   8 #           specified.
   9 #
  10 #           This script reads a report description file to specify the fields
  11 #           and descriptions for the columns of interest.  In reads the raw log
  12 #           input from stdin and writes the table to stdout.
  13 #
  14 # Syntax:   GenerateReport.pl [-html] [-latex] [-graphs] [-csv] <ReportDesc>
  15 #                    < Input > Output
  16 #
  17
  18 # Default values for arguments
  19 my $HTML = 0;
  20 my $LATEX = 0;
  21 my $GRAPHS = 0;
  22 my $CSV = 0;
  23
  24 # Parse arguments...
  25 while ($_ = $ARGV[0], /^[-+]/) {
  26   shift;
  27   last if /^--$/;  # Stop processing arguments on --
  28
  29   # List command line options here...
  30   if (/^-html$/)   { $HTML = 1; next; }
  31   if (/^-latex$/)  { $LATEX = 1; next; }
  32   if (/^-graphs$/) { $GRAPHS = 1; next; }
  33   if (/^-csv$/)    { $CSV = 1; next; }
  34
  35   print "Unknown option: $_ : ignoring!\n";
  36 }
  37
  38 #
  39 # Parameters which may be overriden by the report description file.
  40 #
  41
  42 # The column to sort by, to be overridden as necessary by the report description
  43 my $SortCol = 0;
  44 my $SortReverse = 0;
  45 my $SortNumeric = 0;   # Sort numerically or textually?
  46
  47 # If the report wants us to trim repeated path prefixes off of the start of the
  48 # strings in the first column of the report, we can do that.
  49 my $TrimRepeatedPrefix = 0;
  50 my $TrimAllDirectories = 0;
  51
  52 # Helper functions which may be called by the report description files...
  53 sub SumCols {
  54   my ($Cols, $Col, $NumRows) = @_;
  55   $Val = 0;
  56   while ($NumRows) {
  57     $Col--; $NumRows--;
  58     $Val += $Cols->[$Col] if ($Cols->[$Col] ne "*");
  59   }
  60   return $Val;
  61 }
  62
  63 sub AddColumns {
  64   my ($Cols, $Col, @Indices) = @_;
  65   my $result = 0;
  66
  67   foreach $Idx (@Indices) {
  68     if ($Cols->[$Col+$Idx] ne "*") {
  69       $result += $Cols->[$Col+$Idx];
  70     }
  71   }
  72
  73   return $result;
  74 }
  75
  76 # Check command line arguments...
  77 die "Must specify a report description option" if (scalar(@ARGV) < 1);
  78
  79 # Read file input in one big gulp...
  80 undef $/;
  81
  82 # Read raw data file and split it up into records.  Each benchmarks starts with
  83 # a line with a >>> prefix
  84 #
  85 my @Records = split />>> ========= /, <STDIN>;
  86
  87 # Delete the first "entry" which is really stuff printed prior to starting the
  88 # first test.
  89 shift @Records;
  90
  91 # Read and eval the report description file now.  This defines the Fields array
  92 # and may potentially modify some of our global settings like the sort key.
  93 #
  94 my $ReportFN = $ARGV[0];
  95 #print "Reading report description from $ReportFN\n";
  96 open(REPORTDESC, $ReportFN) or
  97   die "Couldn't open report description '$ReportFN'!";
  98
  99 # HilightColumns - Filled in by the report if desired in HTML mode.  This
 100 # contains a column number if the HTML version of the output should highlight a
 101 # cell in green/red if it is gt/lt 1.0 by a significant margin.
 102 my %HilightColumns;
 103
 104 my @LatexColumns;  # Filled in by report if it supports Latex mode
 105 my %LatexColumnFormat;  # Filled in by report if supports latex mode
 106 my @Graphs;        # Filled in by the report if supports graph mode
 107
 108 # Fill in all of the fields from the report description
 109 my @Fields = eval <REPORTDESC>;
 110
 111
 112 #
 113 # Read data into the table of values...
 114 #
 115 my @Values;
 116 foreach $Record (@Records) {
 117   my @RowValues;
 118   my $Col = 0;
 119   for $Row (@Fields) {
 120     my $Val = "*";
 121     if (scalar(@$Row)) {            # An actual value to read?
 122       if (ref ($Row->[1])) {        # Code to be executed?
 123         $Val = &{$Row->[1]}(\@RowValues, $Col);
 124       } else {                      # Field to be read...
 125         $Record =~ m/$Row->[1]/;
 126         if (!defined($1)) {
 127           $Val = "*";
 128         } else {
 129           # If there is a formatting function, run it now...
 130           $Val = $1;
 131           if (scalar(@$Row) > 2) {
 132             $Val = &{$Row->[2]}($Val);
 133           }
 134         }
 135       }
 136     } else {                        # Just add a seperator...
 137       $Val = "|";
 138     }
 139
 140     push @RowValues, $Val;
 141     $Col++;
 142   }
 143
 144   my $Assert = "";
 145   if ($Record =~ m/Assertion/) {
 146     # If an assertion failure occured, print it out.
 147     $Assert = sprintf "\n\t\t\t%s", (grep /Assertion/, (split "\n", $Record));
 148   }
 149   push @RowValues, $Assert if (!$HTML);
 150   push @Values, [@RowValues];
 151 }
 152
 153
 154 # If the report wants it, we can trim excess cruft off of the beginning of the
 155 # first column (which is often a path).
 156 if ($TrimRepeatedPrefix and scalar(@Values)) {
 157   OuterLoop: while (1) {
 158     # Figure out what the first path prefix is:
 159     $Values[0]->[0] =~ m|^([^/]*/).|;
 160     last OuterLoop if (!defined($1));
 161
 162     # Now that we have the prefix, check to see if all of the entries in the
 163     # table start with this prefix.
 164     foreach $Row (@Values) {
 165       last OuterLoop if ((substr $Row->[0], 0, length $1) ne $1);
 166     }
 167
 168     # If we get here, then all of the entries have the prefix.  Remove it now.
 169     foreach $Row (@Values) {
 170       $Row->[0] = substr $Row->[0], length $1;
 171     }
 172   }
 173 }
 174
 175 # If the report wants it, we can trim of all of the directories part of the
 176 # first column.
 177 if ($TrimAllDirectories and scalar(@Values)) {
 178   foreach $Row (@Values) {
 179     $Row->[0] =~ s|^.*/||g;
 180   }
 181 }
 182
 183
 184 #
 185 # Sort table now...
 186 #
 187 if ($SortNumeric) {
 188   @Values = sort { $lhs = $a->[$SortCol]; $rhs = $b->[$SortCol];
 189                    $lhs = 0 if ($lhs eq "*");
 190                    $rhs = 0 if ($rhs eq "*");
 191                    $lhs <=> $rhs } @Values;
 192 } else {
 193   @Values = sort { $a->[$SortCol] cmp $b->[$SortCol] } @Values;
 194 }
 195 @Values = reverse @Values if ($SortReverse);
 196
 197 #
 198 # Condense the header into an easier to access array...
 199 #
 200 my @Header;
 201 for $Row (@Fields) {
 202   if (scalar(@$Row)) {   # Non-empty row?
 203     push @Header, $Row->[0];
 204   } else {               # Empty row, just add seperator
 205     push @Header, "|";
 206   }
 207 }
 208
 209 if ($HTML) {
 210   sub printCell {
 211     my $Str = shift;
 212     my $ColNo = shift;
 213     my $IsWhite = shift;
 214     my $Attrs = "";
 215     if ($Str eq '|') {
 216       $Attrs = " bgcolor='black' width='1'";
 217       $Str = "";
 218     } else {
 219       # If  the user requested that we highlight this column, check to see what
 220       # number it is.  If it is > 1.05, we color it green, < 0.95 we use red.
 221       # If it's not a number, ignore it.
 222       if ($HilightColumns{$ColNo}) {
 223         if ($Str =~ m/^([0-9]+).?[0-9.]*$/) {
 224           if ($Str <= 0.85) {
 225             $Attrs = " bgcolor='#FF7070'";
 226           } elsif ($Str <= 0.95) {
 227             $Attrs = " bgcolor='#FFAAAA'";
 228           } elsif ($Str >= 1.15) {
 229             $Attrs = " bgcolor='#80FF80'";
 230           } elsif ($Str >= 1.05) {
 231             $Attrs = " bgcolor='#CCFFCC'";
 232           }
 233         }
 234
 235         if (!$IsWhite && $Attrs eq "") {
 236           # If it's not already white, make it white now.
 237           $Attrs = " bgcolor=white";
 238         }
 239       }
 240     };
 241     print "<td$Attrs>$Str</td>";
 242     "";
 243   }
 244
 245   print "<table border='0' cellspacing='0' cellpadding='0'>\n";
 246   print "<tr bgcolor=#FFCC99>\n";
 247   map {
 248     $_ = "<center><b><a href=\"#$_\">$_</a></b></center>"
 249       if $_ ne "|";
 250     printCell($_, -1)
 251   } @Header;
 252   print "\n</tr><tr bgcolor='black' height=1>";
 253   print "</tr>\n";
 254   my $RowCount = 0;
 255   foreach $Row (@Values) {
 256     my $IsWhite;
 257     $IsWhite = ++$RowCount <= 2;
 258     print "<tr bgcolor='" . ($IsWhite ? "white" : "#CCCCCC") . "'>\n";
 259     $RowCount = 0 if ($RowCount > 3);
 260     my $ColCount = 0;
 261     map { printCell($_, $ColCount++, $IsWhite); } @$Row;
 262     print "\n</tr>\n";
 263   }
 264   print "\n</table>\n";
 265 } elsif ($GRAPHS) {      # Graph output...
 266   print "Generating gnuplot data files:\n";
 267   my $GraphNo = 0;
 268   foreach $Graph (@Graphs) {
 269     my @Graph = @$Graph;
 270     my $Type = shift @Graph;
 271     die "Only scatter graphs supported right now, not '$Type'!"
 272       if ($Type ne "scatter");
 273
 274     my $Filename = shift @Graph;
 275
 276     print "Writing '$Filename'...\n";
 277     open (FILE, ">$Filename") or die ("Could not open file '$Filename'!");
 278
 279     my ($XCol, $YCol) = @Graph;
 280     foreach $Row (@Values) {
 281       print FILE $$Row[$XCol] . "\t" . $$Row[$YCol] . "\n";
 282     }
 283     close FILE;
 284     ++$GraphNo;
 285   }
 286
 287 } else {
 288   # Add the header for the report to the table after sorting...
 289   unshift @Values, [@Header];
 290
 291   #
 292   # Figure out how wide each field should be...
 293   #
 294   my @FieldWidths = (0) x scalar(@Fields);
 295   foreach $Value (@Values) {
 296     for ($i = 0; $i < @$Value-1; $i++) {
 297       if (length($$Value[$i]) > $FieldWidths[$i]) {
 298         $FieldWidths[$i] = length($$Value[$i])
 299       }
 300     }
 301   }
 302
 303   if ($LATEX) {
 304     #
 305     # Print out the latexified table...
 306     #
 307     shift @Values;  # Don't print the header...
 308
 309     # Make sure the benchmark name field is wide enough for any aliases.
 310     foreach $Name (@LatexRowMapOrder) {
 311       $FieldWidths[0] = length $Name if (length($Name) > $FieldWidths[0]);
 312     }
 313
 314     # Print out benchmarks listed in the LatexRowMapOrder
 315     for ($i = 0; $i < @LatexRowMapOrder; $i += 2) {
 316       my $Name = $LatexRowMapOrder[$i];
 317       if ($Name eq '-') {
 318         print "\\hline\n";
 319       } else {
 320         # Output benchmark name...
 321         printf "%-$FieldWidths[0]s", $LatexRowMapOrder[$i+1];
 322
 323         # Find the row that this benchmark name corresponds to...
 324         foreach $Row (@Values) {
 325           if ($Row->[0] eq $Name) {
 326             for $ColNum (@LatexColumns) {
 327               # Print a seperator...
 328               my $Val = $Row->[$ColNum];
 329               if (exists $LatexColumnFormat{$ColNum}) {
 330                 # If a column format routine has been specified, run it now...
 331                 $Val = &{$LatexColumnFormat{$ColNum}}($Val);
 332               }
 333
 334               # Escape illegal latex characters
 335               $Val =~ s/([%#])/\\$1/g;
 336
 337               printf " & %-$FieldWidths[$ColNum]s", $Val;
 338             }
 339             goto Done;
 340           }
 341         }
 342         print "UNKNOWN Benchmark name: " . $Name;
 343       Done:
 344         print "\\\\\n";
 345       }
 346     }
 347   } elsif ($CSV && scalar(@LatexRowMapOrder)) {
 348     #
 349     # Print out the table as csv in the row-order specified by LatexRowMapOrder
 350     #
 351     for ($i = 0; $i < @LatexRowMapOrder; $i += 2) {
 352       my $Name = $LatexRowMapOrder[$i];
 353       if ($Name eq '-') {
 354         print "----\n";
 355       } else {
 356         # Output benchmark name.
 357         printf "$LatexRowMapOrder[$i+1]";
 358
 359         # Find the row that this benchmark name corresponds to.
 360         foreach $Row (@Values) {
 361           if ($Row->[0] eq $Name) {
 362             for ($j = 1; $j < @$Row-1; $j++) {
 363               print ",$$Row[$j]";
 364             }
 365             goto Done;
 366           }
 367         }
 368         print "UNKNOWN Benchmark name: " . $Name;
 369       Done:
 370         print "\\\\\n";
 371       }
 372     }
 373
 374   } elsif ($CSV) {
 375     #
 376     # Print out the table as csv
 377     #
 378     my $firstrow = 1;
 379     foreach $Value (@Values) {
 380       printf "$$Value[0]";
 381       for ($i = 1; $i < @$Value-1; $i++) {
 382         print ",$$Value[$i]" if ($$Value[$i] ne "|");
 383       }
 384       if ($firstrow) {
 385         # Print an extra column for the header.
 386         print ",$$Value[@$Value-1]";
 387         $firstrow = 0;
 388       }
 389       print "\n";
 390     }
 391   } else {
 392     #
 393     # Print out the table in plaintext format now...
 394     #
 395     foreach $Value (@Values) {
 396       for ($i = 0; $i < @$Value-1; $i++) {
 397         printf "%-$FieldWidths[$i]s ", $$Value[$i];
 398       }
 399
 400       # Print the assertion message if existant...
 401       print "$$Value[@$Value-1]\n";
 402     }
 403   }
 404 }