1#!/usr/bin/perl
2
3#
4# reconsile.cgi - reconsile two or more scanner files
5#
6
7use CGI qw(:standard);
8
9chdir("/usr/tests/ltp/results/");
10
11# Get the list of results to compare.
12@results = param("results");
13
14print header("text/html");
15print start_html, "<pre>\n";
16
17# Give a warning if the suites do not match
18($a, $b, $lastsuite) = split(/\./, $results[0]);
19for ($i = 1; $i <= $#results; $i++) {
20	($a, $b, $thissuite) = split(/\./, $results[$i]);
21	if ($lastsuite ne $thissuite) {
22		print "Warning: Suites do not match!\n";
23		last;
24	}
25}
26
27# check that each requested result exists.  If one does not exist,
28# print a warning and continue.  If the number of available results
29# is less than two, halt with an error
30@result_filenames = ();
31foreach $a_result (@results) {
32	if (-f "$a_result.scanner") {
33		push(@result_filenames, "$a_result.scanner");
34	} else {
35		print "Could not find a scanner file for $a_result\n";
36	}
37}
38if ($#result_filenames < 1) {
39	print "Not enough result files to compare\n";
40	die;
41}
42
43# for each result file read in and store the header information in
44# an associative array.  Take the rest of the input file and store
45# it as a list.
46@result_details = ();
47@result_testcases = ();
48$i = 0;
49foreach $result_filename (@result_filenames) {
50	unless (open(F, $result_filename)) {
51		print "failed openning $result_filename\n";
52		next;
53	}
54	# advance past the header then read in the rest
55	$result_testcases->[$i] = ();
56	$result_details->[$i] = {};
57	($host, $datestr, $suite, $ext) = split(/\./, $result_filename);
58	$result_details->[$i]->{HOST} = $host;
59	$result_details->[$i]->{DATESTR} = $datestr;
60	$result_details->[$i]->{SUITE} = $suite;
61	while ($line = <F>) {
62		# check for the end of the header
63		if ($line =~ /^-+/) {
64			# we've reached the top of the scanner output
65			# grab the rest and stop the while loop;
66			@rest = <F>;
67			close(F);
68			last;
69		}
70		# grab information from the header
71		if ($line =~ /^UNAME/) {
72			$line =~ s/UNAME *//;
73			$result_details->[$i]->{UNAME} = $line;
74			next;
75		}
76	}
77	# convert the results to records and add them to the list
78	foreach $line (@rest) {
79		($tag, $tcid, $tc, $status, $contact) = split(/\s+/, $line);
80		# fix some of the fields so they sort properly
81		$tcid = '{' if ($tcid eq '*');
82		$tcid = '}' if ($tcid eq '-');
83		$tc = '{' if ($tc eq '*');
84		$tc = '}' if ($tc eq '-');
85		$rec = ();
86		$rec->{TAG} = $tag;
87		$rec->{TCID} = $tcid;
88		$rec->{TC} = $tc;
89		$rec->{STATUS} = $status;
90		$rec->{CONTACT} = $contact;
91		push(@{$result_testcases[$i]}, $rec);
92	}
93	$i++;
94}
95
96# sort each set of results.
97# This is the most important step since walking the data depends on
98# correctly sorting the data.  Some substitutions are made to keep
99# the test cases in each test tag in the proper order.  i.e.
100# s/\*/{/
101#$i = 0;
102foreach $rtcs (@result_testcases) {
103	@$rtcs = sort { $a->{TAG} cmp $b->{TAG}
104					|| $a->{TCID} cmp $b->{TCID}
105					|| $a->{TC} <=> $b->{TC}
106					|| $a->{TC} cmp $b->{TC}
107					|| $a->{STATUS} cmp $b->{STATUS}} @$rtcs;
108	#print "sorted file $i\n";
109	#print "=" x 50 . "\n";
110	#foreach (@$rtcs) {
111	#	print "$_->{TAG}:$_->{TCID}:$_->{TC}:$_->{STATUS}\n";
112	#}
113	#print "=" x 50 . "\n";
114	#$i++;
115}
116
117# here is the loop that prints the data into a multi-column table with the test
118# tags grouped together.
119
120print "</pre>";
121print "<table border=1>\n";
122
123print "<tr><td>";
124for($i=0; $i <= $#result_testcases; $i++) {
125	print "<th colspan=3>$result_details->[$i]->{HOST}.$result_details->[$i]->{DATESTR}.$result_details->[$i]->{SUITE}";
126}
127print "</tr>\n";
128
129print "<tr><th>Test Tag";
130for($i=0; $i <= $#result_testcases; $i++) {
131	print "<th>TCID<th>Test Case<th>Status";
132}
133print "<th>Contact</tr>\n";
134
135# while the result lists still have test cases
136# 	Find the smallest record from the top of the lists
137#   remove matching records from the lists and output them
138$last_tag = "";
139while (1) {
140
141	# if there wasn't anything left, leave
142	$somethingleft = 0;
143	foreach $rtcs (@result_testcases) {
144		if ($#$rtcs > -1) {
145			$somethingleft = 1;
146			last;
147		}
148	}
149	unless ($somethingleft) { last; }
150
151	# find the Lowest Common Record
152	@tops = ();
153	foreach $rtcs (@result_testcases) {
154		if (@$rtcs[0]) {
155			push(@tops, copy_record(@$rtcs[0]));
156		}
157	}
158	@tops = sort { $a->{TAG} cmp $b->{TAG}
159				|| $a->{TCID} cmp $b->{TCID}
160				|| $a->{TC} <=> $b->{TC}
161				|| $a->{TC} cmp $b->{TC}
162				|| $a->{STATUS} cmp $b->{STATUS}} @tops;
163
164	$LCR = $tops[0];
165
166	# check to see if everyone matches
167	$matches = 0;
168	foreach $rtcs (@result_testcases) {
169		if (! @$rtcs[0]) { next; }
170		if (@$rtcs[0]->{TAG} eq $LCR->{TAG}
171			&& @$rtcs[0]->{TCID} eq $LCR->{TCID}
172			&& @$rtcs[0]->{TC} eq $LCR->{TC}
173			&& @$rtcs[0]->{STATUS} eq $LCR->{STATUS}) {
174
175			$matches++;
176		}
177	}
178	# if everyone does match (status included) shift them
179	# and move on.
180	if ($matches == ($#result_testcases+1)) {
181		foreach $rtcs (@result_testcases) { shift(@$rtcs); }
182		next;
183	}
184
185	# if we've already output stuff related to this test tag,
186	# skip that column, otherwise print the tag
187	if ($LCR->{TAG} eq $lasttag) {
188		print "<tr><td>";
189	} else {
190		print "<tr><td>$LCR->{TAG}";
191		$lasttag = $LCR->{TAG};
192	}
193
194	# walk through the lists again outputting as we match
195	$column = 0;
196	foreach $rtcs (@result_testcases) {
197		if (! @$rtcs[0]) {
198			print "<td><td><td>";
199			$column++;
200			next;
201		} elsif (@$rtcs[0]->{TAG} eq $LCR->{TAG}
202			&& @$rtcs[0]->{TCID} eq $LCR->{TCID}
203			&& @$rtcs[0]->{TC} eq $LCR->{TC}) {
204
205			$match = shift(@$rtcs);
206			$match->{TCID} = '*' if ($match->{TCID} eq '{');
207			$match->{TCID} = '-' if ($match->{TCID} eq '}');
208			$match->{TC} = '*' if ($match->{TC} eq '{');
209			$match->{TC} = '-' if ($match->{TC} eq '}');
210			print "<td>";
211			$rd = $result_details->[$column];
212			print "<a href=\"results.cgi?get_df=$rd->{HOST}.$rd->{DATESTR}.$rd->{SUITE}.driver&zoom_tag=$match->{TAG}\">";
213			print "$match->{TCID}</a>";
214			print "<td>$match->{TC}";
215			print "<td>";
216			if ($match->{STATUS} =~ /PASS/) {
217				print "<font color=green>";
218			} elsif ($match->{STATUS} =~ /FAIL/) {
219				print "<font color=red>";
220			} elsif ($match->{STATUS} =~ /CONF/) {
221				print "<font color=yello>";
222			} elsif ($match->{STATUS} =~ /BROK/) {
223				print "<font color=blue>";
224			} else {
225				print "<font color=black>";
226			}
227			print "$match->{STATUS}</font>";
228		} else {
229			print "<td><td><td>";
230		}
231		$column++;
232	}
233	print "<td>$LCR->{CONTACT}</tr>\n";
234}
235print "</table>";
236
237print end_html;
238
239
240sub copy_record {
241	my $copy, $rec = shift;
242
243	$copy->{TAG} = $rec->{TAG};
244	$copy->{TCID} = $rec->{TCID};
245	$copy->{TC} = $rec->{TC};
246	$copy->{STATUS} = $rec->{STATUS};
247	$copy->{CONTACT} = $rec->{CONTACT};
248	return $copy;
249
250}
251