]>
Commit | Line | Data |
---|---|---|
b75a7d8f A |
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 "\">±"; | |
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 |