pan/cgi/reconsile.cgi

#!/usr/bin/perl

#
# reconsile.cgi - reconsile two or more scanner files
#

use CGI qw(:standard);

chdir("/usr/tests/ltp/results/");

# Get the list of results to compare.
@results = param("results");

print header("text/html");
print start_html, "<pre>\n";

# Give a warning if the suites do not match
($a, $b, $lastsuite) = split(/\./, $results[0]);
for ($i = 1; $i <= $#results; $i++) {
	($a, $b, $thissuite) = split(/\./, $results[$i]);
	if ($lastsuite ne $thissuite) {
		print "Warning: Suites do not match!\n";
		last;
	}
}

# check that each requested result exists.  If one does not exist,
# print a warning and continue.  If the number of available results
# is less than two, halt with an error
@result_filenames = ();
foreach $a_result (@results) {
	if (-f "$a_result.scanner") {
		push(@result_filenames, "$a_result.scanner");
	} else {
		print "Could not find a scanner file for $a_result\n";
	}
}
if ($#result_filenames < 1) {
	print "Not enough result files to compare\n";
	die;
}

# for each result file read in and store the header information in
# an associative array.  Take the rest of the input file and store
# it as a list.
@result_details = ();
@result_testcases = ();
$i = 0;
foreach $result_filename (@result_filenames) {
	unless (open(F, $result_filename)) {
		print "failed openning $result_filename\n";
		next;
	}
	# advance past the header then read in the rest
	$result_testcases->[$i] = ();
	$result_details->[$i] = {};
	($host, $datestr, $suite, $ext) = split(/\./, $result_filename);
	$result_details->[$i]->{HOST} = $host;
	$result_details->[$i]->{DATESTR} = $datestr;
	$result_details->[$i]->{SUITE} = $suite;
	while ($line = <F>) {
		# check for the end of the header
		if ($line =~ /^-+/) {
			# we've reached the top of the scanner output
			# grab the rest and stop the while loop;
			@rest = <F>;
			close(F);
			last;
		}
		# grab information from the header
		if ($line =~ /^UNAME/) {
			$line =~ s/UNAME *//;
			$result_details->[$i]->{UNAME} = $line;
			next;
		}
	}
	# convert the results to records and add them to the list
	foreach $line (@rest) {
		($tag, $tcid, $tc, $status, $contact) = split(/\s+/, $line);
		# fix some of the fields so they sort properly
		$tcid = '{' if ($tcid eq '*');
		$tcid = '}' if ($tcid eq '-');
		$tc = '{' if ($tc eq '*');
		$tc = '}' if ($tc eq '-');
		$rec = ();
		$rec->{TAG} = $tag;
		$rec->{TCID} = $tcid;
		$rec->{TC} = $tc;
		$rec->{STATUS} = $status;
		$rec->{CONTACT} = $contact;
		push(@{$result_testcases[$i]}, $rec);
	}
	$i++;
}

# sort each set of results.
# This is the most important step since walking the data depends on
# correctly sorting the data.  Some substitutions are made to keep
# the test cases in each test tag in the proper order.  i.e.
# s/\*/{/
#$i = 0;
foreach $rtcs (@result_testcases) {
	@$rtcs = sort { $a->{TAG} cmp $b->{TAG}
					|| $a->{TCID} cmp $b->{TCID}
					|| $a->{TC} <=> $b->{TC}
					|| $a->{TC} cmp $b->{TC}
					|| $a->{STATUS} cmp $b->{STATUS}} @$rtcs;
	#print "sorted file $i\n";
	#print "=" x 50 . "\n";
	#foreach (@$rtcs) {
	#	print "$_->{TAG}:$_->{TCID}:$_->{TC}:$_->{STATUS}\n";
	#}
	#print "=" x 50 . "\n";
	#$i++;
}

# here is the loop that prints the data into a multi-column table with the test
# tags grouped together.

print "</pre>";
print "<table border=1>\n";

print "<tr><td>";
for($i=0; $i <= $#result_testcases; $i++) {
	print "<th colspan=3>$result_details->[$i]->{HOST}.$result_details->[$i]->{DATESTR}.$result_details->[$i]->{SUITE}";
}
print "</tr>\n";

print "<tr><th>Test Tag";
for($i=0; $i <= $#result_testcases; $i++) {
	print "<th>TCID<th>Test Case<th>Status";
}
print "<th>Contact</tr>\n";

# while the result lists still have test cases
# 	Find the smallest record from the top of the lists
#   remove matching records from the lists and output them
$last_tag = "";
while (1) {

	# if there wasn't anything left, leave
	$somethingleft = 0;
	foreach $rtcs (@result_testcases) {
		if ($#$rtcs > -1) {
			$somethingleft = 1;
			last;
		}
	}
	unless ($somethingleft) { last; }

	# find the Lowest Common Record
	@tops = ();
	foreach $rtcs (@result_testcases) {
		if (@$rtcs[0]) {
			push(@tops, copy_record(@$rtcs[0]));
		}
	}
	@tops = sort { $a->{TAG} cmp $b->{TAG}
				|| $a->{TCID} cmp $b->{TCID}
				|| $a->{TC} <=> $b->{TC}
				|| $a->{TC} cmp $b->{TC}
				|| $a->{STATUS} cmp $b->{STATUS}} @tops;

	$LCR = $tops[0];

	# check to see if everyone matches
	$matches = 0;
	foreach $rtcs (@result_testcases) {
		if (! @$rtcs[0]) { next; }
		if (@$rtcs[0]->{TAG} eq $LCR->{TAG}
			&& @$rtcs[0]->{TCID} eq $LCR->{TCID}
			&& @$rtcs[0]->{TC} eq $LCR->{TC}
			&& @$rtcs[0]->{STATUS} eq $LCR->{STATUS}) {

			$matches++;
		}
	}
	# if everyone does match (status included) shift them
	# and move on.
	if ($matches == ($#result_testcases+1)) {
		foreach $rtcs (@result_testcases) { shift(@$rtcs); }
		next;
	}

	# if we've already output stuff related to this test tag,
	# skip that column, otherwise print the tag
	if ($LCR->{TAG} eq $lasttag) {
		print "<tr><td>";
	} else {
		print "<tr><td>$LCR->{TAG}";
		$lasttag = $LCR->{TAG};
	}

	# walk through the lists again outputting as we match
	$column = 0;
	foreach $rtcs (@result_testcases) {
		if (! @$rtcs[0]) {
			print "<td><td><td>";
			$column++;
			next;
		} elsif (@$rtcs[0]->{TAG} eq $LCR->{TAG}
			&& @$rtcs[0]->{TCID} eq $LCR->{TCID}
			&& @$rtcs[0]->{TC} eq $LCR->{TC}) {

			$match = shift(@$rtcs);
			$match->{TCID} = '*' if ($match->{TCID} eq '{');
			$match->{TCID} = '-' if ($match->{TCID} eq '}');
			$match->{TC} = '*' if ($match->{TC} eq '{');
			$match->{TC} = '-' if ($match->{TC} eq '}');
			print "<td>";
			$rd = $result_details->[$column];
			print "<a href=\"results.cgi?get_df=$rd->{HOST}.$rd->{DATESTR}.$rd->{SUITE}.driver&zoom_tag=$match->{TAG}\">";
			print "$match->{TCID}</a>";
			print "<td>$match->{TC}";
			print "<td>";
			if ($match->{STATUS} =~ /PASS/) {
				print "<font color=green>";
			} elsif ($match->{STATUS} =~ /FAIL/) {
				print "<font color=red>";
			} elsif ($match->{STATUS} =~ /CONF/) {
				print "<font color=yello>";
			} elsif ($match->{STATUS} =~ /BROK/) {
				print "<font color=blue>";
			} else {
				print "<font color=black>";
			}
			print "$match->{STATUS}</font>";
		} else {
			print "<td><td><td>";
		}
		$column++;
	}
	print "<td>$LCR->{CONTACT}</tr>\n";
}
print "</table>";

print end_html;


sub copy_record {
	my $copy, $rec = shift;

	$copy->{TAG} = $rec->{TAG};
	$copy->{TCID} = $rec->{TCID};
	$copy->{TC} = $rec->{TC};
	$copy->{STATUS} = $rec->{STATUS};
	$copy->{CONTACT} = $rec->{CONTACT};
	return $copy;

}