Home | History | Annotate | Download | only in perldriver 
      1 #!/usr/local/bin/perl
      2 
      3 #  ********************************************************************
      4 #  * COPYRIGHT:
      5 #  * Copyright (c) 2002, International Business Machines Corporation and
      6 #  * others. All Rights Reserved.
      7 #  ********************************************************************
      8 
      9 
     10 use strict;
     11 
     12 use Dataset;
     13 
     14 my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
     15 my $outType = "HTML";
     16 my $html = "noName";
     17 my $inTable;
     18 my @headers;
     19 my @timetypes = ("mean per op", "error per op", "events", "per event");
     20 my %raw;
     21 my $current = "";
     22 my $exp = 0;
     23 my $mult = 1e9; #use nanoseconds
     24 my $perc = 100; #for percent
     25 my $printEvents = 0;
     26 my $legend = "<a name=\"Legend\">\n<h2>Table legend</h2></a><ul>";
     27 my $legendDone = 0;
     28 my %options;
     29 my $operationIs = "operation";
     30 my $eventIs = "event";
     31 
     32 sub startTest {
     33   $current = shift;
     34   $exp = 0;
     35   outputData($current);
     36 }
     37 
     38 sub printLeg {
     39   if(!$legendDone) {
     40     my $message;
     41     foreach $message (@_) {
     42       $legend .= "<li>".$message."</li>\n";
     43     }
     44   }
     45 }
     46 
     47 sub outputDist {
     48   my $value = shift;
     49   my $percent = shift;
     50   my $mean = $value->getMean;
     51   my $error = $value->getError;
     52   print HTML "<td class=\"";
     53   if($mean > 0) {
     54     print HTML "value";
     55   } else {
     56     print HTML "worse";
     57   }
     58   print HTML "\">";
     59   if($percent) {
     60     print HTML formatPercent(2, $mean);
     61   } else {
     62     print HTML formatNumber(2, $mult, $mean);
     63   }
     64   print HTML "</td>\n";  
     65   print HTML "<td class=\"";
     66   if((($error*$mult < 10)&&!$percent) || (($error<10)&&$percent)) {
     67     print HTML "error";
     68   } else {
     69     print HTML "errorLarge";
     70   }
     71   print HTML "\">&plusmn;";
     72   if($percent) {
     73     print HTML formatPercent(2, $error);
     74   } else {
     75     print HTML formatNumber(2, $mult, $error);
     76   }
     77   print HTML "</td>\n";  
     78 }
     79   
     80 sub outputValue {
     81   my $value = shift;
     82   print HTML "<td class=\"sepvalue\">";
     83   print HTML $value;
     84   #print HTML formatNumber(2, 1, $value);
     85   print HTML "</td>\n";  
     86 }
     87 
     88 sub startTable {
     89   #my $printEvents = shift;
     90   $inTable = 1;
     91   my $i;
     92   print HTML "<table $TABLEATTR>\n";
     93   print HTML "<tbody>\n";
     94   if($#headers >= 0) {
     95     my ($header, $i);
     96     print HTML "<tr>\n";
     97     print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#TestName\">Test Name</a></th>\n";
     98     print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#Ops\">Ops</a></th>\n";
     99     printLeg("<a name=\"Test Name\">TestName</a> - name of the test as set by the test writer\n", "<a name=\"Ops\">Ops</a> - number of ".$operationIs."s per iteration\n");
    100     if(!$printEvents) {
    101       print HTML "<th colspan=".((4*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
    102     } else {
    103       print HTML "<th colspan=".((2*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
    104       print HTML "<th colspan=".((5*($#headers+1))-2)." class=\"sourceType\">Per Event</th>\n";
    105     }
    106     print HTML "</tr>\n<tr>\n";
    107     if(!$printEvents) {
    108       foreach $header (@headers) {
    109 	print HTML "<th class=\"source\" colspan=2><a href=\"#meanop_$header\">$header<br>/op</a></th>\n";
    110 	printLeg("<a name=\"meanop_$header\">$header /op</a> - mean time and error for $header per $operationIs");
    111       }
    112     }
    113     for $i (1 .. $#headers) {
    114       print HTML "<th class=\"source\" colspan=2><a href=\"#mean_op_$i\">ratio $i<br>/op</a></th>\n";
    115       printLeg("<a name=\"mean_op_$i\">ratio $i /op</a> - ratio and error of per $operationIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
    116     }
    117     if($printEvents) {
    118       foreach $header (@headers) {
    119 	print HTML "<th class=\"source\"><a href=\"#events_$header\">$header<br>events</a></th>\n";
    120 	printLeg("<a name=\"events_$header\">$header events</a> - number of ".$eventIs."s for $header per iteration");
    121       }
    122       foreach $header (@headers) {
    123 	print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$header\">$header<br>/ev</a></th>\n";
    124 	printLeg("<a name=\"mean_ev_$header\">$header /ev</a> - mean time and error for $header per $eventIs");
    125       }
    126       for $i (1 .. $#headers) {
    127 	print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$i\">ratio $i<br>/ev</a></th>\n";
    128 	printLeg("<a name=\"mean_ev_$i\">ratio $i /ev</a> - ratio and error of per $eventIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
    129       }
    130     }
    131     print HTML "</tr>\n";
    132   }
    133   $legendDone = 1;
    134 }
    135 
    136 sub closeTable {
    137   if($inTable) {
    138     undef $inTable;
    139     print HTML "</tr>\n";
    140     print HTML "</tbody>";
    141     print HTML "</table>\n";
    142   }
    143 }
    144 
    145 sub newRow {
    146   if(!$inTable) {
    147     startTable;
    148   } else {
    149     print HTML "</tr>\n";
    150   }
    151   print HTML "<tr>";
    152 }
    153 
    154 sub outputData {
    155   if($inTable) {
    156     my $msg = shift;
    157     my $align = shift;
    158     print HTML "<td";
    159     if($align) {
    160       print HTML " align = $align>";
    161     } else {
    162       print HTML ">";
    163     }
    164     print HTML "$msg";
    165     print HTML "</td>";
    166   } else {
    167     my $message;
    168     foreach $message (@_) {
    169       print HTML "$message";
    170     }
    171   }
    172 }
    173 
    174 sub setupOutput {
    175   my $date = localtime;
    176   my $options = shift;
    177   %options = %{ $options };
    178   my $title = $options{ "title" };
    179   my $headers = $options{ "headers" };
    180   if($options{ "operationIs" }) {
    181     $operationIs = $options{ "operationIs" };
    182   }
    183   if($options{ "eventIs" }) {
    184     $eventIs = $options{ "eventIs" };
    185   }
    186   @headers = split(/ /, $headers);
    187   my ($t, $rest);
    188   ($t, $rest) = split(/\.\w+/, $0);
    189   $t =~ /^.*\W(\w+)$/;
    190   $t = $1;
    191   if($outType eq 'HTML') {
    192     $html = $date;
    193     $html =~ s/://g; # ':' illegal
    194     $html =~ s/\s*\d+$//; # delete year
    195     $html =~ s/^\w+\s*//; # delete dow
    196     $html = "$t $html.html";
    197     if($options{ "outputDir" }) {
    198       $html = $options{ "outputDir" }."/".$html;
    199     }
    200     $html =~ s/ /_/g;
    201 
    202     open(HTML,">$html") or die "Can't write to $html: $!";
    203 
    204 #<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
    205     print HTML <<EOF;
    206 <HTML>
    207    <HEAD>
    208    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
    209       <TITLE>$title</TITLE>
    210 <style>
    211 <!--
    212 body         { font-size: 10pt; font-family: sans-serif }
    213 th           { font-size: 10pt; border: 0 solid #000080; padding: 5 }
    214 th.testNameHeader { border-width: 1 }
    215 th.testName  { text-align: left; border-left-width: 1; border-right-width: 1; 
    216                border-bottom-width: 1 }
    217 th.source    { border-right-width: 1; border-bottom-width: 1 }
    218 th.sourceType { border-right-width: 1; border-top-width: 1; border-bottom-width: 1 }
    219 td           { font-size: 10pt; text-align: Right; border: 0 solid #000080; padding: 5 }
    220 td.string    { text-align: Left; border-bottom-width:1; border-right-width:1 }
    221 td.sepvalue  { border-bottom-width: 1; border-right-width: 1 }
    222 td.value     { border-bottom-width: 1 }
    223 td.worse     { color: #FF0000; font-weight: bold; border-bottom-width: 1 }
    224 td.error     { font-size: 75%; border-right-width: 1; border-bottom-width: 1 }
    225 td.errorLarge { font-size: 75%; color: #FF0000; font-weight: bold; border-right-width: 1; 
    226                border-bottom-width: 1 }
    227 A:link    { color: black; font-weight: normal; text-decoration: none}    /* unvisited links */
    228 A:visited { color: blue; font-weight: normal; text-decoration: none }   /* visited links   */
    229 A:hover   { color: red; font-weight: normal; text-decoration: none } /* user hovers     */
    230 A:active  { color: lime; font-weight: normal; text-decoration: none }   /* active links    */
    231 -->
    232 </style>
    233    </HEAD>
    234    <BODY bgcolor="#FFFFFF" LINK="#006666" VLINK="#000000">
    235 EOF
    236     print HTML "<H1>$title</H1>\n";
    237 
    238     #print HTML "<H2>$TESTCLASS</H2>\n";
    239   }
    240 }
    241 
    242 sub closeOutput {
    243   if($outType eq 'HTML') {
    244     if($inTable) {
    245       closeTable;
    246     }
    247     $legend .= "</ul>\n";
    248     print HTML $legend;
    249     outputRaw();
    250     print HTML <<EOF;
    251    </BODY>
    252 </HTML>
    253 EOF
    254     close(HTML) or die "Can't close $html: $!";
    255   }
    256 }
    257 
    258 
    259 sub outputRaw {
    260   print HTML "<h2>Raw data</h2>";
    261   my $key;
    262   my $i;
    263   my $j;
    264   my $k;
    265   print HTML "<table $TABLEATTR>\n";
    266   for $key (sort keys %raw) {
    267     my $printkey = $key;
    268     $printkey =~ s/\<br\>/ /g;
    269     if($printEvents) {
    270       if($key ne "") {
    271 	print HTML "<tr><th class=\"testNameHeader\" colspan = 7>$printkey</td></tr>\n"; # locale and data file
    272       }
    273       print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th><th class=\"testName\">events</th></tr>\n";
    274     } else {
    275       if($key ne "") {
    276 	print HTML "<tr><th class=\"testName\" colspan = 6>$printkey</td></tr>\n"; # locale and data file
    277       }
    278       print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th></tr>\n";
    279     }
    280     $printkey =~ s/[\<\>\/ ]//g;
    281       
    282     my %done;
    283     for $i ( $raw{$key} ) {
    284       print HTML "<tr>";
    285       for $j ( @$i ) {
    286 	my ($test, $args);
    287 	($test, $args) = split(/,/, shift(@$j));
    288 
    289 	print HTML "<th class=\"testName\">";
    290 	if(!$done{$test}) {
    291 	  print HTML "<a name=\"".$printkey."_".$test."\">".$test."</a>";
    292 	  $done{$test} = 1;
    293 	} else {
    294 	  print HTML $test;
    295 	}
    296 	print HTML "</th>";
    297 
    298 	print HTML "<td class=\"string\">".$args."</td>";
    299 	
    300 	print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
    301 	print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
    302 
    303 	my @data = @{ shift(@$j) };
    304 	my $ds = Dataset->new(@data);
    305 	print HTML "<td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getMean)."</td><td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getError)."</td>";
    306 	if($#{ $j } >= 0) {
    307 	  print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
    308 	}
    309 	print HTML "</tr>\n";
    310       }
    311     }
    312   }
    313 }
    314 
    315 sub store {
    316   $raw{$current}[$exp++] = [@_];
    317 }
    318 
    319 sub outputRow {
    320   #$raw{$current}[$exp++] =  [@_];
    321   my $testName = shift;
    322   my @iterPerPass = @{shift(@_)};
    323   my @noopers =  @{shift(@_)};
    324    my @timedata =  @{shift(@_)};
    325   my @noevents;
    326   if($#_ >= 0) {
    327     @noevents =  @{shift(@_)};
    328   }
    329   if(!$inTable) {
    330     if(@noevents) {
    331       $printEvents = 1;
    332       startTable;
    333     } else {
    334       startTable;
    335     }
    336   }
    337   debug("No events: @noevents, $#noevents\n");
    338 
    339   my $j;
    340   my $loc = $current;
    341   $loc =~ s/\<br\>/ /g;
    342   $loc =~ s/[\<\>\/ ]//g;
    343 
    344   # Finished one row of results. Outputting
    345   newRow;
    346   #outputData($testName, "LEFT");
    347   print HTML "<th class=\"testName\"><a href=\"#".$loc."_".$testName."\">$testName</a></th>\n";
    348   #outputData($iterCount);
    349   #outputData($noopers[0], "RIGHT");
    350   outputValue($noopers[0]);
    351 
    352   if(!$printEvents) {
    353     for $j ( 0 .. $#timedata ) {
    354       my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
    355       #debug("Time per operation: ".formatSeconds(4, $perOperation->getMean, $perOperation->getError)."\n");
    356       outputDist($perOperation);
    357     }
    358   }
    359   my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noopers[0]);
    360   for $j ( 1 .. $#timedata ) {
    361     my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
    362     my $ratio = $baseLinePO->subtract($perOperation);
    363     $ratio = $ratio->divide($perOperation);
    364     outputDist($ratio, "%");
    365   }   
    366   if (@noevents) {
    367     for $j ( 0 .. $#timedata ) {
    368       #outputData($noevents[$j], "RIGHT");
    369       outputValue($noevents[$j]);
    370     }
    371     for $j ( 0 .. $#timedata ) {
    372       my $perEvent =  $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per event
    373       #debug("Time per operation: ".formatSeconds(4, $perEvent->getMean, $perEvent->getError)."\n");
    374       outputDist($perEvent);
    375     }   
    376     my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noevents[0]);
    377     for $j ( 1 .. $#timedata ) {
    378       my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per operation
    379       my $ratio = $baseLinePO->subtract($perOperation);
    380       $ratio = $ratio->divide($perOperation);
    381       outputDist($ratio, "%");
    382     }   
    383   }
    384 }
    385 
    386 
    387 1;
    388 
    389 #eof
    390