|
1 # Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
2 # All rights reserved. |
|
3 # This component and the accompanying materials are made available |
|
4 # under the terms of "Eclipse Public License v1.0" |
|
5 # which accompanies this distribution, and is available |
|
6 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
7 # |
|
8 # Initial Contributors: |
|
9 # Nokia Corporation - initial contribution. |
|
10 # |
|
11 # Contributors: |
|
12 # |
|
13 # Description: |
|
14 # |
|
15 |
|
16 $suite = ""; |
|
17 $verbose = 1; |
|
18 |
|
19 $numtests = $ARGV[0]; |
|
20 |
|
21 open TESTS, $ARGV[1] or die "Cannot open $ARGV[1]"; |
|
22 %config = (tdlogs => "", logdir => "", mainlog => ""); |
|
23 CONFIG: while (<TESTS>) { |
|
24 last CONFIG if /\[tests\]/i; |
|
25 next CONFIG if /^\n/; |
|
26 chomp; |
|
27 ($var, $value) = split /=/, $_; |
|
28 if (exists $config{$var}) { |
|
29 $config{$var} = $value; |
|
30 } |
|
31 } |
|
32 close TESTS; |
|
33 |
|
34 @rundirs = &find_rundirs; |
|
35 @sorted = sort { |
|
36 $a =~ /RunNo([0-9]+)/; |
|
37 $l = $1; |
|
38 $b =~ /RunNo([0-9]+)/; |
|
39 $r = $1; |
|
40 $r <=> $l; |
|
41 } @rundirs; |
|
42 |
|
43 open MAIN, ">".$config{"mainlog"} or die "Can't open ".$config{"mainlog"}.": $!"; |
|
44 print MAIN <<EOT; |
|
45 <html> |
|
46 <head> |
|
47 <title>$suite Log</title></head> |
|
48 <style type="text/css"> |
|
49 .pass { color: green; } |
|
50 .fail { color: red; } |
|
51 </style> |
|
52 <body> |
|
53 EOT |
|
54 print "Number of test dirs to process: $numtests\n"; |
|
55 my @dirlist; |
|
56 for ($i = 0; $i < $numtests; $i++) { |
|
57 $dirlist[$i] = $sorted[$i]; |
|
58 } |
|
59 @dirlist = reverse @dirlist; |
|
60 for ($i = 0; $i < $numtests; $i++) { |
|
61 &process_dir($dirlist[$i], ""); |
|
62 } |
|
63 print MAIN "</body></html>"; |
|
64 close MAIN; |
|
65 |
|
66 sub find_rundirs { |
|
67 my @rundirs; |
|
68 opendir(RESDIR, $config{"tdlogs"}) or die "Can't open ".$config{"tdlogs"}.": $!\n"; |
|
69 my @dirs = grep { /^[^.]/ } readdir(RESDIR); |
|
70 close RESDIR; |
|
71 my $highest = 0; |
|
72 my $highDir = ""; |
|
73 for my $dir (@dirs) { |
|
74 opendir(SUBDIR, $config{"tdlogs"}."\\$dir") or die "Can't open ".$config{"tdlogs"}."\\$dir: $!\n"; |
|
75 @subdirs = grep { /[^.]/ } readdir(SUBDIR); |
|
76 for my $subdir (@subdirs) { |
|
77 push @rundirs, $config{"tdlogs"}."\\$dir\\$subdir"; |
|
78 # print "Found ".$config{"tdlogs"}."\\$dir\\$subdir\n" |
|
79 #$subdir =~ /RunNo([0-9]+)/; |
|
80 #if ($1 > $highest) { |
|
81 # $highest = $1; |
|
82 # $highDir = $config{"tdlogs"}."\\$dir\\$subdir"; |
|
83 #} |
|
84 } |
|
85 close SUBDIR; |
|
86 } |
|
87 #return $highDir; |
|
88 return @rundirs; |
|
89 } |
|
90 |
|
91 sub process_dir { |
|
92 my ($tdlogdir, $currdir) = @_; |
|
93 print "Processing $tdlogdir$currdir\n" if $verbose; |
|
94 chdir("$tdlogdir$currdir"); |
|
95 #Find all log files that match the ones retrieved from the board and process them. |
|
96 while (<*.htm>) { |
|
97 /(.*)\.htm/; |
|
98 my $htmlog = $_; |
|
99 my $txtlog = ""; |
|
100 print "Looking for ".$config{"logdir"}."\\$suite$currdir\\$1.txt\n" if $verbose; |
|
101 if (-e $config{"logdir"}."\\$suite$currdir\\$1.txt") { |
|
102 print "found $1.txt\n" if $verbose; |
|
103 $txtlog = $config{"logdir"}."\\$suite$currdir\\$1.txt"; |
|
104 } |
|
105 &process_logs($1, $txtlog, $htmlog); |
|
106 } |
|
107 |
|
108 #Process subdirectories |
|
109 opendir(DIR, "$tdlogdir$currdir") or die "Can't open $tdlogdir$currdir: $!\n"; |
|
110 my @dirs = grep { /^[^.]/ } readdir(DIR); |
|
111 close DIR; |
|
112 for my $dir (@dirs) { |
|
113 if (-d "$tdlogdir$currdir\\$dir") { |
|
114 &process_dir($tdlogdir, "$currdir\\$dir"); |
|
115 } |
|
116 } |
|
117 } |
|
118 |
|
119 sub process_logs { |
|
120 my ($name, $txtlog, $htmlog) = @_; |
|
121 print MAIN "<b>$name Log</b><br/><br/>"; |
|
122 my $fail = 0; |
|
123 $fail += &process_txt_log($txtlog) unless $txtlog eq ""; |
|
124 $fail += &process_htm_log($htmlog); |
|
125 if ($fail > 0) { |
|
126 print MAIN "<b>$name: </b><span class=\"fail\"><b>$fail step(s) failed</b></span><br/>"; |
|
127 } else { |
|
128 print MAIN "<b>$name: </b><span class=\"pass\"><b>All steps passed</b></span><br/>"; |
|
129 } |
|
130 } |
|
131 |
|
132 sub process_txt_log { |
|
133 open LOG, $_[0] or die "Can't open".$_[0].": $!\n"; |
|
134 my $fail = 0; |
|
135 while (<LOG>) { |
|
136 print MAIN "Command $_ : "; |
|
137 $_ = <LOG>; |
|
138 print MAIN "<span class=\"pass\">PASS" if /pass/i; |
|
139 do { print MAIN "<span class=\"fail\">FAIL"; $fail++ } if /fail/i; |
|
140 print MAIN "</span><br/>"; |
|
141 } |
|
142 close LOG; |
|
143 return $fail; |
|
144 } |
|
145 |
|
146 sub process_htm_log { |
|
147 open LOG, $_[0] or die "Can't open".$_[0].": $!\n"; |
|
148 print MAIN "<pre>\n"; |
|
149 my $fail = 0; |
|
150 LINE: while (<LOG>) { |
|
151 next LINE if /<\/?html>/; |
|
152 if (/(FAIL|ABORT|PANIC|INCONCLUSIVE|UNKNOWN|UNEXECUTED) = ([0-9]+)/) { |
|
153 $fail += $2; |
|
154 } |
|
155 print MAIN; |
|
156 } |
|
157 print MAIN "</pre>\n"; |
|
158 return $fail; |
|
159 } |
|
160 |
|
161 |