#!/usr/bin/perl -w
require 5.003;
use strict;
# compares results labeled with label_results
# see also: label_results, plot_tables
if (`pwd` =~ 'ReportGen') {
use lib '..';
}
use FileHandle;
#use HTML::Entities;
use ReportGen::Opts;
use ReportGen::Globs;
use ReportGen::ObjDbase;
use ReportGen::ObjManip;
use ReportGen::RepFormat;
# Configuration
my %Opts = (
table_plotter => undef(),
table_plotter_opts => undef(),
);
my %SavedOpts = %Opts;
my @RawMeas = qw(
product.price
rep.rate
hit.rptm.mean rep.rptm.mean miss.rptm.mean
hit.ratio.obj
rep.rptm.mean.save.ratio
hit.rate_price.ratio rep.rate_price.ratio
miss.time_till_first hit.time_till_first
cache.age.max
);
my @RawMeasAll = qw(
product.price
rep.rate hit.rate
hit.rptm.mean rep.rptm.median rep.rptm.mean miss.rptm.mean
hit.ratio.obj hit.ratio.byte rep.rptm.mean.save.ratio
hit.rate_price.ratio rep.rate_price.ratio
miss.time_till_first hit.time_till_first
cache.age.max err_xact.ratio
cache.rack.space
hit.rate_rack.space.ratio rep.rate_rack.space.ratio
);
my %MetaGraphs = (
'rep.rate' => 'Peak Throughput',
'hit.rate' => 'Peak Hit Rate',
'product.price' => 'Total Price',
'rep.rptm.mean' => 'Mean Response Time',
'rep.rptm.median' => 'Median Response Time',
'hit.rptm.mean' => 'Hit Response Time',
'miss.rptm.mean' => 'Miss Response Time',
'hit.ratio.obj' => 'Document Hit Ratio',
'hit.ratio.byte' => 'Byte Hit Ratio',
'rep.rptm.mean.save.ratio' => 'Mean Response Time Improvement',
'rep.rate_price.ratio' => 'Throughput / Price',
'hit.rate_price.ratio' => 'Hit rate / Price',
'hit.time_till_first' => 'Time till first hit',
'miss.time_till_first' => 'Time till first miss',
'cache.age.max' => 'Cache Age',
'rep.rate_rack.space.ratio' => 'Throughput / Rack Space',
'hit.rate_rack.space.ratio' => 'Hit rate / Rack Space',
);
my @CfgMeas = qw(
human_name cache.price
cache.availability cache.units cache.cpus
cache.ram cache.disks cache.nics
cache.rack.space
cache.size.bytes
cache.software
);
# globals
my @Labels = ();
my $MetaDir;
my $CmpName = 'all';
my $TmpFName;
my $ConfSep = ' · ';
&init();
exit(&main());
sub main {
foreach my $label (@Labels) {
&curLabel($label);
my $stats = &ReadDbase(&FullInFName($label, "clt.All.lx"));
&importObjects($stats);
my $facts = &ReadDbase(&FullInFName($label, "facts.lx"));
&importObjects($facts);
&addMoreObjects();
&curLabel(undef());
}
# order runs based on request rate
# @Labels = sort { &objVal("$a\::rep.rate") <=> &objVal("$b\::rep.rate") } @Labels;
# alphabetical order
@Labels = sort cmpLabelsAlph @Labels;
if (1) {
$TmpFName = &FullOutFName($CmpName, "tmp-$$", '.dat');
my $fname = &FullOutFName($CmpName, 'index', '.html');
&openReport($fname, $CmpName);
&buildExecSumTable();
&buildRawSumTable();
&plotGraphs();
&buildCfgSumTable();
&closeReport();
unlink($TmpFName);
warn("$0: comparison: file:$fname\n");
}
&buildComments();
&buildMetaFiles();
my $metaFName = &FullOutFName($MetaDir, 'index', '.html');
warn("$0: meta-dir: file:$metaFName\n");
return 0;
}
sub buildExecSumTable {
my $pfx = "$MetaDir/all"; # "polyrep/$CmpName";
my $table = <<HTML;
<table border=1 cellpadding=1 cellspacing=1>
<tr bgcolor="#BBBBBB">
<th rowspan=2>Product</th>
<th rowspan=2><a href="$pfx/product.price.html">Total<br>Price</a><br><small>(US\$)</small></th>
<th rowspan=2><a href="$pfx/rep.rate.html">Peak<br>Tput</a><br><small>(req/sec)</small></th>
<th colspan=3>Response Time<br><small>(sec)</small></th>
<th colspan=2>Savings<br><small>(%)</small></th>
<th colspan=2>\$1,000<br>can buy</th>
<th colspan=2>Minutes<br>Till First</th>
<th rowspan=2><a href="$pfx/cache.age.max.html">Cache<br>Age</a><br><small>(hour)</small></th>
</tr>
<tr bgcolor="#BBBBBB">
<th><a href="$pfx/hit.rptm.mean.html">Hit</a></th>
<th><a href="$pfx/rep.rptm.mean.html">All</a></th>
<th><a href="$pfx/miss.rptm.mean.html">Miss</a></th>
<th><a href="$pfx/hit.ratio.obj.html">Doc</a></th>
<th><a href="$pfx/rep.rptm.mean.save.ratio.html">Time</a></th>
<th><a href="$pfx/hit.rate_price.ratio.html"><small>hit/sec</small></a></th>
<th><a href="$pfx/rep.rate_price.ratio.html"><small>req/sec</small></a></th>
<th><a href="$pfx/miss.time_till_first.html">Miss</a></th>
<th><a href="$pfx/hit.time_till_first.html">Hit</a></th>
</tr>
HTML
foreach my $label (sort cmpLabelsAlph @Labels) {
$table .= sprintf('<tr><th align=left>%s</th>',
&benchRef($label, $MetaDir));
foreach my $meas (@RawMeas) {
my $val = &objVal("$label\::$meas");
if (!defined $val) {
if (my $special = &objVal("$label\::${meas}_special_")) {
$val = $special;
} else {
$val = 'n/a';
}
} elsif ($meas =~ /\.price/) {
$val =~ s/(\d)(\d\d\d)$/$1,$2/;
} elsif ($meas =~ /hit\.ratio/) {
$val = sprintf('%.1f', $val);
} elsif ($meas =~ /\bsave\b/) {
$val = sprintf('%.1f', $val);
} elsif ($meas =~ /rptm/) {
$val = sprintf('%.2f', $val/1000);
} elsif ($meas =~ /time_till_first/) {
$val = sprintf('%.1f', $val/(60*1000));
} elsif ($meas =~ /cache.age/) {
$val = sprintf('%.1f', $val/(3600*1000));
} elsif ($meas =~ /\.rate/) {
$val = sprintf('%.0f', &roundVal($val));
} else {
$val = sprintf('%.0f', $val); # default case
}
$table .= '<td align=right>';
$table .= $val;
$table .= "</td>\n";
}
}
$table .= '</table>';
# &openSection('Summary');
my $localTable = $table;
$localTable =~ s|$MetaDir|..|g;
print($OFile "$localTable");
# &closeSection();
# stand-alone "include" file
my $IncFName = &FullOutFName($CmpName, 'execsum', '.inc');
my $IncFile = new FileHandle(">$IncFName");
print($IncFile $table);
undef $IncFile;
}
sub buildCfgSumTable {
my $pfx = "."; # "polyrep/$CmpName";
my $table = <<HTML;
<table border=1 cellpadding=1 cellspacing=1>
<tr bgcolor="#BBBBBB">
<th>Label</th>
<th>Full product name</th>
<th>Price<br><small>(US\$)</small></th>
<th>Avail<br>able</th>
<th>Cache units</th>
<th>CPUs<br><small>(n${ConfSep}MHz)</small></th>
<th>RAM<br><small>(MB)</small></th>
<th>Cache disks<br><small>(n${ConfSep}GB)</small></th>
<th>NICs<br><small>(n${ConfSep}Mbps)</small></th>
<th>Rack<br>Space<br><small>(RU)</small></th>
<th>Cache<br><small>(GB)</small></th>
<th>Software</th>
</tr>
HTML
foreach my $label (sort cmpLabelsAlph @Labels) {
$table .= sprintf(
'<tr><th align=left>%s</th>',
&benchRef($label, $MetaDir, 'conf.html'));
foreach my $meas (@CfgMeas) {
my $val = &objVal("$label\::$meas");
if (!defined $val) {
if (my $special = &objVal("$label\::${meas}_special_")) {
$val = $special;
} else {
$val = $meas =~ /\.space/ ? 'n/m' : 'n/a';
}
} elsif ($meas =~ /\.price/) {
$val =~ s/(\d)(\d\d\d)$/$1,$2/;
} elsif ($meas =~ /\.ram/) {
$val = sprintf('%d', $val/1024/1024);
} elsif ($meas =~ /\.bytes/) {
$val = sprintf('%d', $val/1024/1024/1024);
} elsif ($val =~ /\bx\b.*\@/) {
my @kinds = &splitKindVals($val);
$val = join('<br>', map {
sprintf("%d$ConfSep%02d", ${$_}[0], ${$_}[2])
} @kinds);
} elsif ($val =~ /^"(.*)"$/) {
$val = $1;
$val = "<small>$val</small>" if $meas =~ /human_name|software/;
} else {
$val = sprintf('%.0f', $val); # default case
}
$table .= $val =~ /^\d/ ? '<td align=right>' : '<td align=center>';
$table .= $val;
$table .= "</td>\n";
}
}
$table .= '</table>';
# &openSection('Configuration');
my $localTable = $table;
$localTable =~ s|$MetaDir|..|g;
print($OFile "$localTable");
# &closeSection();
# stand-alone "include" file
my $IncFName = &FullOutFName($CmpName, 'config.all', '.inc');
my $IncFile = new FileHandle(">$IncFName");
print($IncFile $table);
undef $IncFile;
}
sub buildComments {
my $fname = &FullOutFName($CmpName, 'comments.all', '.inc');
my $f = new FileHandle(">$fname");
foreach my $label (sort cmpLabelsAlph @Labels) {
&curLabel($label);
my $vname = &substNamesInHTML('[vendor.comments.label||human_label]');
$vname =~ s/^"|"$//g;
my $url = &objVal('vendor.comments.url') || '';
$url =~ s/^"|"$//g;
my $urlImage = $url;
my $h = $url;
$h =~ s|^[^/]+//||;
$urlImage =~ $h unless $h =~ m|/.|;
$urlImage =~ s|/$|| unless $h =~ m|/.|;
my $comments = &objBody('vendor.comments.text');
next unless defined $comments;
$comments =~ s/^"|"$//g;
$comments =~ s|^\s*$|</p><p>|mg;
# $comments = sprintf('TBA (%d)', length($comments));
$f->print("\n\n<!-- $label -->\n");
$f->printf('<h5>%s<br><a href="%s"><em>%s</em></a></h5>',
$vname, $url, $urlImage);
$f->printf('<blockquote><p>%s</p></blockquote>', $comments);
&curLabel(undef());
}
$f->close();
}
sub buildRawSumTable {
warn("$0: building tmp exchange file: $TmpFName\n");
my $TmpFile = new FileHandle(">$TmpFName");
# create header for temporary data file
print($TmpFile '#label');
foreach my $meas (@RawMeasAll) {
print($TmpFile " $meas");
}
print($TmpFile " human_name\n");
# dump table rows
foreach my $label (@Labels) {
# skip unless rep.rate is known (skip failed entries)
next unless defined &objVal("$label\::rep.rate");
print($TmpFile $label);
foreach my $meas (@RawMeasAll) {
my $val = &objVal("$label\::$meas");
if (defined $val) {
$val /= 60*1000 if $meas =~ /time_till_first/;
$val /= 3600*1000 if $meas =~ /^cache\.age/;
printf($TmpFile "\t %.2f", $val);
} else {
printf($TmpFile "\t ?");
}
}
my $hlabel = &label2hlabel($label);
printf($TmpFile "\t \"%s\"", $hlabel);
print($TmpFile "\n");
}
undef $TmpFile;
}
sub buildMetaFiles {
my $mf = &openMetaFile('index.html', 'Tested Products');
my $fmd = &FullDir($MetaDir);
my $fad = &FullDir($CmpName);
&System("cp -pr $fad $fmd/") == 0 or die($!);
$mf->printf('<p>Auto-generated graphs and tables comparing all tested'.
' products side-by-side are <a href="all/">available</a>.'.
' Below are links to individual product pages.</p>');
$mf->print("<blockquote><table border=0 cellpadding=3>\n");
foreach my $label (@Labels) {
my $bdir = &benchMetaDir($label);
my $fbd = &FullDir($label);
&System("rm -rf $fmd/$bdir");
&System("cp -pr $fbd $fmd/$bdir");
&buildBenchMetas($label);
$mf->printf("<tr><td><b><b>%s</b></td><td>%s</td><td>%s</td><td>%s</td></tr>\n",
&benchRef($label), &cardRef($label), &sheetRef($label), &confRef($label));
}
$mf->print("</table></blockquote>\n");
&closeMetaFile($mf);
&buildGraphPairMetas();
}
sub buildGraphPairMetas {
while (my ($name, $title) = each %MetaGraphs) {
my $mf = &openMetaFile("$CmpName/$name.html", $title);
my $fmt = '<center><img src="%s.png" alt="%s"></center>';
$mf->printf($fmt, $name, $title);
$mf->printf($fmt, "$name.by-meas", $title);
&closeMetaFile($mf);
}
}
sub buildBenchMetas {
my $label = shift;
&buildBenchIndex($label);
&buildBenchConf($label);
}
sub buildBenchIndex {
my $label = shift;
my $hlabel = label2hlabel($label);
my $fmd = &FullDir($MetaDir);
my $bdir = &benchMetaDir($label);
my $idx = &openMetaFile("$bdir/index.html", $hlabel);
$idx->print("<p>The following information is available about $hlabel:");
$idx->printf("<ul><li>%s, <li>%s, and <li>%s</ul></p>\n",
'<a href="card/">2-page auto-generated performance card</a>',
'<a href="sheet/">detailed auto-generated performance sheet</a>',
'<a href="conf.html">entry configuration details</a>');
&closeMetaFile($idx);
}
sub buildBenchConf {
my $label = shift;
&curLabel($label);
my $hlabel = label2hlabel($label);
my $fmd = &FullDir($MetaDir);
my $bdir = &benchMetaDir($label);
my $conf = &openMetaFile("$bdir/conf.html", $hlabel);
my $html = '';
$html .= "<h2>$hlabel</h2>\n";
$html .= "<table border=1 cellpadding=3>\n";
$html .= "<tr bgcolor=#BBBBBB><th>Component</th><th>Price (US\$)</th></tr>\n";
my ($val, $n, $kind, $major, $minor);
# cache config
$html .= "<tr><td><p>[human_name]:<ul>\n";
$html .= "<li>[cache.units#%d] cache unit(s)\n";
$val = &objVal("cache.cpus");
foreach my $k (&splitKindVals($val)) {
($n, $kind, $major) = @{$k};
$html .= sprintf("<li>(%d) %s %dMHz CPU\n",
$n, $kind, $major);
}
$val = &objVal("cache.nics");
foreach my $k (&splitKindVals($val)) {
($n, $kind, $major, $minor) = @{$k};
$html .= sprintf("<li>(%d) %s %dMbps NIC\n",
$n, $kind, $major);
}
$val = &objVal("cache.disks");
foreach my $k (&splitKindVals($val)) {
($n, $kind, $major, $minor) = @{$k};
$html .= sprintf("<li>(%d) %s %dRPM %.1fGB disk\n",
$n, $kind, $minor, $major);
}
$html .= "<li>[int(cache.ram/1024/1024)#%d]MB RAM\n";
$html .= "<li>Software: [cache.software]\n";
$html .= &freeText2Html('cache.comments');
$html .= "</ul></td><td align=right valign=top>[cache.price || cache.price_special_]</td></tr>";
# netgear
$html .= sprintf("<tr><td><p>Network gear:<ul>%s</ul></td>",
&freeText2Html('netgear.comments'));
$html .= "<td align=right valign=top>[netgear.price]</td></tr>\n";
# total
$html .= "<tr><td>Total:</td><td align=right><b>[product.price || product.price_special_]</b></td></tr>\n";
$html .= "</table></p>\n";
# config changes
if (my $changes = &freeText2Html('product.changes')) {
$html .= '<p>According to the participant, the following changes were applied to the configuration above:';
$html .= "<ul>$changes</ul></p>\n";
} else {
$html .= '<p>According to the participant, no changes were applied to the configuration above.</p>';
}
if (my $pic = &objVal('cache.image.fname')) {
$pic =~ s/^"|"$//g;
my $dir = '../../pics';
$html .= sprintf(
'<p><a href="%s/%s"><img border=0 src="%s/reduced/%s" alt="a picture taken during the tests"></a></p>',
$dir, $pic,
$dir, $pic);
}
$conf->print(&substNamesInHTML($html));
&closeMetaFile($conf);
&curLabel(undef());
}
sub openMetaFile {
my ($fname, $title) = @_;
$fname = &FullOutFName($MetaDir, $fname);
my $mf = new FileHandle(">$fname") or die("cannot open `$fname': $!; stopped");
$mf->printf("<html><head><title>%s</title></head>\n", $title);
$mf->print("<body bgcolor=\"#FFFFFF\">\n");
warn("meta-file: file:$fname\n");
return $mf;
}
sub closeMetaFile {
my $mf = shift;
$mf->print("</body></html>\n");
$mf->close();
}
sub benchHref {
my ($label, $level, $fname) = @_;
die("$level, $label, $fname") unless defined $label;
$level = '.' unless defined $level;
$fname = 'index.html' unless defined $fname;
return sprintf('%s/%s/%s', $level, &benchMetaDir($label), $fname);
}
sub benchRef {
my ($label, $level, $fname) = @_;
die("$level, $label, $fname") unless defined $label;
$level = '.' unless defined $level;
$fname = 'index.html' unless defined $fname;
return sprintf('<a href="%s">%s</a>', benchHref(@_), &label2hlabel($label));
}
sub cardRef {
my ($label, $level, $text) = @_;
die("$level, $label, $text") unless defined $label;
$level = '.' unless defined $level;
my $res = '';
$res .= '[ ' unless defined $text;
$res .= sprintf('<a href="%s/%s/card/">%s</a>',
$level, &benchMetaDir($label),
defined $text ? $text : 'card');
$res .= ' ]' unless defined $text;
return $res;
}
sub sheetRef {
my ($label, $level, $text) = @_;
die("$level, $label, $text") unless defined $label;
$level = '.' unless defined $level;
my $res = '';
$res .= '[ ' unless defined $text;
$res .= sprintf('<a href="%s/%s/sheet/">%s</a>',
$level, &benchMetaDir($label),
defined $text ? $text : 'sheet');
$res .= ' ]' unless defined $text;
return $res;
}
sub confRef {
my ($label, $level, $text) = @_;
die("$level, $label, $text") unless defined $label;
$level = '.' unless defined $level;
my $res = '';
$res .= '[ ' unless defined $text;
$res .= sprintf('<a href="%s/%s/%s">%s</a>',
$level, &benchMetaDir($label), 'conf.html',
defined $text ? $text : 'conf');
$res .= ' ]' unless defined $text;
return $res;
}
sub benchMetaDir {
my $label = shift;
my ($bdir) = ($label =~ /^(b\d+)/);
return $bdir if defined $bdir;
my ($dir) = ($label =~ m|([^/]+)$|);
return $dir if defined $dir;
return $label;
}
sub plotGraphs {
while (my ($name, $title) = each %MetaGraphs) {
&plotGraph($name, $title);
}
}
sub plotGraph {
my ($meas, $title) = @_;
my $options = $Opts{table_plotter_opts};
$options = '' unless defined $options;
# &openSection($title);
my $fname = &callPlotter($meas, $title);
my $sortedFName = &callPlotter($meas, $title, $meas);
printf($OFile '<a href="%s"><img src="%s"></a></p>',
$fname, $sortedFName);
# &closeSection();
}
sub callPlotter {
my ($meas, $title, $order) = @_;
my $options = $Opts{table_plotter_opts};
$options = '' unless defined $options;
my $fname = "$meas";
$fname .= '.by-meas' if defined $order;
$fname .= '.png';
my $sortOpt = defined $order ? "--sort_by $order" : '';
my $fullFName = &FullOutFName($CmpName, $fname);
&System(sprintf('%s %s --out_name %s --plot_title "%s" %s %s %s',
$Opts{table_plotter},
$options,
$fullFName,
$title,
$sortOpt,
$meas,
$TmpFName));
return $fname;
}
sub addMoreObjects() {
&defineObj('product.price', 'cache.price + netgear.price');
&defineObj('nopxy.rptm.mean', '2800');
&defineObj('rep.rptm.mean.save', 'nopxy.rptm.mean - rep.rptm.mean');
&defineObj('rep.rptm.mean.save.ratio', '100*rep.rptm.mean.save/nopxy.rptm.mean');
&defineObj('rep.rate_price.ratio', '1000*rep.rate/product.price');
&defineObj('hit.rate_price.ratio', '1000*hit.rate/product.price');
&defineObj('cache.age.max', 'cache.size.bytes/fill.bw*1000');
&defineObj('rep.rate_rack.space.ratio', 'rep.rate/cache.rack.space');
&defineObj('hit.rate_rack.space.ratio', 'hit.rate/cache.rack.space');
}
sub cmpLabelsAlph($$) {
my $l1 = uc(&label2hlabel($a));
my $l2 = uc(&label2hlabel($b));
# make sure that all numbers are long enough to compare alphabetically
$l1 =~ s/(\d+)/sprintf('%010d', $1)/eg;
$l2 =~ s/(\d+)/sprintf('%010d', $1)/eg;
return $l1 cmp $l2;
# my @l1 = split(/-/, uc(&label2hlabel($a)));
# my @l2 = split(/-/, uc(&label2hlabel($b)));
# while (@l1 && @l2) {
# my $l1 = shift @l1;
# my $l2 = shift @l2;
# if ($l1 =~ /^\d/)
# }
# return uc(&label2hlabel($a)) cmp uc(&label2hlabel($b));
}
sub splitKindVals {
my $val = shift;
return () unless defined $val;
my @res = ();
my @kinds = split(/\s*,+\s*/, $val);
foreach my $kind (@kinds) {
my ($n, $k, $major, $minor) =
($kind =~ /^"?(\d+)\s*x\s*(.*?)\s*\@\s*(\d+(?:\.\d*)?)\s*(?:\:\s*(\d+(?:\.\d*)?)\s*)?"?$/);
die("cannot parse `$val' as `n x kind @ major : minor, ...' value, stopped") unless
defined $major;
push @res, [$n, $k, $major, $minor];
}
return (@res);
}
sub roundVal {
my $val = shift;
my %fudges = (
1 => -1, 2 => -2, 4 => +1,
6 => -1, 8 => +2, 9 => +1,
);
return $val if $val < 100;
$val = int($val);
my $ldigit = $val - 10 * int($val / 10);
return $val unless defined $fudges{$ldigit};
return $val + $fudges{$ldigit};
}
sub init {
die(&usage()) unless &ParseOpts(\%Opts, \@Labels, @ARGV) && @Labels > 2;
$MetaDir = shift @Labels;
$CmpName = shift @Labels;
}
sub usage {
return "usage: $0 [options] <auto_dir> <comparison_name> <label> ...\n" . &Opts2Str(\%SavedOpts);
}
syntax highlighted by Code2HTML, v. 0.9.1