source/test/perf/perldriver/Output.pm - external/github.com/unicode-org/icu - Git at Google

 #!/usr/local/bin/perl

 #  ********************************************************************
 #  * COPYRIGHT:
 #  * Copyright (c) 2002, International Business Machines Corporation and
 #  * others. All Rights Reserved.
 #  ********************************************************************


 use strict;

 use Dataset;

 my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
 my $outType = "HTML";
 my $html = "noName";
 my $inTable;
 my @headers;
 my @timetypes = ("mean per op", "error per op", "events", "per event");
 my %raw;
 my $current = "";
 my $exp = 0;
 my $mult = 1e9; #use nanoseconds
 my $perc = 100; #for percent
 my $printEvents = 0;
 my $legend = "<a name=\"Legend\">\n<h2>Table legend</h2></a><ul>";
 my $legendDone = 0;
 my %options;
 my $operationIs = "operation";
 my $eventIs = "event";

 sub startTest {
   $current = shift;
   $exp = 0;
   outputData($current);
 }

 sub printLeg {
   if(!$legendDone) {
     my $message;
     foreach $message (@_) {
       $legend .= "<li>".$message."</li>\n";
     }
   }
 }

 sub startTable {
   #my $printEvents = shift;
   $inTable = 1;
   my $i;
   print HTML "<font size=3>";
   print HTML "<table $TABLEATTR>\n";
   if($#headers >= 0) {
     my ($header, $i);
     print HTML "<tr>";
     print HTML "<th><a href=\"#Test Name\">Test Name</a></th>";
     print HTML "<th><a href=\"#Ops\">Ops</a></th>";
     printLeg("<a name=\"Test Name\">Test Name</a> - name of the test as set by the test writer", "<a name=\"Ops\">Ops</a> - number of ".$operationIs."s per iteration");
     if(!$printEvents) {
       foreach $header (@headers) {
 	print HTML "<th><a href=\"#meanop $header\">$header<br>mean/op</a></th>";
 	print HTML "<th><a href=\"#errorop $header\">$header<br>error/op</a></th>";
 	printLeg("<a name=\"meanop $header\">$header mean/op</a> - mean time for $header per $operationIs");
 	printLeg("<a name=\"errorop $header\">$header error/op - error range for mean time");
       }
     }
     for $i (1 .. $#headers) {
       print HTML "<th><a href=\"#mean $i op\">ratio $i<br>mean/op</a></th>";
       print HTML "<th><a href=\"#error $i op\">ratio $i<br>error/op</a></th>";
       printLeg("<a name=\"mean $i op\">ratio $i mean/op</a> - ratio of per $operationIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
       printLeg("<a name=\"error $i op\">ratio $i error/op</a> - error range of the above value");
     }
     if($printEvents) {
       foreach $header (@headers) {
 	print HTML "<th><a href=\"#events $header\">$header<br>events</a></th>";
 	printLeg("<a name=\"events $header\">$header events</a> - number of ".$eventIs."s for $header per iteration");
       }
       foreach $header (@headers) {
 	print HTML "<th><a href=\"#mean ev $header\">$header<br>mean/ev</a></th>";
 	print HTML "<th><a href=\"#error ev $header\">$header<br>error/ev</a></th>";
 	printLeg("<a name=\"mean $header mean/op - mean time for $header per $eventIs");
 	printLeg("$header error/op - error range for mean time");
       }
       for $i (1 .. $#headers) {
 	print HTML "<th><a href=\"#mean $i ev\">ratio $i<br>mean/ev</a></th>";
 	print HTML "<th><a href=\"#error $i ev\">ratio $i<br>error/ev</a></th>";
 	printLeg("<a name=\"mean $i ev\">ratio $i mean/ev</a> - ratio of per $eventIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
 	printLeg("<a name=\"error $i ev\">ratio $i error/ev</a> - error range of the above value");
       }
     }


 #     foreach $i (@timetypes) {
 #       foreach $header (@headers) {
 # 	print HTML "<th>$header<br>$i</th>" unless ($i =~ /event/ && !$printEvents);
 #       }
 #     }
     print HTML "</tr>\n";
   }
   $legendDone = 1;
 }

 sub closeTable {
   if($inTable) {
     undef $inTable;
     print HTML "</tr>\n";
     print HTML "</table>\n";
     print HTML "</font>";
   }
 }

 sub newRow {
   if(!$inTable) {
     startTable;
   } else {
     print HTML "</tr>\n";
   }
   print HTML "<tr>";
 }

 sub outputData {
   if($inTable) {
     my $msg = shift;
     my $align = shift;
     print HTML "<td";
     if($align) {
       print HTML " align = $align>";
     } else {
       print HTML ">";
     }
     print HTML "$msg";
     print HTML "</td>";
   } else {
     my $message;
     foreach $message (@_) {
       print HTML "$message";
     }
   }
 }

 sub setupOutput {
   my $date = localtime;
   my $options = shift;
   %options = %{ $options };
   my $title = $options{ "title" };
   my $headers = $options{ "headers" };
   if($options{ "operationIs" }) {
     $operationIs = $options{ "operationIs" };
   }
   if($options{ "eventIs" }) {
     $eventIs = $options{ "eventIs" };
   }
   @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 <<EOF;
 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
    "http://www.w3.org/TR/html4/strict.dtd">
 <HTML>
    <HEAD>
       <TITLE>$title</TITLE>
 <!--
 <style>
 <!--
 td { text-align: "." }
 td:before { content: "$" }
 -->
 </style>
 -->
    </HEAD>
    <BODY>
 EOF
     print HTML "<H1>$title</H1>\n";

     #print HTML "<H2>$TESTCLASS</H2>\n";
   }
 }

 sub closeOutput {
   if($outType eq 'HTML') {
     if($inTable) {
       closeTable;
     }
     $legend .= "</ul>\n";
     print HTML $legend;
     printRaw();
     print HTML <<EOF;
    </BODY>
 </HTML>
 EOF
     close(HTML) or die "Can't close $html: $!";
   }
 }


 sub printRaw {
   print HTML "<h2>Raw data</h2>";
   my $key;
   my $i;
   my $j;
   my $k;
   print HTML "<table $TABLEATTR>\n";
   for $key (sort keys %raw) {
     my $printkey = $key;
     $printkey =~ s/\<br\>/ /;
     if($printEvents) {
       print HTML "<tr><td colspan = 7>$printkey</td></tr>\n"; # locale and data file
       print HTML "<tr><th>test name</th><th>interesting arguments</th><th>iterations</th><th>operations</th><th>mean time (ns)</th><th>error (ns)</th><th>events</th></tr>\n";
     } else {
       print HTML "<tr><td colspan = 6>$printkey</td></tr>\n"; # locale and data file
       print HTML "<tr><th>test name</th><th>interesting arguments</th><th>iterations</th><th>operations</th><th>mean time (ns)</th><th>error (ns)</th></tr>\n";
     }


     for $i ( $raw{$key} ) {
       print HTML "<tr>";
       for $j ( @$i ) {
 	my ($test, $args);
 	($test, $args) = split(/,/, shift(@$j));
 	print HTML "<td>".$test."</td>";
 	print HTML "<td>".$args."</td>";

 	#print HTML "<td>".shift(@$j)."</td>";
 	print HTML "<td align=\"right\">".shift(@$j)."</td>";
 	print HTML "<td align=\"right\">".shift(@$j)."</td>";
 	my @data = @{ shift(@$j) };
 # 	for $k (@data) {
 # 	  print HTML "$k, ";
 # 	}
 	my $ds = Dataset->new(@data);
 	print HTML "<td align=\"right\">".formatNumber(4, $mult, $ds->getMean)."</td><td align=\"right\">".formatNumber(4, $mult, $ds->getError)."</td>";
 	if($#{ $j } >= 0) {
 	  print HTML "<td align=\"right\">".shift(@$j)."</td>";
 	}
 	print HTML "</tr>\n";
       }
     }
 #    print HTML "<br>\n";
   }
 #  print %raw;
 }

 sub store {
   $raw{$current}[$exp++] = [@_];
 }

 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");
       $printEvents = 1;
       startTable;
     } else {
       debug("No events header\n");
       startTable;
     }
   }
   debug("No events: @noevents, $#noevents\n");

   my $j;

   # Finished one row of results. Outputting
   newRow;
   outputData($testName, "LEFT");
   #outputData($iterCount);
   outputData($noopers[0], "RIGHT");

   if(!$printEvents) {
     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(formatNumber(2, $mult, $perOperation->getMean), "RIGHT");
       outputData(formatNumber(2, $mult, $perOperation->getError), "RIGHT");
     }
   }
   my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noopers[0]);
   for $j ( 1 .. $#timedata ) {
     my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
     my $ratio = $baseLinePO->subtract($perOperation);
     $ratio = $ratio->divide($perOperation);
     outputData(formatPercent(2, $ratio->getMean), "RIGHT");
     outputData(formatPercent(2, $ratio->getError), "RIGHT");
   }
   if (@noevents) {
     for $j ( 0 .. $#timedata ) {
       outputData($noevents[$j], "RIGHT");
     }
     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(formatNumber(2, $mult, $perEvent->getMean), "RIGHT");
       outputData(formatNumber(2, $mult, $perEvent->getError), "RIGHT");
     }
     my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noevents[0]);
     for $j ( 1 .. $#timedata ) {
       my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per operation
       my $ratio = $baseLinePO->subtract($perOperation);
       $ratio = $ratio->divide($perOperation);
       outputData(formatPercent(2, $ratio->getMean), "RIGHT");
       outputData(formatPercent(2, $ratio->getError), "RIGHT");
     }
   }
 }


 1;

 #eof
	#!/usr/local/bin/perl

	# ********************************************************************
	# * COPYRIGHT:
	# * Copyright (c) 2002, International Business Machines Corporation and
	# * others. All Rights Reserved.
	# ********************************************************************


	use strict;

	use Dataset;

	my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
	my $outType = "HTML";
	my $html = "noName";
	my $inTable;
	my @headers;
	my @timetypes = ("mean per op", "error per op", "events", "per event");
	my %raw;
	my $current = "";
	my $exp = 0;
	my $mult = 1e9; #use nanoseconds
	my $perc = 100; #for percent
	my $printEvents = 0;
	my $legend = "<a name=\"Legend\">\n<h2>Table legend</h2></a><ul>";
	my $legendDone = 0;
	my %options;
	my $operationIs = "operation";
	my $eventIs = "event";

	sub startTest {
	$current = shift;
	$exp = 0;
	outputData($current);
	}

	sub printLeg {
	if(!$legendDone) {
	my $message;
	foreach $message (@_) {
	$legend .= "<li>".$message."</li>\n";
	}
	}
	}

	sub startTable {
	#my $printEvents = shift;
	$inTable = 1;
	my $i;
	print HTML "<font size=3>";
	print HTML "<table $TABLEATTR>\n";
	if($#headers >= 0) {
	my ($header, $i);
	print HTML "<tr>";
	print HTML "<th><a href=\"#Test Name\">Test Name</a></th>";
	print HTML "<th><a href=\"#Ops\">Ops</a></th>";
	printLeg("<a name=\"Test Name\">Test Name</a> - name of the test as set by the test writer", "<a name=\"Ops\">Ops</a> - number of ".$operationIs."s per iteration");
	if(!$printEvents) {
	foreach $header (@headers) {
	print HTML "<th><a href=\"#meanop $header\">$header<br>mean/op</a></th>";
	print HTML "<th><a href=\"#errorop $header\">$header<br>error/op</a></th>";
	printLeg("<a name=\"meanop $header\">$header mean/op</a> - mean time for $header per $operationIs");
	printLeg("<a name=\"errorop $header\">$header error/op - error range for mean time");
	}
	}
	for $i (1 .. $#headers) {
	print HTML "<th><a href=\"#mean $i op\">ratio $i<br>mean/op</a></th>";
	print HTML "<th><a href=\"#error $i op\">ratio $i<br>error/op</a></th>";
	printLeg("<a name=\"mean $i op\">ratio $i mean/op</a> - ratio of per $operationIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
	printLeg("<a name=\"error $i op\">ratio $i error/op</a> - error range of the above value");
	}
	if($printEvents) {
	foreach $header (@headers) {
	print HTML "<th><a href=\"#events $header\">$header<br>events</a></th>";
	printLeg("<a name=\"events $header\">$header events</a> - number of ".$eventIs."s for $header per iteration");
	}
	foreach $header (@headers) {
	print HTML "<th><a href=\"#mean ev $header\">$header<br>mean/ev</a></th>";
	print HTML "<th><a href=\"#error ev $header\">$header<br>error/ev</a></th>";
	printLeg("<a name=\"mean $header mean/op - mean time for $header per $eventIs");
	printLeg("$header error/op - error range for mean time");
	}
	for $i (1 .. $#headers) {
	print HTML "<th><a href=\"#mean $i ev\">ratio $i<br>mean/ev</a></th>";
	print HTML "<th><a href=\"#error $i ev\">ratio $i<br>error/ev</a></th>";
	printLeg("<a name=\"mean $i ev\">ratio $i mean/ev</a> - ratio of per $eventIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
	printLeg("<a name=\"error $i ev\">ratio $i error/ev</a> - error range of the above value");
	}
	}



	# foreach $i (@timetypes) {
	# foreach $header (@headers) {
	# print HTML "<th>$header<br>$i</th>" unless ($i =~ /event/ && !$printEvents);
	# }
	# }
	print HTML "</tr>\n";
	}
	$legendDone = 1;
	}

	sub closeTable {
	if($inTable) {
	undef $inTable;
	print HTML "</tr>\n";
	print HTML "</table>\n";
	print HTML "</font>";
	}
	}

	sub newRow {
	if(!$inTable) {
	startTable;
	} else {
	print HTML "</tr>\n";
	}
	print HTML "<tr>";
	}

	sub outputData {
	if($inTable) {
	my $msg = shift;
	my $align = shift;
	print HTML "<td";
	if($align) {
	print HTML " align = $align>";
	} else {
	print HTML ">";
	}
	print HTML "$msg";
	print HTML "</td>";
	} else {
	my $message;
	foreach $message (@_) {
	print HTML "$message";
	}
	}
	}

	sub setupOutput {
	my $date = localtime;
	my $options = shift;
	%options = %{ $options };
	my $title = $options{ "title" };
	my $headers = $options{ "headers" };
	if($options{ "operationIs" }) {
	$operationIs = $options{ "operationIs" };
	}
	if($options{ "eventIs" }) {
	$eventIs = $options{ "eventIs" };
	}
	@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 <<EOF;
	<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
	"http://www.w3.org/TR/html4/strict.dtd">
	<HTML>
	<HEAD>
	<TITLE>$title</TITLE>
	<!--
	<style>
	<!--
	td { text-align: "." }
	td:before { content: "$" }
	-->
	</style>
	-->
	</HEAD>
	<BODY>
	EOF
	print HTML "<H1>$title</H1>\n";

	#print HTML "<H2>$TESTCLASS</H2>\n";
	}
	}

	sub closeOutput {
	if($outType eq 'HTML') {
	if($inTable) {
	closeTable;
	}
	$legend .= "</ul>\n";
	print HTML $legend;
	printRaw();
	print HTML <<EOF;
	</BODY>
	</HTML>
	EOF
	close(HTML) or die "Can't close $html: $!";
	}
	}


	sub printRaw {
	print HTML "<h2>Raw data</h2>";
	my $key;
	my $i;
	my $j;
	my $k;
	print HTML "<table $TABLEATTR>\n";
	for $key (sort keys %raw) {
	my $printkey = $key;
	$printkey =~ s/\<br\>/ /;
	if($printEvents) {
	print HTML "<tr><td colspan = 7>$printkey</td></tr>\n"; # locale and data file
	print HTML "<tr><th>test name</th><th>interesting arguments</th><th>iterations</th><th>operations</th><th>mean time (ns)</th><th>error (ns)</th><th>events</th></tr>\n";
	} else {
	print HTML "<tr><td colspan = 6>$printkey</td></tr>\n"; # locale and data file
	print HTML "<tr><th>test name</th><th>interesting arguments</th><th>iterations</th><th>operations</th><th>mean time (ns)</th><th>error (ns)</th></tr>\n";
	}


	for $i ( $raw{$key} ) {
	print HTML "<tr>";
	for $j ( @$i ) {
	my ($test, $args);
	($test, $args) = split(/,/, shift(@$j));
	print HTML "<td>".$test."</td>";
	print HTML "<td>".$args."</td>";

	#print HTML "<td>".shift(@$j)."</td>";
	print HTML "<td align=\"right\">".shift(@$j)."</td>";
	print HTML "<td align=\"right\">".shift(@$j)."</td>";
	my @data = @{ shift(@$j) };
	# for $k (@data) {
	# print HTML "$k, ";
	# }
	my $ds = Dataset->new(@data);
	print HTML "<td align=\"right\">".formatNumber(4, $mult, $ds->getMean)."</td><td align=\"right\">".formatNumber(4, $mult, $ds->getError)."</td>";
	if($#{ $j } >= 0) {
	print HTML "<td align=\"right\">".shift(@$j)."</td>";
	}
	print HTML "</tr>\n";
	}
	}
	# print HTML "<br>\n";
	}
	# print %raw;
	}

	sub store {
	$raw{$current}[$exp++] = [@_];
	}

	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");
	$printEvents = 1;
	startTable;
	} else {
	debug("No events header\n");
	startTable;
	}
	}
	debug("No events: @noevents, $#noevents\n");

	my $j;

	# Finished one row of results. Outputting
	newRow;
	outputData($testName, "LEFT");
	#outputData($iterCount);
	outputData($noopers[0], "RIGHT");

	if(!$printEvents) {
	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(formatNumber(2, $mult, $perOperation->getMean), "RIGHT");
	outputData(formatNumber(2, $mult, $perOperation->getError), "RIGHT");
	}
	}
	my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noopers[0]);
	for $j ( 1 .. $#timedata ) {
	my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
	my $ratio = $baseLinePO->subtract($perOperation);
	$ratio = $ratio->divide($perOperation);
	outputData(formatPercent(2, $ratio->getMean), "RIGHT");
	outputData(formatPercent(2, $ratio->getError), "RIGHT");
	}
	if (@noevents) {
	for $j ( 0 .. $#timedata ) {
	outputData($noevents[$j], "RIGHT");
	}
	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(formatNumber(2, $mult, $perEvent->getMean), "RIGHT");
	outputData(formatNumber(2, $mult, $perEvent->getError), "RIGHT");
	}
	my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noevents[0]);
	for $j ( 1 .. $#timedata ) {
	my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per operation
	my $ratio = $baseLinePO->subtract($perOperation);
	$ratio = $ratio->divide($perOperation);
	outputData(formatPercent(2, $ratio->getMean), "RIGHT");
	outputData(formatPercent(2, $ratio->getError), "RIGHT");
	}
	}
	}


	1;

	#eof