ports//benchmarks/polygraph/work/polygraph-3.0.6/tools/ReportGen/make

#!/usr/bin/perl -w
require 5.003;
use strict;

# plots traces labeled with label_results
# see also: label_results, plot_traces

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 = (
	trace_plotter => undef(),
	trace_plotter_opts => undef(),
);
my %SavedOpts = %Opts;

my @BaseTypes = qw(
	hit miss
	ims.sc200 ims.sc304
	redired_req rep_to_redir
	cachable uncachable
	fill basic ims reload rep 
);


# globals

my @Labels;

&init();
exit(&main());


sub main {

	foreach my $label (@Labels) {
		makeCard($label);
	}

	return 0;
}

sub makeCard {
	my $label = &curLabel(shift);

	&clearObjects();

	my $stats = &ReadDbase(&FullInFName($label, "clt.All.lx"));
	&importObjects($stats);

	my $facts = &ReadDbase(&FullInFName($label, "facts.lx"), 'may fail');
	&importObjects($facts) if $facts;

	&checkObjects();
	
	my $fname = &FullOutFName("$label/card", 'index', '.html');
	my $hname = label2hname($label);
	&openReport($fname, $hname);

	&reportAggrStats();
	&reportTraces();
	#&reportDistrib();

	&closeReport();

	warn("$0: local report URL is file:$fname\n");

	&curLabel(undef());
}

sub reportAggrStats {

	print($OFile '<table colspacing=0 cellpadding=0><tr><td align="left">');
		&reportExSummary();
		print($OFile &substNamesInHTML('<small>Phases:  [name].</small></p>'));
		&reportTputAndHr();
	print($OFile '</td><td align="right">');
		&reportStreams();
	print($OFile '</td></tr></table>');
	&reportObjs();

	# print some warnings if needed
	my @wobjs = (&getWarnObjs());
	if (@wobjs) {
		print($OFile "<p><small>Potential <font color=\"#FF0000\">problems</font>:\n<ol>\n");
		foreach my $obj (@wobjs) {
			printf($OFile "\t<li><a name=\"%s\"></a>%s\n", 
				$obj->{warn_key}, $obj->{warn_txt}) if $obj->{warn_txt};
		}
		print($OFile "</ol></small>\n");
	}
	&reportErrors();
}

sub reportExSummary {
	my $html = <<HTML;

	<p>
	<table border=0 cellpadding=1 cellspacing=1>
	<!-- <tr bgcolor="#BBBBBB"><th>Metric</th><th colspan=2>Value</th></tr> -->

	<tr><td align=left>Throughput:</td><td width=33% align=right>[rep.rate]</td><td>rep/sec</td></tr>
	<tr><td align=left>Response time:</td><td align=right>[rep.rptm.mean]</td><td>msec</td></tr>
		<tr><td align=right>- misses:</td><td align=right>[miss.rptm.mean]</td><td>msec</td></tr>
		<tr><td align=right>- hits:</td><td align=right>[hit.rptm.mean]</td><td>msec</td></tr>
	<tr><td align=left>Hit Ratio:</td><td align=right>[hit.ratio.obj]</td><td>%</td></tr>
	<tr><td align=left>Errors:</td><td align=right>[err_xact.ratio]</td><td>%</td></tr>
	<tr><td align=left>Duration:</td><td align=right>[duration/3600]</td><td>hour</td></tr>

	</table></p>
HTML

	print($OFile &substNamesInHTML($html));
}

sub reportTputAndHr {

	my $html = <<TABLE;
		<p>
		<table border=1 cellpadding=1 cellspacing=1>
		<tr bgcolor="#BBBBBB">
			<th rowspan=2>&nbsp;</th>
			<th colspan=2>Load</th>
			<th colspan=2>Hit Ratios</th>
		</tr>
		<tr bgcolor="#BBBBBB">
			<th>Count<br>(xact/sec)</th>
			<th>Volume<br>(Mbit/sec)</th>
			<th>DHR<br>(%)</th>
			<th>BHR<br>(%)</th>
		</tr>
	
		<tr><td align=left>Offered:</td>
			<td align=right>[req.rate]</td>
			<td align=right>[req.bw/$Mbit]</td>

			<td align=right>[offered.hit.ratio.obj]</td>
			<td align=right>[offered.hit.ratio.byte]</td>

		</tr>
		<tr><td align=left>Measured:</td>
			<td align=right>[rep.rate]</td>
			<td align=right>[rep.bw/$Mbit]</td>

			<td align=right>[hit.ratio.obj]</td>
			<td align=right>[hit.ratio.byte]</td>
		</tr>
TABLE

	if (&objVal('_have_icp_stats')) {
		$html .= <<TABLE;
			<tr><td align=left>ICP reqs:</td>
				<td align=right>[icp.req.rate]</td>
				<td align=right>[icp.req.bw/$Mbit]</td>
				<td align=right>&nbsp;</td>
				<td align=right>&nbsp;</td>
			</tr>
			<tr><td align=left>ICP reps:</td>
				<td align=right>[icp.rep.rate]</td>
				<td align=right>[icp.rep.bw/$Mbit]</td>

				<td align=right>[icp.hit.ratio.obj]</td>
				<td align=right>[icp.hit.ratio.byte]</td>
			</tr>
TABLE
	}

	$html .= <<TABLE;
		</table></p>
TABLE
	print($OFile &smallTable(&substNamesInHTML($html)));
}

sub reportChb {

	my $html = <<TABLE;
		<p>
		<table border=1 cellpadding=1 cellspacing=1>
		<tr bgcolor="#BBBBBB">
			<th>Cachability Ratios</th>
			<th>Count<br>(%)</th>
			<th>Volume<br>(%)</th>
		</tr>
	
		<tr><td align=left>Measured:</td>
			<td align=right>[cachable.ratio.obj]</td>
			<td align=right>[cachable.ratio.byte]</td>
		</tr>
	
		</table></p>
TABLE
	print($OFile &smallTable(&substNamesInHTML($html)));
}

sub reportObjs {

	my @types = @BaseTypes;

	my $html = '';
	$html .= <<TABLE;
		<p>
		<table border=1 cellpadding=1 cellspacing=1>
		<tr bgcolor="#BBBBBB">
			<th rowspan=2>Object Class</th>
			<th colspan=2>Contribution (%)</th>
			<th colspan=4>Response Time (msec)</th>
			<th colspan=4>Size (KB)</th>
		</tr>
		<tr bgcolor="#BBBBBB">
			<th>Count</th>
			<th>Volume</th>

			<th>Min</th>
			<th>Median</th>
			<th>Mean</th>
			<th>Max</th>

			<th>Min</th>
			<th>Median</th>
			<th>Mean</th>
			<th>Max</th>
		</tr>
TABLE
	
	foreach my $type (@types) {
		$html .= "<tr><td align=left>$type</td>\n";
		foreach my $meas (qw( obj byte )) {
			$html .= "\t<td align=right>[$type.ratio.$meas]</td>\n";
		}
		foreach my $meas (qw( min median mean max )) {
			$html .= "\t<td align=right>[$type.rptm.$meas]</td>\n";
		}
		foreach my $meas (qw( min median mean max )) {
			$html .= "\t<td align=right>[$type.size.$meas/1024]</td>\n";
		}
		$html .= "</tr>\n";
	}
	
	print($OFile &smallTable(&substNamesInHTML($html)));

	print $OFile <<TABLE;
		</table></p>
TABLE
}

sub reportStreams {
	my $html = <<TABLE;
		<p>
		<table border=1 cellpadding=1 cellspacing=1>
		<tr bgcolor="#BBBBBB">
			<th rowspan=2>Streams</th>
			<th colspan=2>Rates</th>
			<th colspan=2>Totals</th>
		</tr>
		
		<tr bgcolor="#BBBBBB">
			<th>Count<br>(rep/sec)</th>
			<th>Volume<br>(Mbit/sec)</th>
			<th>Count<br>(rep*10<sup><small>6</small></sup>)</th>
			<th>Volume<br>(GByte)</th>
		</tr>
TABLE

	my @types = @BaseTypes;
	push @types, map { "icp.$_" } qw ( hit miss rep ) if 
		&objVal('_have_icp_stats');

	for my $type (@types) {
		$html .= "
			<tr><td align=left>$type</td>
				<td align=right>[$type.rate]</td>
				<td align=right>[$type.bw/$Mbit]</td>

				<td align=right>[$type.size.count/1e6]</td>
				<td align=right>[$type.size.sum/$GByte]</td>
			</tr>\n";
	}

	$html .= '</table></p>';

	print($OFile &smallTable(&substNamesInHTML($html)));
}


sub reportErrors {
	if (&objVal('_have_icp_stats')) {
		
		print($OFile &substNamesInHTML(
			"<p>ICP timeouts: [icp.timeout.count]".
			" ([icp.timeout.ratio]% of all ICP requests)</p>\n"
		));
	}

	# print errors table
	my $tbl = &getTable('errors.tbl');
	if (defined $tbl) {
		my $lines = $tbl->{lines};
		if ($lines && @{$lines}) {
			print($OFile '<blockquote><pre><small>');
			foreach my $line (@{$lines}) {
				print($OFile $line);
			}
			print($OFile "</small></pre></blockquote>\n");
		}
	}
}

sub checkObjects {
	my $diffp;

	$diffp = 2;
	if (&exprDiffer('rep.rate', 'req.rate', \$diffp)) {
		&setWarn('rep.rate', 'suspecious reply rate',
			"Reply rate ([rep.rate]/sec) differs from the request rate 
			 ([req.rate]/sec) by <b>[$diffp]%</b>.");
	}

	$diffp = 3;
	if (&exprDiffer('hit.ratio.obj', 'offered.hit.ratio.obj', \$diffp)) {
		&setWarn('hit.ratio.obj', 'suspecious DHR',
			"Measured document hit ratio ([hit.ratio.obj]%) differs 
			from the offered DHR ([offered.hit.ratio.obj]%) 
			by <b>[$diffp]%</b>.");
	}

	$diffp = 5;
	if (&exprDiffer('hit.ratio.byte', 'offered.hit.ratio.byte', \$diffp)) {
		&setWarn('hit.ratio.byte', 'suspecious BHR',
			"Measured byte hit ratio ([hit.ratio.byte]%) differs 
			from the offered BHR ([offered.hit.ratio.byte]%) 
			by <b>[$diffp]%</b>.");
	}

	$diffp = 10;
	if (&exprDiffer('hit.rptm.mean', 'miss.rptm.mean', \$diffp) && $diffp > 0) {
		&setWarn('hit.rptm.mean', 'hit rptm too high',
			"Hit response time ([hit.rptm.mean]s msec) is 
			<b>[$diffp]%</b> higher than miss response time 
			([miss.rptm.mean] msec).");
	}

#	$diffp = 0.01;
#	my $wr = '100*wait.started/xact.started';
#	if (&computeExpr("$wr > $diffp")) {
#		&setWarn('wait.started', 'too many queued requests',
#			"Quite a few ([$wr]% > $diffp%) requests 
#			got queued waiting for resources.");
#	}

	$diffp = 0.1;
	if (&checkObj('err_xact.ratio') && &objVal('err_xact.ratio') > $diffp) {
		&setWarn('err_xact.ratio', 'too many errors',
			"Error ratio ([err_xact.ratio]%) exceeds [$diffp]%.");
	}

	my $minDur = 20*60;
	if (checkObj('duration') && &objVal('duration') < $minDur) {
		&setWarn('duration', 'too small sample',
			"Experiment duration ([duration/60] minutes) is less than
			[$minDur] minutes and may be too short.");
	}
}

sub reportTraces {
	&traceSmth('rates', [qw( req.rate rep.rate )]);
	&traceSmth('rptms', [qw( miss.rptm.mean rep.rptm.mean hit.rptm.mean )]);
	&traceSmth('ratios',   [qw( cachable.ratio.obj offered.hit.ratio.obj hit.ratio.obj )]);
	&traceSmth('xact_lvl', [qw( xact.level.mean wait.level.mean )]);
	&traceSmth('errors',[qw( err_xact.ratio err_xact.count )]);
}

sub traceSmth {
	my ($name, $objects, $options) = @_;
	$options = $Opts{trace_plotter_opts} unless defined $options;
	$options = '' unless defined $options;
	$options .= ' --plot_size 1,0.33' unless index('--plot_size ', $options) >= 0;

	my $fname = "$name.png";
	my $label = &curLabel();
	my $fullFName = &FullOutFName("$label/card", $fname);
	&System(sprintf("%s %s --out_name %s %s",
		$Opts{trace_plotter},
		$options,
		$fullFName,
		join(' ', map { "$label:$_" } @{$objects})));

	printf($OFile '<br><br><img src="%s">', $fname);
}

sub smallTable {
	my $txt = shift;
	$txt =~ s|<td[^>]*>|$&<small>|g;
	$txt =~ s|<th[^>]*>|$&<small>|g;
	$txt =~ s|</td[^>]*>|</small>$&|g;
	$txt =~ s|</th[^>]*>|</small>$&|g;
	return $txt;
}

sub init {
	die(&usage()) unless &ParseOpts(\%Opts, \@Labels, @ARGV) && @Labels;
}

sub usage {
	return "usage: $0 [options] <label> ...\n" . &Opts2Str(\%SavedOpts);
}
syntax highlighted by Code2HTML, v. 0.9.1