r24671: More improvements to the HTML test suite results: hide
[kai/samba.git] / 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} ok";
203         if ($st->{TESTS_UNEXPECTED_OK} > 0) {
204                 print INDEX " ($st->{TESTS_UNEXPECTED_OK})";
205         }
206         print INDEX "</td>";
207         if ($st->{TESTS_SKIP} > 0) {
208                 print INDEX ", $st->{TESTS_SKIP} skipped";
209         }
210         print INDEX ", $st->{TESTS_EXPECTED_FAIL} failures";
211         if ($st->{TESTS_UNEXPECTED_OK} > 0) {
212                 print INDEX " ($st->{TESTS_UNEXPECTED_FAIL})";
213         }
214         if ($st->{TESTS_ERROR} > 0) {
215                 print INDEX ", $st->{TESTS_ERROR} errors";
216         }
217
218         print INDEX "</td>";
219
220         print INDEX "</tr>\n";
221
222         print INDEX "</table>\n";
223         print INDEX "</center>\n";
224         print INDEX "</td></tr>\n";
225         print INDEX "</table>\n";
226         print INDEX "</body>\n";
227         print INDEX "</html>\n";
228         close(INDEX);
229 }
230
231 sub missing_env($$$)
232 {
233         my ($self, $name, $envname) = @_;
234
235         print "FAIL: $name (ENV[$envname] not available!)\n";
236 }
237
238 sub skip_testsuite($$)
239 {
240         my ($self, $name) = @_;
241
242         print INDEX "<tr>\n";
243         print INDEX "  <td class=\"testSuite\">$name</td>\n";
244         print INDEX "  <td class=\"resultSkipped\" colspan=\"2\">SKIPPED</td>\n";
245         print INDEX "</tr>\n";
246 }
247
248 1;