source4/selftest/output/html.pm

   1 #!/usr/bin/perl
   2
   3 package output::html;
   4 use Exporter;
   5 @ISA = qw(Exporter);
   6
   7 use strict;
   8 use warnings;
   9
  10 sub new($$$$) {
  11         my ($class, $dirname, $statistics) = @_;
  12         my $self = {
  13                 dirname => $dirname,
  14                 statistics => $statistics,
  15                 active_test => undef,
  16                 local_statistics => {},
  17                 msg => ""
  18         };
  19
  20         link("selftest/output/testresults.css", "$dirname/testresults.css");
  21
  22         open(INDEX, ">$dirname/index.html");
  23
  24         print INDEX "<html lang=\"en\">\n";
  25         print INDEX "<head>\n";
  26         print INDEX "  <title>Samba Testsuite Run</title>\n";
  27         print INDEX "  <link rel=\"stylesheet\" type=\"text/css\" href=\"testresults.css\"/>\n";
  28         print INDEX "</head>\n";
  29         print INDEX "<body>\n";
  30         print INDEX "<table width=\"100%\" border=\"0\" cellspacing=\"0\">\n";
  31         print INDEX "  <tr><td class=\"title\">Samba Testsuite Run</td></tr>\n";
  32         print INDEX "  <tr><td>\n";
  33         print INDEX "  <center>";
  34         print INDEX "  <table>\n";
  35         print INDEX "  <tr>\n";
  36         print INDEX "    <td class=\"tableHead\">Test</td>\n";
  37         print INDEX "    <td class=\"tableHead\">Environment</td>\n";
  38         print INDEX "    <td class=\"tableHead\">Result</td>\n";
  39         print INDEX "  </tr>\n";
  40
  41         bless($self, $class);
  42 }
  43
  44 sub output_msg($$$);
  45
  46 sub start_testsuite($$)
  47 {
  48         my ($self, $state) = @_;
  49
  50         $self->{local_statistics} = {
  51                 success => 0,
  52                 skip => 0,
  53                 error => 0,
  54                 failure => 0
  55         };
  56
  57         $state->{HTMLFILE} = "$state->{NAME}.html";
  58         $state->{HTMLFILE} =~ s/[:\t\n \/]/_/g;
  59
  60         open(TEST, ">$self->{dirname}/$state->{HTMLFILE}") or die("Unable to open $state->{HTMLFILE} for writing");
  61
  62         my $title = "Test Results for $state->{NAME}";
  63
  64         print TEST "<html lang=\"en\">\n";
  65         print TEST "<head>\n";
  66         print TEST "  <title>$title</title>\n";
  67         print TEST "  <link rel=\"stylesheet\" type=\"text/css\" href=\"testresults.css\"/>\n";
  68         print TEST "</head>\n";
  69         print TEST "<body>\n";
  70         print TEST "<table width=\"100%\" border=\"0\" cellspacing=\"0\">\n";
  71         print TEST "  <tr><td class=\"title\">$title</td></tr>\n";
  72         print TEST "  <tr><td>\n";
  73         print TEST "  <table>\n";
  74 }
  75
  76 sub control_msg($$$)
  77 {
  78         my ($self, $state, $output) = @_;
  79
  80         $self->{msg} .=  "<span class=\"control\">$output<br/></span>\n";
  81 }
  82
  83 sub output_msg($$$)
  84 {
  85         my ($self, $state, $output) = @_;
  86
  87         unless (defined($self->{active_test})) {
  88                 print TEST "$output<br/>";
  89         } else {
  90                 $self->{msg} .= "$output<br/>";
  91         }
  92 }
  93
  94 sub end_testsuite($$$$$)
  95 {
  96         my ($self, $state, $expected_ret, $ret, $envlog) = @_;
  97
  98         print TEST "</table>\n";
  99
 100         print TEST "<div class=\"duration\">Duration: " . (time() - $state->{START_TIME}) . "s</div>\n";
 101         print TEST "</body>\n";
 102         print TEST "</html>\n";
 103
 104         close(TEST);
 105
 106         print INDEX "<tr>\n";
 107         print INDEX "  <td class=\"testSuite\"><a href=\"$state->{HTMLFILE}\">$state->{NAME}</a></td>\n";
 108         print INDEX "  <td class=\"environment\">$state->{ENVNAME}</td>\n";
 109         my $st = $self->{local_statistics};
 110
 111         if ($ret == $expected_ret) {
 112                 print INDEX "  <td class=\"resultOk\">";
 113         } else {
 114                 print INDEX "  <td class=\"resultFailure\">";
 115         }
 116
 117         my $l = 0;
 118         if ($st->{success} > 0) {
 119                 print INDEX "$st->{success} ok";
 120                 $l++;
 121         }
 122         if ($st->{skip} > 0) {
 123                 print INDEX ", " if ($l);
 124                 print INDEX "$st->{skip} skipped";
 125                 $l++;
 126         }
 127         if ($st->{failure} > 0) {
 128                 print INDEX ", " if ($l);
 129                 print INDEX "$st->{failure} failures";
 130                 $l++;
 131         }
 132         if ($st->{error} > 0) {
 133                 print INDEX ", " if ($l);
 134                 print INDEX "$st->{error} errors";
 135                 $l++;
 136         }
 137
 138         if ($l == 0) {
 139                 if ($ret == $expected_ret) {
 140                         print INDEX "OK";
 141                 } else {
 142                         print INDEX "FAIL";
 143                 }
 144         }
 145
 146         print INDEX "</td>";
 147
 148         print INDEX "</tr>\n";
 149 }
 150
 151 sub start_test($$$)
 152 {
 153         my ($self, $state, $testname) = @_;
 154
 155         $self->{active_test} = $testname;
 156         $self->{msg} = "";
 157 }
 158
 159 sub end_test($$$$$$)
 160 {
 161         my ($self, $state, $testname, $result, $unexpected, $reason) = @_;
 162
 163         print TEST "<tr>";
 164
 165         $self->{local_statistics}->{$result}++;
 166
 167         if ($result eq "skip") {
 168                 print TEST "<td class=\"outputSkipped\">\n";
 169         } elsif ($unexpected) {
 170                 print TEST "<td class=\"outputFailure\">\n";
 171         } else {
 172                 print TEST "<td class=\"outputOk\">\n";
 173         }
 174
 175         print TEST "<h3>$testname</h3>\n";
 176
 177         print TEST $self->{msg};
 178
 179         if (defined($reason)) {
 180                 print TEST "<div class=\"reason\">$reason</div>\n";
 181         }
 182
 183         print TEST "</td></tr>\n";
 184
 185         $self->{active_test} = undef;
 186 }
 187
 188 sub summary($)
 189 {
 190         my ($self) = @_;
 191
 192         my $st = $self->{statistics};
 193         print INDEX "<tr>\n";
 194         print INDEX "  <td class=\"testSuiteTotal\">Total</td>\n";
 195         print INDEX "  <td></td>\n";
 196
 197         if ($st->{SUITES_FAIL} == 0) {
 198                 print INDEX "  <td class=\"resultOk\">";
 199         } else {
 200                 print INDEX "  <td class=\"resultFailure\">";
 201         }
 202         print INDEX ($st->{TESTS_EXPECTED_OK} + $st->{TESTS_UNEXPECTED_OK}) + " ok";
 203         if ($st->{TESTS_UNEXPECTED_OK} > 0) {
 204                 print INDEX " ($st->{TESTS_UNEXPECTED_OK} unexpected)";
 205         }
 206         if ($st->{TESTS_SKIP} > 0) {
 207                 print INDEX ", $st->{TESTS_SKIP} skipped";
 208         }
 209         print INDEX ", " . ($st->{TESTS_UNEXPECTED_FAIL} + $st->{TESTS_EXPECTED_FAIL}) . " failures";
 210         if ($st->{TESTS_UNEXPECTED_OK} > 0) {
 211                 print INDEX " ($st->{TESTS_EXPECTED_FAIL} expected)";
 212         }
 213         if ($st->{TESTS_ERROR} > 0) {
 214                 print INDEX ", $st->{TESTS_ERROR} errors";
 215         }
 216
 217         print INDEX "</td>";
 218
 219         print INDEX "</tr>\n";
 220
 221         print INDEX "</table>\n";
 222         print INDEX "</center>\n";
 223         print INDEX "</td></tr>\n";
 224         print INDEX "</table>\n";
 225         print INDEX "</body>\n";
 226         print INDEX "</html>\n";
 227         close(INDEX);
 228 }
 229
 230 sub missing_env($$$)
 231 {
 232         my ($self, $name, $envname) = @_;
 233
 234         print INDEX "<tr>\n";
 235         print INDEX "  <td class=\"testSuite\">$name</td>\n";
 236         print INDEX "  <td class=\"resultSkipped\" colspan=\"2\">SKIPPED - environment `$envname` not available!</td>\n";
 237         print INDEX "</tr>\n";
 238 }
 239
 240 sub skip_testsuite($$)
 241 {
 242         my ($self, $name) = @_;
 243
 244         print INDEX "<tr>\n";
 245         print INDEX "  <td class=\"testSuite\">$name</td>\n";
 246         print INDEX "  <td class=\"resultSkipped\" colspan=\"2\">SKIPPED</td>\n";
 247         print INDEX "</tr>\n";
 248 }
 249
 250 1;