|
1 #!/usr/bin/perl |
|
2 use strict; |
|
3 |
|
4 #listdir_platform_MCL.PDK-3.5_baseline.log |
|
5 #listdir_platform_MCL.PDK-3.5_post-clean.log |
|
6 #listdir_platform_MCL.PDK-3.5_post-clean_delta.log |
|
7 #listdir_platform_MCL.PDK-3.5_post-build-tools2.log |
|
8 #listdir_platform_MCL.PDK-3.5_post-build-tools.log |
|
9 #listdir_platform_MCL.PDK-3.5_post-build-main.log |
|
10 #listdir_platform_MCL.PDK-3.5_s60-baseline.log |
|
11 #listdir_platform_MCL.PDK-3.5_post-s60-clean.log |
|
12 #listdir_platform_MCL.PDK-3.5_post-s60-clean_delta.log |
|
13 #listdir_platform_MCL.PDK-3.5_post-s60-build-tools.log |
|
14 #listdir_platform_MCL.PDK-3.5_post-s60-build-main.log |
|
15 |
|
16 |
|
17 |
|
18 my $lowercase = 1; |
|
19 my $useoutputfiles = 1; |
|
20 main(); |
|
21 |
|
22 |
|
23 |
|
24 sub main() |
|
25 { |
|
26 if($lowercase) |
|
27 { |
|
28 print "Running in lower case mode!\n"; |
|
29 } |
|
30 my $path = shift @ARGV; |
|
31 my @listfiles = glob($path."listdir*"); |
|
32 |
|
33 my $gt_base; |
|
34 my $gt_clean; |
|
35 my $gt_main; |
|
36 my $s60_base; |
|
37 my $s60_clean; |
|
38 my $s60_main; |
|
39 foreach my $file (@listfiles) |
|
40 { |
|
41 if($file =~ m/s60/) |
|
42 { |
|
43 if($file =~ m/baseline/) |
|
44 { |
|
45 $s60_base = parsefile($file); |
|
46 } |
|
47 elsif($file =~ m/clean.log/) |
|
48 { |
|
49 $s60_clean = parsefile($file); |
|
50 } |
|
51 elsif($file =~ m/main.log/) |
|
52 { |
|
53 $s60_main = parsefile($file); |
|
54 } |
|
55 } |
|
56 else |
|
57 { |
|
58 if($file =~ m/baseline/) |
|
59 { |
|
60 $gt_base = parsefile($file); |
|
61 } |
|
62 elsif($file =~ m/clean.log/) |
|
63 { |
|
64 $gt_clean = parsefile($file); |
|
65 } |
|
66 elsif($file =~ m/main.log/) |
|
67 { |
|
68 $gt_main = parsefile($file); |
|
69 } |
|
70 } |
|
71 } |
|
72 |
|
73 |
|
74 |
|
75 my $gt_try = diff($gt_base, $gt_clean); |
|
76 my $gt_fail = diff($gt_base, $gt_main); |
|
77 my $gt_built = diff($gt_try, $gt_fail); |
|
78 |
|
79 # printgroup($gt_fail,'fail'); |
|
80 # printgroup($gt_built,'built'); |
|
81 |
|
82 |
|
83 my $s60_try = diff($s60_base, $s60_clean); |
|
84 my $s60_fail = diff($s60_base, $s60_main); |
|
85 my $s60_built = diff($s60_try, $s60_fail); |
|
86 |
|
87 my $s60_add = diff($s60_main,$s60_base); |
|
88 my $gt_add = diff($gt_main,$gt_base); |
|
89 |
|
90 |
|
91 my $try = union($gt_try,$s60_try); # All the stuff we try to build |
|
92 my $untouched = diff($gt_base,$try); # all the stuff we didn't try. |
|
93 |
|
94 #printgroup($try,"try"); |
|
95 |
|
96 my $uptodate = finduptodate($path); # this is a bit dicey, 'cos it might get deleted/rebuilt by another part... |
|
97 |
|
98 |
|
99 printgroup(diff($untouched,$uptodate),"untouched"); # 'clean' doesn't remove headers if they are 'uptodate' |
|
100 |
|
101 my $rebuildfail = intersect(union($gt_built,$gt_add), $s60_fail); #everything built in GT, minus stuff that failed in S60 |
|
102 my $rebuilt = intersect($gt_built, $s60_built); # everything built in both |
|
103 my $built = diff(diff(union($gt_built, $s60_built),$rebuilt),$rebuildfail); # everything built, minus rebuilt, minus rebuildfail |
|
104 my $fail = diff(union($gt_fail,$s60_fail),$rebuildfail); #everyhting that failed, minus the rebuild failures |
|
105 |
|
106 my $added = diff(union($gt_add,$s60_add),$rebuildfail); #all the stuff that got added, minus the stuff that filaed to rebuild |
|
107 |
|
108 printgroup($built,"built"); |
|
109 printgroup($rebuilt,'rebuilt'); |
|
110 printgroup($rebuildfail,'rebuildfail'); |
|
111 printgroup($added,"added"); |
|
112 |
|
113 |
|
114 printgroup($fail,"failed"); |
|
115 |
|
116 $uptodate = diff($uptodate,union($added,$built)); #remove all stuff in other categories...'uptodate' was added late in the program |
|
117 printgroup($uptodate,"uptodate"); # uptodate list isn't that good at the moment...put it last. |
|
118 } |
|
119 |
|
120 sub printgroup($$) |
|
121 { |
|
122 my $group = shift; |
|
123 my $label = shift; |
|
124 foreach my $key (sort keys %$group) |
|
125 { |
|
126 print $label." : ".$key."\t".$group->{$key}."\n"; |
|
127 } |
|
128 if($useoutputfiles) |
|
129 { |
|
130 my $filename = "results_$label.log"; |
|
131 open(FILE,">$filename") or die "Couldn't open $filename\n"; |
|
132 foreach my $key (sort keys %$group) |
|
133 { |
|
134 print FILE $key."\n"; |
|
135 } |
|
136 close FILE; |
|
137 } |
|
138 } |
|
139 |
|
140 sub diff($s1,$s2) |
|
141 { |
|
142 my $s1 = shift; |
|
143 my $s2 = shift; |
|
144 my %r; |
|
145 foreach my $key (keys %$s1) |
|
146 { |
|
147 if(!defined $s2->{$key}) |
|
148 { |
|
149 $r{$key} = $s1->{$key}; |
|
150 } |
|
151 } |
|
152 return \%r; |
|
153 } |
|
154 |
|
155 |
|
156 |
|
157 sub intersect($s1,$s2) |
|
158 { |
|
159 my $s1 = shift; |
|
160 my $s2 = shift; |
|
161 my %r; |
|
162 foreach my $key (keys %$s1) |
|
163 { |
|
164 if(defined $s2->{$key}) |
|
165 { |
|
166 $r{$key} = $s2->{$key}; |
|
167 } |
|
168 } |
|
169 return \%r; |
|
170 } |
|
171 |
|
172 sub union($s1,$s2) |
|
173 { |
|
174 my $s1 = shift; |
|
175 my $s2 = shift; |
|
176 my %r; |
|
177 foreach my $key (keys %$s1) |
|
178 { |
|
179 $r{$key} = $s1->{$key}; |
|
180 } |
|
181 foreach my $key (keys %$s2) #lazy |
|
182 { |
|
183 $r{$key} = $s2->{$key}; |
|
184 } |
|
185 return \%r; |
|
186 } |
|
187 |
|
188 |
|
189 sub finduptodate($path) |
|
190 { |
|
191 my $path = shift; |
|
192 my @files = glob($path."*CLEAN*compile.log"); |
|
193 my %results; |
|
194 foreach my $file (@files) |
|
195 { |
|
196 print "Reading $file\n"; |
|
197 open(FILE,"<$file") or die "Cannot open $file\n"; |
|
198 while( my $line = <FILE>) |
|
199 { |
|
200 if($line =~ m/<info>Up-to-date:\s+(.+)<\/info>/) |
|
201 { |
|
202 my $str = $1; |
|
203 $str =~ s/^\S:\///; |
|
204 if($lowercase) |
|
205 { |
|
206 $str = lc($str); |
|
207 } |
|
208 |
|
209 $results{$str} = ""; |
|
210 # print $str; |
|
211 } |
|
212 } |
|
213 close FILE; |
|
214 } |
|
215 |
|
216 return \%results; |
|
217 } |
|
218 |
|
219 |
|
220 sub parsefile($file) |
|
221 { |
|
222 my $file = shift; |
|
223 # my @results; |
|
224 my %results; |
|
225 print "Reading $file\n"; |
|
226 open(FILE,"<$file") or die "Couldn't open $file\n"; |
|
227 while(my $line = <FILE>) |
|
228 { |
|
229 $line =~ s/\n//; |
|
230 if($line =~ m/\S+/) |
|
231 { |
|
232 if( $line !~/^epoc32/ ) #latest lists sometimes don't have this... |
|
233 { |
|
234 $line = "epoc32/".$line; |
|
235 } |
|
236 if( $line !~/epoc32\/build\// ) #ignore epoc32/build |
|
237 { |
|
238 if($lowercase) |
|
239 { |
|
240 $line = lc($line); |
|
241 } |
|
242 $results{$line} = ""; |
|
243 # $results{$line} = $file; #debugging |
|
244 } |
|
245 |
|
246 # push(@results,$line) |
|
247 } |
|
248 } |
|
249 close FILE; |
|
250 # return \@results; |
|
251 return \%results; |
|
252 } |