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