#!/usr/bin/perl package output::html; use Exporter; @ISA = qw(Exporter); use strict; sub new($$$$) { my ($class, $dirname, $statistics) = @_; my $self = { dirname => $dirname, statistics => $statistics, active_test => undef, msg => "" }; open(INDEX, ">$dirname/index.html"); print INDEX "\n"; print INDEX "\n"; print INDEX "\n"; print INDEX "\n"; $self->{INDEX} = *INDEX; 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}"); 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"; close(TEST); print {$self->{INDEX}} ""; if ($ret == $expected_ret) { print {$self->{INDEX}} ""; } else { print {$self->{INDEX}} ""; } print {$self->{INDEX}} "\n"; print {$self->{INDEX}} "\n"; } sub start_test($$$) { my ($self, $state, $testname) = @_; print TEST "

$testname

\n"; $self->{active_test} = $testname; $self->{msg} = ""; } sub end_test($$$$$) { my ($self, $state, $testname, $result, $unexpected) = @_; if ($result eq "skip") { print TEST "
\n"; } elsif ($unexpected) { print TEST "
\n"; } print TEST $self->{msg}; print TEST "
\n"; $self->{active_test} = undef; } sub summary($) { my ($self) = @_; print {$self->{INDEX}} "
TestEnvironmentResultDuration
{HTMLFILE}\">$state->{NAME}$state->{ENVNAME}OKFAIL" . (time() - $state->{START_TIME}) . "
\n"; print {$self->{INDEX}} "FAILED ($self->{statistics}->{TESTS_UNEXPECTED_FAIL} failures and $self->{statistics}->{TESTS_ERROR} errors in $self->{statistics}->{SUITES_FAIL} testsuites)\n"; print {$self->{INDEX}} "\n"; print {$self->{INDEX}} "\n"; } sub missing_env($$$) { my ($self, $name, $envname) = @_; print "FAIL: $name (ENV[$envname] not available!)\n"; } sub skip_testsuite($$) { my ($self, $name) = @_; print {$self->{INDEX}} "$nameN/ASKIPPEDN/A\n"; } 1;