common/tools/analysis/parselistdirs.pl
author Simon Howkins <simonh@symbian.org>
Thu, 10 Dec 2009 12:01:59 +0000
changeset 825 1de547e13d13
parent 100 c222f4b27ad7
permissions -rw-r--r--
Updates to make the build environment check more reasonable: Mercurial v1.3 permitted The Java compiler is not a showstopping issue 7-zip can be installed in any location Update to Helium 5 Helium can be installed in PDT 1.*, not necessarily 1.0 Raptor installation path not significant Update to Raptor 2.9.* The Raptor patch to update the bundled version of python is no longer relevant BRAG calculations updated to ignore items not being in the system path, as this just doesn't matter. Overall effect is that the build environment check should pass on a machine that is able to do a build!

#!/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;
}