#!/usr/bin/perl
package output::html;
use Exporter;
@ISA = qw(Exporter);
use strict;
use warnings;
sub new($$$$) {
my ($class, $dirname, $statistics) = @_;
my $self = {
dirname => $dirname,
statistics => $statistics,
active_test => undef,
local_statistics => {},
msg => ""
};
link("selftest/output/testresults.css", "$dirname/testresults.css");
open(INDEX, ">$dirname/index.html");
print INDEX "\n";
print INDEX "\n";
print INDEX " Samba Testsuite Run\n";
print INDEX " \n";
print INDEX "\n";
print INDEX "\n";
print INDEX "
\n";
print INDEX "
Samba Testsuite Run
\n";
print INDEX "
\n";
print INDEX "
";
print INDEX "
\n";
print INDEX "
\n";
print INDEX "
Test
\n";
print INDEX "
Environment
\n";
print INDEX "
Result
\n";
print INDEX "
\n";
bless($self, $class);
}
sub output_msg($$$);
sub start_testsuite($$)
{
my ($self, $state) = @_;
$self->{local_statistics} = {
success => 0,
skip => 0,
error => 0,
failure => 0
};
$state->{HTMLFILE} = "$state->{NAME}.html";
$state->{HTMLFILE} =~ s/[:\t\n \/]/_/g;
open(TEST, ">$self->{dirname}/$state->{HTMLFILE}") or die("Unable to open $state->{HTMLFILE} for writing");
my $title = "Test Results for $state->{NAME}";
print TEST "\n";
print TEST "\n";
print TEST " $title\n";
print TEST " \n";
print TEST "\n";
print TEST "\n";
print TEST "
\n";
print TEST "
$title
\n";
print TEST "
\n";
print TEST "
\n";
}
sub control_msg($$$)
{
my ($self, $state, $output) = @_;
$self->{msg} .= "$output \n";
}
sub output_msg($$$)
{
my ($self, $state, $output) = @_;
unless (defined($self->{active_test})) {
print TEST "$output ";
} else {
$self->{msg} .= "$output ";
}
}
sub end_testsuite($$$$$)
{
my ($self, $state, $expected_ret, $ret, $envlog) = @_;
print TEST "
\n";
my $st = $self->{local_statistics};
if ($ret == $expected_ret) {
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) {
if ($ret == $expected_ret) {
print INDEX "OK";
} else {
print INDEX "FAIL";
}
}
print INDEX "
";
print INDEX "
\n";
}
sub start_test($$$)
{
my ($self, $state, $testname) = @_;
$self->{active_test} = $testname;
$self->{msg} = "";
}
sub end_test($$$$$$)
{
my ($self, $state, $testname, $result, $unexpected, $reason) = @_;
print TEST "
";
$self->{local_statistics}->{$result}++;
if ($result eq "skip") {
print TEST "
\n";
} elsif ($unexpected) {
print TEST "
\n";
} else {
print TEST "
\n";
}
print TEST "
$testname
\n";
print TEST $self->{msg};
if (defined($reason)) {
print TEST "
$reason
\n";
}
print TEST "
\n";
$self->{active_test} = undef;
}
sub summary($)
{
my ($self) = @_;
my $st = $self->{statistics};
print INDEX "
\n";
print INDEX "
Total
\n";
print INDEX "
\n";
if ($st->{SUITES_FAIL} == 0) {
print INDEX "
";
} else {
print INDEX "
";
}
print INDEX "$st->{TESTS_EXPECTED_OK} ok";
if ($st->{TESTS_UNEXPECTED_OK} > 0) {
print INDEX " ($st->{TESTS_UNEXPECTED_OK})";
}
print INDEX "
";
if ($st->{TESTS_SKIP} > 0) {
print INDEX ", $st->{TESTS_SKIP} skipped";
}
print INDEX ", $st->{TESTS_EXPECTED_FAIL} failures";
if ($st->{TESTS_UNEXPECTED_OK} > 0) {
print INDEX " ($st->{TESTS_UNEXPECTED_FAIL})";
}
if ($st->{TESTS_ERROR} > 0) {
print INDEX ", $st->{TESTS_ERROR} errors";
}
print INDEX "";
print INDEX "
\n";
print INDEX "
\n";
print INDEX "\n";
print INDEX "\n";
print INDEX "
\n";
print INDEX "\n";
print INDEX "\n";
close(INDEX);
}
sub missing_env($$$)
{
my ($self, $name, $envname) = @_;
print "FAIL: $name (ENV[$envname] not available!)\n";
}
sub skip_testsuite($$)
{
my ($self, $name) = @_;
print INDEX "