#!/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,
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 "
Duration
\n";
print INDEX "
\n";
bless($self, $class);
}
sub output_msg($$$);
sub start_testsuite($$)
{
my ($self, $state) = @_;
$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 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";
print TEST "\n";
print TEST "\n";
close(TEST);
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) = @_;
print TEST "
";
if ($result eq "skip") {
print TEST "
\n";
} elsif ($unexpected) {
print TEST "
\n";
} else {
print TEST "
\n";
}
print TEST "
$testname
\n";
print TEST $self->{msg};
print TEST "
\n";
$self->{active_test} = undef;
}
sub summary($)
{
my ($self) = @_;
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 "