251 lines
6.4 KiB
Perl
Executable File
251 lines
6.4 KiB
Perl
Executable File
#!/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;
|
|
|
|
}
|