#!/usr/bin/perl
# HTML output for selftest
# Copyright (C) 2008 Jelmer Vernooij
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
package output::html;
use Exporter;
@ISA = qw(Exporter);
use strict;
use warnings;
use FindBin qw($RealBin);
use lib "$RealBin/..";
sub new($$$) {
my ($class, $dirname, $statistics) = @_;
my $self = {
dirname => $dirname,
active_test => undef,
local_statistics => {},
statistics => $statistics,
msg => "",
error_summary => {
skip => [],
expected_success => [],
unexpected_success => [],
expected_failure => [],
unexpected_failure => [],
skip_testsuites => [],
error => []
}
};
link("$RealBin/output/testresults.css", "$dirname/testresults.css");
open(INDEX, ">$dirname/index.html");
bless($self, $class);
$self->print_html_header("Samba Testsuite Run", *INDEX);
print INDEX "
\n";
}
sub print_html_footer($$)
{
my ($self, $fh) = @_;
print $fh "
\n";
print $fh "
\n";
print $fh "\n";
print $fh "\n";
}
sub output_msg($$);
sub start_testsuite($$)
{
my ($self, $name) = @_;
$self->{START_TIME} = $self->{last_time};
$self->{local_statistics} = {
success => 0,
skip => 0,
error => 0,
failure => 0
};
$self->{NAME} = $name;
$self->{HTMLFILE} = "$name.html";
$self->{HTMLFILE} =~ s/[:\t\n \/]/_/g;
open(TEST, ">$self->{dirname}/$self->{HTMLFILE}") or die("Unable to open $self->{HTMLFILE} for writing");
$self->print_html_header("Test Results for $name", *TEST);
print TEST "
Tests
\n";
print TEST "
\n";
}
sub control_msg($$)
{
my ($self, $output) = @_;
# Perhaps the CSS should hide this by default?
$self->{msg} .= "$output \n";
}
sub output_msg($$)
{
my ($self, $output) = @_;
unless (defined($self->{active_test})) {
if (defined($self->{NAME})) {
print TEST "$output ";
}
} else {
$self->{msg} .= "$output ";
}
}
sub end_testsuite($$$)
{
my ($self, $name, $result, $reason) = @_;
print TEST "
\n";
my $st = $self->{local_statistics};
if ($result eq "xfail") {
print INDEX "
";
} elsif ($result eq "success") {
print INDEX "
";
} else {
print INDEX "
";
}
my $l = 0;
if ($st->{success} > 0) {
print INDEX "$st->{success} ok";
$l++;
}
if ($st->{skip} > 0) {
print INDEX ", " if ($l);
print INDEX "$st->{skip} skipped";
$l++;
}
if ($st->{failure} > 0) {
print INDEX ", " if ($l);
print INDEX "$st->{failure} failures";
$l++;
}
if ($st->{error} > 0) {
print INDEX ", " if ($l);
print INDEX "$st->{error} errors";
$l++;
}
if ($l == 0) {
print INDEX uc($result);
}
print INDEX "
";
print INDEX "
\n";
$self->{NAME} = undef;
}
sub report_time($$)
{
my ($self, $time) = @_;
$self->{last_time} = $time;
}
sub start_test($$)
{
my ($self, $testname) = @_;
$self->{active_test} = $testname;
$self->{msg} = "";
}
sub end_test($$$$)
{
my ($self, $testname, $result, $unexpected, $reason) = @_;
print TEST "
";
$self->{local_statistics}->{$result}++;
my $track_class;
if ($result eq "skip") {
print TEST "