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