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
10use strict;
11
12use Dataset;
13
14my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
15my $outType = "HTML";
16my $html = "noName";
17my $inTable;
18my @headers;
19my @timetypes = ("mean per op", "error per op", "events", "per event");
20my %raw;
21my $current = "";
22my $exp = 0;
23my $mult = 1e9; #use nanoseconds
24my $perc = 100; #for percent
25my $printEvents = 0;
26my $legend = "<a name=\"Legend\">\n<h2>Table legend</h2></a><ul>";
27my $legendDone = 0;
28my %options;
29my $operationIs = "operation";
30my $eventIs = "event";
31
32sub startTest {
33  $current = shift;
34  $exp = 0;
35  outputData($current);
36}
37
38sub printLeg {
39  if(!$legendDone) {
40    my $message;
41    foreach $message (@_) {
42      $legend .= "<li>".$message."</li>\n";
43    }
44  }
45}
46
47sub 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
80sub 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
88sub 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
136sub closeTable {
137  if($inTable) {
138    undef $inTable;
139    print HTML "</tr>\n";
140    print HTML "</tbody>";
141    print HTML "</table>\n";
142  }
143}
144
145sub newRow {
146  if(!$inTable) {
147    startTable;
148  } else {
149    print HTML "</tr>\n";
150  }
151  print HTML "<tr>";
152}
153
154sub 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
174sub 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<!--
212body         { font-size: 10pt; font-family: sans-serif }
213th           { font-size: 10pt; border: 0 solid #000080; padding: 5 }
214th.testNameHeader { border-width: 1 }
215th.testName  { text-align: left; border-left-width: 1; border-right-width: 1;
216               border-bottom-width: 1 }
217th.source    { border-right-width: 1; border-bottom-width: 1 }
218th.sourceType { border-right-width: 1; border-top-width: 1; border-bottom-width: 1 }
219td           { font-size: 10pt; text-align: Right; border: 0 solid #000080; padding: 5 }
220td.string    { text-align: Left; border-bottom-width:1; border-right-width:1 }
221td.sepvalue  { border-bottom-width: 1; border-right-width: 1 }
222td.value     { border-bottom-width: 1 }
223td.worse     { color: #FF0000; font-weight: bold; border-bottom-width: 1 }
224td.error     { font-size: 75%; border-right-width: 1; border-bottom-width: 1 }
225td.errorLarge { font-size: 75%; color: #FF0000; font-weight: bold; border-right-width: 1;
226               border-bottom-width: 1 }
227A:link    { color: black; font-weight: normal; text-decoration: none}    /* unvisited links */
228A:visited { color: blue; font-weight: normal; text-decoration: none }   /* visited links   */
229A:hover   { color: red; font-weight: normal; text-decoration: none } /* user hovers     */
230A:active  { color: lime; font-weight: normal; text-decoration: none }   /* active links    */
231-->
232</style>
233   </HEAD>
234   <BODY bgcolor="#FFFFFF" LINK="#006666" VLINK="#000000">
235EOF
236    print HTML "<H1>$title</H1>\n";
237
238    #print HTML "<H2>$TESTCLASS</H2>\n";
239  }
240}
241
242sub 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>
253EOF
254    close(HTML) or die "Can't close $html: $!";
255  }
256}
257
258
259sub 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
315sub store {
316  $raw{$current}[$exp++] = [@_];
317}
318
319sub 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
3871;
388
389#eof
390