Skip to content

Commit 869b42b

Browse files
author
Geoffrey Broadwell
committed
Add html and html_snippet output formats
1 parent 0cb18fd commit 869b42b

File tree

1 file changed

+118
-7
lines changed

1 file changed

+118
-7
lines changed

‎bench

Lines changed: 118 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -184,7 +184,9 @@ my %TESTS = (
184184
],
185185
);
186186
my %FORMATTER = (
187-
text => \&summarize_results,
187+
text => \&summarize_results_text,
188+
html => \&summarize_results_html,
189+
html_snippet => \&summarize_results_html_snippet,
188190
);
189191

190192

@@ -357,7 +359,7 @@ sub compare_times {
357359
return \%relative;
358360
}
359361

360-
sub summarize_results {
362+
sub summarize_results_text {
361363
my ($times, $style) = @_;
362364

363365
$style = -t STDOUT
@@ -439,6 +441,110 @@ sub center {
439441
return $output;
440442
}
441443

444+
sub summarize_results_html {
445+
my ($times, $style) = @_;
446+
447+
# Default to including style in full HTML pages
448+
$style = 1
449+
if $style eq 'auto';
450+
451+
print <<'HEADER';
452+
<html>
453+
<head>
454+
<title>Perl Bench Summary</title>
455+
</head>
456+
457+
<body>
458+
HEADER
459+
460+
summarize_results_html_snippet($times, $style);
461+
462+
print <<'FOOTER';
463+
</body>
464+
</html>
465+
FOOTER
466+
}
467+
468+
sub summarize_results_html_snippet {
469+
my ($times, $style) = @_;
470+
my $html = '';
471+
472+
# Default to no style info if just generating an HTML snippet
473+
$style = 0
474+
if $style eq 'auto';
475+
476+
if ($style) {
477+
$html .= <<'CSS';
478+
<style type="text/css">
479+
bench_language { text-align: center; }
480+
bench_compiler { text-align: center; }
481+
bench_vm { text-align: center; }
482+
bench_time { text-align: right; font-family: monospace; }
483+
bench_no_time { text-align: right; font-family: monospace; }
484+
bench_good { text-align: right; font-family: monospace; color: green; }
485+
bench_bad { text-align: right; font-family: monospace; color: yellow; }
486+
bench_ugly { text-align: right; font-family: monospace; color: red; }
487+
bench_skip { text-align: right; font-family: monospace; color: red; }
488+
bench_fail { text-align: right; font-family: monospace; color: red; }
489+
</style>
490+
491+
CSS
492+
}
493+
494+
my @test_names = map { $_->{name} } @$times;
495+
my @perls = map { @{$COMPILERS{$_}} } @GROUPS;
496+
@perls = grep { $_->{enabled} } @perls;
497+
my @lang_names = map { $_->{language} } @perls;
498+
my @comp_names = map { $_->{compiler} } @perls;
499+
my @vm_names = map { $_->{vm} } @perls;
500+
501+
my %lang_count;
502+
$lang_count{$_}++ for @lang_names;
503+
my @langs = uniq @lang_names;
504+
505+
$html .= qq{<table class="bench_summary">\n};
506+
$html .= "<tr><th></th>\n" . join('' => map qq{ <th class="bench_language" colspan="$lang_count{$_}">$_</th>\n} => @langs) . "</tr>\n";
507+
$html .= "<tr><th></th>\n" . join('' => map qq{ <th class="bench_compiler">$_</th>\n} => @comp_names) . "</tr>\n";
508+
$html .= "<tr><th>TEST</th>\n" . join('' => map qq{ <th class="bench_vm">$_</th>\n} => @vm_names) . "</tr>\n";
509+
510+
for my $test (@$times) {
511+
$html .= "<tr><td>$test->{name}</td>\n";
512+
for my $perl (@perls) {
513+
my $name = $perl->{name};
514+
my $best = $test->{best}{$name};
515+
if (defined $best) {
516+
$html .= sprintf qq{ <td class="bench_time">%.3fs</td>\n}, $test->{best}{$name};
517+
}
518+
else {
519+
$html .= qq{ <td class="bench_no_time">--</td>\n};
520+
}
521+
}
522+
$html .= "</tr>\n";
523+
524+
$html .= "<tr><td></td>\n";
525+
for my $perl (@perls) {
526+
my $name = $perl->{name};
527+
my $rel = $test->{compare}{$name};
528+
if (defined $rel) {
529+
my $class = $rel < 2 ? 'bench_good' :
530+
$rel < 10 ? 'bench_bad' :
531+
'bench_ugly' ;
532+
$html .= sprintf qq{ <td class="$class">%.3fx</td>\n}, $rel;
533+
}
534+
else {
535+
my $is_skip = grep { $_ eq $name } @{$test->{conf}{skip} || []};
536+
my $class = $is_skip ? 'bench_skip' : 'bench_fail';
537+
my $message = $is_skip ? 'SKIP' : 'FAIL';
538+
$html .= qq{ <td class="$class">$message</td>\n};
539+
}
540+
}
541+
$html .= "</tr>\n";
542+
}
543+
$html .= "</table>\n";
544+
545+
print $html;
546+
}
547+
442548
443549
__END__
444550
@@ -449,7 +555,7 @@ bench -- Benchmark Perl-family compilers against each other
449555
450556
=head1 SYNOPSIS
451557
452-
bench [--help|-h|-?] [--man] [--format=text] [--style=0|1|auto]
558+
bench [--help|-h|-?] [--man] [--format=text|html|html_snippet] [--style=0|1|auto]
453559
454560
455561
=head1 DESCRIPTION
@@ -478,18 +584,23 @@ Get basic help for this program
478584
479585
Display this program's entire manpage
480586
481-
=item --format=text
587+
=item --format=text|html|html_snippet
482588
483-
Format the summary output in a particular format. The default is 'text',
484-
which outputs a text-rendered summary table, with ANSI coloring.
589+
Format the summary output in a particular format. The default is C<text>,
590+
which outputs a text-rendered summary table with ANSI coloring. HTML output
591+
is also available, either in full document form (C<html>), or just a snippet
592+
containing the summary table (C<html_snippet>).
485593
486594
=item --style=0|1|auto
487595
488596
Select whether style settings are included in the output. C<0> turns off
489597
style output, C<1> turns it on, and C<auto> (the default) tries to DWIM.
490598
For text output, this option selects whether ANSI color codes are used to
491599
highlight entries in the summary table; C<auto> turns on ANSI color whenever
492-
the output is a TTY.
600+
the output is a TTY. For HTML output, this determines whether a CSS style
601+
block is added to the HTML (element C<class> attributes are always output).
602+
C<auto> defaults to adding CSS to full HTML documents (format C<html>), and
603+
I<not> adding it to HTML snippets (format C<html_snippet>).
493604
494605
=back
495606

0 commit comments

Comments
 (0)