findphysicaldrive.pl - Fixed so it works with empty (freshly formatted) drives.
#!/usr/bin/perl
use strict;
#listdir_platform_MCL.PDK-3.5_baseline.log
#listdir_platform_MCL.PDK-3.5_post-clean.log
#listdir_platform_MCL.PDK-3.5_post-clean_delta.log
#listdir_platform_MCL.PDK-3.5_post-build-tools2.log
#listdir_platform_MCL.PDK-3.5_post-build-tools.log
#listdir_platform_MCL.PDK-3.5_post-build-main.log
#listdir_platform_MCL.PDK-3.5_s60-baseline.log
#listdir_platform_MCL.PDK-3.5_post-s60-clean.log
#listdir_platform_MCL.PDK-3.5_post-s60-clean_delta.log
#listdir_platform_MCL.PDK-3.5_post-s60-build-tools.log
#listdir_platform_MCL.PDK-3.5_post-s60-build-main.log
my $lowercase = 1;
my $useoutputfiles = 1;
my $path = shift @ARGV;
my $outputpath = shift @ARGV;
main();
sub main()
{
if($lowercase)
{
print "Running in lower case mode!\n";
}
my @listfiles = glob($path."listdir*");
my $gt_base;
my $gt_clean;
my $gt_main;
my $s60_base;
my $s60_clean;
my $s60_main;
foreach my $file (@listfiles)
{
if($file =~ m/s60/)
{
if($file =~ m/baseline/)
{
$s60_base = parsefile($file);
}
elsif($file =~ m/clean.log/)
{
$s60_clean = parsefile($file);
}
elsif($file =~ m/main.log/)
{
$s60_main = parsefile($file);
}
}
else
{
if($file =~ m/baseline/)
{
$gt_base = parsefile($file);
}
elsif($file =~ m/clean.log/)
{
$gt_clean = parsefile($file);
}
elsif($file =~ m/main.log/)
{
$gt_main = parsefile($file);
}
}
}
my $gt_try = diff($gt_base, $gt_clean);
my $gt_fail = diff($gt_base, $gt_main);
my $gt_built = diff($gt_try, $gt_fail);
# printgroup($gt_fail,'fail');
# printgroup($gt_built,'built');
my $s60_try = diff($s60_base, $s60_clean);
my $s60_fail = diff($s60_base, $s60_main);
my $s60_built = diff($s60_try, $s60_fail);
my $s60_add = diff($s60_main,$s60_base);
my $gt_add = diff($gt_main,$gt_base);
my $try = union($gt_try,$s60_try); # All the stuff we try to build
my $untouched = diff($gt_base,$try); # all the stuff we didn't try.
#printgroup($try,"try");
my $uptodate = finduptodate($path); # this is a bit dicey, 'cos it might get deleted/rebuilt by another part...
my $exported = findexported($path);
printgroup($exported,'exported');
$untouched = diff($untouched,union($exported,$uptodate));
printgroup($untouched,"untouched"); # 'clean' doesn't remove headers if they are 'uptodate'
#here's where the fun begins...
my $rebuildfail = intersect(union($gt_built,$gt_add), $s60_fail); #everything built in GT, minus stuff that failed in S60
my $rebuilt = intersect($gt_built, $s60_built); # everything built in both
my $built = diff(diff(union($gt_built, $s60_built),$rebuilt),$rebuildfail); # everything built, minus rebuilt, minus rebuildfail
my $fail = diff(union($gt_fail,$s60_fail),$rebuildfail); #everyhting that failed, minus the rebuild failures
my $added = diff(diff(union($gt_add,$s60_add),$exported),$rebuildfail); #all the stuff that got added, minus the stuff that filaed to rebuild
printgroup($built,"built");
printgroup($rebuilt,'rebuilt');
printgroup($rebuildfail,'rebuildfail');
printgroup($added,"added");
printgroup($fail,"failed");
$uptodate = diff($uptodate,union(union($added,$built),$exported)); #remove all stuff in other categories...'uptodate' was added late in the program
printgroup($uptodate,"uptodate"); # uptodate list isn't that good at the moment...put it last.
}
sub printgroup($$)
{
my $group = shift;
my $label = shift;
foreach my $key (sort keys %$group)
{
print $label." : ".$key."\t".$group->{$key}."\n";
}
if($useoutputfiles)
{
my $filename = $outputpath."results_$label.log";
open(FILE,">$filename") or die "Couldn't open $filename\n";
foreach my $key (sort keys %$group)
{
print FILE $key."\n";
}
close FILE;
}
}
sub diff($s1,$s2)
{
my $s1 = shift;
my $s2 = shift;
my %r;
foreach my $key (keys %$s1)
{
if(!defined $s2->{$key})
{
$r{$key} = $s1->{$key};
}
}
return \%r;
}
sub intersect($s1,$s2)
{
my $s1 = shift;
my $s2 = shift;
my %r;
foreach my $key (keys %$s1)
{
if(defined $s2->{$key})
{
$r{$key} = $s2->{$key};
}
}
return \%r;
}
sub union($s1,$s2)
{
my $s1 = shift;
my $s2 = shift;
my %r;
foreach my $key (keys %$s1)
{
$r{$key} = $s1->{$key};
}
foreach my $key (keys %$s2) #lazy
{
$r{$key} = $s2->{$key};
}
return \%r;
}
sub finduptodate($path)
{
my $path = shift;
my @files = glob($path."*compile.log");
my %results;
foreach my $file (@files)
{
print "Reading $file\n";
open(FILE,"<$file") or die "Cannot open $file\n";
while( my $line = <FILE>)
{
if($line =~ m/<info>Up-to-date:\s+(.+)<\/info>/)
{
my $str = $1;
$str =~ s/^\S:\///;
if($lowercase)
{
$str = lc($str);
}
$results{$str} = "";
# print $str;
}
}
close FILE;
}
return \%results;
}
sub findexported($)
{
my $path = shift;
my @files = glob($path."*compile.log");
my %results;
foreach my $file (@files)
{
print "Reading $file\n";
open(FILE,"<$file") or die "Cannot open $file\n";
while( my $line = <FILE>)
{
#<info>Copied u:/sf/app/conntools/emulatorlan/data/s60_32_default_snaps.xml to u:/epoc32/winscw/c/s60_32_default_snaps.xml</info>
if($line =~ m/<info>Copied\s+(\S+)\s+to\s+(\S+)<\/info>/)
{
my $str = $2; #we want the destination, not the source...
$str =~ s/^\S:\///;
if($lowercase)
{
$str = lc($str);
}
$results{$str} = "";
}
}
close FILE;
}
return \%results;
}
sub parsefile($file)
{
my $file = shift;
# my @results;
my %results;
print "Reading $file\n";
open(FILE,"<$file") or die "Couldn't open $file\n";
while(my $line = <FILE>)
{
$line =~ s/\n//;
if($line =~ m/\S+/)
{
if( $line !~/^epoc32/ ) #latest lists sometimes don't have this...
{
$line = "epoc32/".$line;
}
if( $line !~/epoc32\/build\// ) #ignore epoc32/build
{
if($lowercase)
{
$line = lc($line);
}
$results{$line} = "";
# $results{$line} = $file; #debugging
}
# push(@results,$line)
}
}
close FILE;
# return \@results;
return \%results;
}