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