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 }