Home | History | Annotate | Download | only in cgi 
      1 #!/usr/bin/perl
      2 
      3 #
      4 # reconsile.cgi - reconsile two or more scanner files
      5 #
      6 
      7 use CGI qw(:standard);
      8 
      9 chdir("/usr/tests/ltp/results/");
     10 
     11 # Get the list of results to compare.
     12 @results = param("results");
     13 
     14 print header("text/html");
     15 print start_html, "<pre>\n";
     16 
     17 # Give a warning if the suites do not match
     18 ($a, $b, $lastsuite) = split(/\./, $results[0]);
     19 for ($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 = ();
     31 foreach $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 }
     38 if ($#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;
     49 foreach $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;
    102 foreach $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 
    120 print "</pre>";
    121 print "<table border=1>\n";
    122 
    123 print "<tr><td>";
    124 for($i=0; $i <= $#result_testcases; $i++) {
    125 	print "<th colspan=3>$result_details->[$i]->{HOST}.$result_details->[$i]->{DATESTR}.$result_details->[$i]->{SUITE}";
    126 }
    127 print "</tr>\n";
    128 
    129 print "<tr><th>Test Tag";
    130 for($i=0; $i <= $#result_testcases; $i++) {
    131 	print "<th>TCID<th>Test Case<th>Status";
    132 }
    133 print "<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 = "";
    139 while (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 }
    235 print "</table>";
    236 
    237 print end_html;
    238 
    239 
    240 sub 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