| changeset 100 | c222f4b27ad7 |
| parent 97 | 4f54ca96b7e8 |
| 99:2c7b53b5228f | 100:c222f4b27ad7 |
|---|---|
15 |
15 |
16 |
16 |
17 |
17 |
18 my $lowercase = 1; |
18 my $lowercase = 1; |
19 my $useoutputfiles = 1; |
19 my $useoutputfiles = 1; |
20 my $path = shift @ARGV; |
|
21 my $outputpath = shift @ARGV; |
|
22 |
|
20 main(); |
23 main(); |
21 |
24 |
22 |
25 |
23 |
26 |
24 sub main() |
27 sub main() |
25 { |
28 { |
26 if($lowercase) |
29 if($lowercase) |
27 { |
30 { |
28 print "Running in lower case mode!\n"; |
31 print "Running in lower case mode!\n"; |
29 } |
32 } |
30 my $path = shift @ARGV; |
|
31 my @listfiles = glob($path."listdir*"); |
33 my @listfiles = glob($path."listdir*"); |
32 |
34 |
33 my $gt_base; |
35 my $gt_base; |
34 my $gt_clean; |
36 my $gt_clean; |
35 my $gt_main; |
37 my $gt_main; |
92 my $untouched = diff($gt_base,$try); # all the stuff we didn't try. |
94 my $untouched = diff($gt_base,$try); # all the stuff we didn't try. |
93 |
95 |
94 #printgroup($try,"try"); |
96 #printgroup($try,"try"); |
95 |
97 |
96 my $uptodate = finduptodate($path); # this is a bit dicey, 'cos it might get deleted/rebuilt by another part... |
98 my $uptodate = finduptodate($path); # this is a bit dicey, 'cos it might get deleted/rebuilt by another part... |
97 |
99 my $exported = findexported($path); |
98 |
100 |
99 printgroup(diff($untouched,$uptodate),"untouched"); # 'clean' doesn't remove headers if they are 'uptodate' |
101 printgroup($exported,'exported'); |
102 $untouched = diff($untouched,union($exported,$uptodate)); |
|
103 printgroup($untouched,"untouched"); # 'clean' doesn't remove headers if they are 'uptodate' |
|
104 |
|
105 #here's where the fun begins... |
|
100 |
106 |
101 my $rebuildfail = intersect(union($gt_built,$gt_add), $s60_fail); #everything built in GT, minus stuff that failed in S60 |
107 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 |
108 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 |
109 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 |
110 my $fail = diff(union($gt_fail,$s60_fail),$rebuildfail); #everyhting that failed, minus the rebuild failures |
105 |
111 |
106 my $added = diff(union($gt_add,$s60_add),$rebuildfail); #all the stuff that got added, minus the stuff that filaed to rebuild |
112 my $added = diff(diff(union($gt_add,$s60_add),$exported),$rebuildfail); #all the stuff that got added, minus the stuff that filaed to rebuild |
107 |
113 |
108 printgroup($built,"built"); |
114 printgroup($built,"built"); |
109 printgroup($rebuilt,'rebuilt'); |
115 printgroup($rebuilt,'rebuilt'); |
110 printgroup($rebuildfail,'rebuildfail'); |
116 printgroup($rebuildfail,'rebuildfail'); |
111 printgroup($added,"added"); |
117 printgroup($added,"added"); |
112 |
118 |
113 |
119 |
114 printgroup($fail,"failed"); |
120 printgroup($fail,"failed"); |
115 |
121 |
116 $uptodate = diff($uptodate,union($added,$built)); #remove all stuff in other categories...'uptodate' was added late in the program |
122 $uptodate = diff($uptodate,union(union($added,$built),$exported)); #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. |
123 printgroup($uptodate,"uptodate"); # uptodate list isn't that good at the moment...put it last. |
118 } |
124 } |
119 |
125 |
120 sub printgroup($$) |
126 sub printgroup($$) |
121 { |
127 { |
125 { |
131 { |
126 print $label." : ".$key."\t".$group->{$key}."\n"; |
132 print $label." : ".$key."\t".$group->{$key}."\n"; |
127 } |
133 } |
128 if($useoutputfiles) |
134 if($useoutputfiles) |
129 { |
135 { |
130 my $filename = "results_$label.log"; |
136 my $filename = $outputpath."results_$label.log"; |
131 open(FILE,">$filename") or die "Couldn't open $filename\n"; |
137 open(FILE,">$filename") or die "Couldn't open $filename\n"; |
132 foreach my $key (sort keys %$group) |
138 foreach my $key (sort keys %$group) |
133 { |
139 { |
134 print FILE $key."\n"; |
140 print FILE $key."\n"; |
135 } |
141 } |
187 |
193 |
188 |
194 |
189 sub finduptodate($path) |
195 sub finduptodate($path) |
190 { |
196 { |
191 my $path = shift; |
197 my $path = shift; |
192 my @files = glob($path."*CLEAN*compile.log"); |
198 my @files = glob($path."*compile.log"); |
193 my %results; |
199 my %results; |
194 foreach my $file (@files) |
200 foreach my $file (@files) |
195 { |
201 { |
196 print "Reading $file\n"; |
202 print "Reading $file\n"; |
197 open(FILE,"<$file") or die "Cannot open $file\n"; |
203 open(FILE,"<$file") or die "Cannot open $file\n"; |
214 } |
220 } |
215 |
221 |
216 return \%results; |
222 return \%results; |
217 } |
223 } |
218 |
224 |
225 sub findexported($) |
|
226 { |
|
227 my $path = shift; |
|
228 my @files = glob($path."*compile.log"); |
|
229 my %results; |
|
230 foreach my $file (@files) |
|
231 { |
|
232 print "Reading $file\n"; |
|
233 open(FILE,"<$file") or die "Cannot open $file\n"; |
|
234 while( my $line = <FILE>) |
|
235 { |
|
236 #<info>Copied u:/sf/app/conntools/emulatorlan/data/s60_32_default_snaps.xml to u:/epoc32/winscw/c/s60_32_default_snaps.xml</info> |
|
237 if($line =~ m/<info>Copied\s+(\S+)\s+to\s+(\S+)<\/info>/) |
|
238 { |
|
239 |
|
240 my $str = $2; #we want the destination, not the source... |
|
241 $str =~ s/^\S:\///; |
|
242 if($lowercase) |
|
243 { |
|
244 $str = lc($str); |
|
245 } |
|
246 $results{$str} = ""; |
|
247 } |
|
248 } |
|
249 close FILE; |
|
250 } |
|
251 return \%results; |
|
252 } |
|
253 |
|
254 |
|
219 |
255 |
220 sub parsefile($file) |
256 sub parsefile($file) |
221 { |
257 { |
222 my $file = shift; |
258 my $file = shift; |
223 # my @results; |
259 # my @results; |