#!/usr/local/bin/perl
use strict;
my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
my $outType = "HTML";
my $html = "noName";
my $inTable;
my @headers;
my @timetypes = ("per iteration", "per operation", "events", "per event");
my %raw;
my $current;
my $exp = 0;
sub startTest {
$current = shift;
$exp = 0;
outputData($current);
}
sub startTable {
my $printEvents = shift;
$inTable = 1;
print HTML "\n";
if($#headers >= 0) {
my ($header, $i);
print HTML "";
print HTML "| Test Name | ";
print HTML "Operations | ";
foreach $i (@timetypes) {
foreach $header (@headers) {
print HTML "$header
$i | " unless ($i =~ /event/ && !$printEvents);
}
}
print HTML "
\n";
}
}
sub closeTable {
if($inTable) {
undef $inTable;
print HTML "\n";
print HTML "
\n";
}
}
sub newRow {
if(!$inTable) {
startTable;
} else {
print HTML "\n";
}
print HTML "";
}
sub outputData {
my $message;
if($inTable) {
print HTML "| ";
foreach $message (@_) {
print HTML "$message";
}
print HTML " | ";
} else {
foreach $message (@_) {
print HTML "$message";
}
}
}
sub setupOutput {
my $date = localtime;
my $options = shift;
my %options = %{ $options };
my $title = $options{ "title" };
my $headers = $options{ "headers" };
@headers = split(/ /, $headers);
my ($t, $rest);
($t, $rest) = split(/\.\w+/, $0);
$t =~ /^.*\W(\w+)$/;
$t = $1;
if($outType eq 'HTML') {
$html = $date;
$html =~ s/://g; # ':' illegal
$html =~ s/\s*\d+$//; # delete year
$html =~ s/^\w+\s*//; # delete dow
$html = "$t $html.html";
if($options{ "outputDir" }) {
$html = $options{ "outputDir" }."/".$html;
}
open(HTML,">$html") or die "Can't write to $html: $!";
print HTML <
$title
EOF
print HTML "$title
\n";
#print HTML "$TESTCLASS
\n";
}
}
sub closeOutput {
if($outType eq 'HTML') {
if($inTable) {
closeTable;
}
printRaw();
print HTML <
EOF
close(HTML) or die "Can't close $html: $!";
}
}
sub printRaw {
print HTML "Raw data
";
my $key;
my $i;
for $key (sort keys %raw) {
print HTML $key;
foreach $i ( 0 .. $#{ $raw{$key} } ) {
print HTML " $i = $raw{$key}[$i]";
}
}
print %raw;
}
sub outputRow {
$raw{$current}[$exp++] = [@_];
my $testName = shift;
my @iterPerPass = @{shift(@_)};
my @noopers = @{shift(@_)};
my @timedata = @{shift(@_)};
my @noevents;
if($#_ >= 0) {
@noevents = @{shift(@_)};
}
if(!$inTable) {
if(@noevents) {
debug("Have events header\n");
startTable(1);
} else {
debug("No events header\n");
startTable;
}
}
debug("No events: @noevents, $#noevents\n");
my $j;
# Finished one row of results. Outputting
newRow;
outputData($testName);
#outputData($iterCount);
outputData($noopers[0]);
for $j ( 0 .. $#timedata ) {
my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]); # time per operation
#debug("Time per operation: ".formatSeconds(4, $perOperation->getMean, $perOperation->getError)."\n");
outputData(formatSeconds(4, $perOperation->getMean, $perOperation->getError));
}
for $j ( 0 .. $#timedata ) {
my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
#debug("Time per operation: ".formatSeconds(4, $perOperation->getMean, $perOperation->getError)."\n");
outputData(formatSeconds(4, $perOperation->getMean, $perOperation->getError));
}
if(@noevents) {
for $j ( 0 .. $#timedata ) {
outputData($noevents[$j]);
}
for $j ( 0 .. $#timedata ) {
my $perEvent = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per event
#debug("Time per operation: ".formatSeconds(4, $perEvent->getMean, $perEvent->getError)."\n");
outputData(formatSeconds(4, $perEvent->getMean, $perEvent->getError));
}
}
}
1;
#eof