code_churn/churn_core.pl
changeset 48 c0d2a34bf681
child 157 27cf0a88d449
equal deleted inserted replaced
47:8e73266ba54f 48:c0d2a34bf681
       
     1 #!perl -w
       
     2 
       
     3 # Copyright (c) 2009 Symbian Foundation Ltd
       
     4 # This component and the accompanying materials are made available
       
     5 # under the terms of the License "Eclipse Public License v1.0"
       
     6 # which accompanies this distribution, and is available
       
     7 # at the URL "http://www.eclipse.org/legal/epl-v10.html".
       
     8 #
       
     9 # Initial Contributors:
       
    10 # Symbian Foundation Ltd - initial contribution.
       
    11 # 
       
    12 # Contributors:
       
    13 #
       
    14 # Description:
       
    15 #
       
    16 
       
    17 use strict;
       
    18 use File::Find;
       
    19 use File::Copy;
       
    20 use Cwd;
       
    21 
       
    22 sub diffstat();
       
    23 
       
    24 my $Logs_Dir = $ARGV[0];
       
    25 my $dir_left = $ARGV[1];
       
    26 my $dir_right = $ARGV[2];
       
    27 my $dir_tmp_left = $ARGV[0].'\\'.$ARGV[1];
       
    28 my $dir_tmp_right = $ARGV[0].'\\'.$ARGV[2];
       
    29 
       
    30 print "left changeset $dir_left\n";
       
    31 print "right chnageset $dir_right\n";
       
    32 mkdir $dir_tmp_left;
       
    33 mkdir $dir_tmp_right;
       
    34 
       
    35 # default inclusions from churn.pl are "*.cpp", "*.c", "*.cxx", "*.h", "*.hpp", "*.inl" 
       
    36 my @file_pattern=('\.cpp$','\.c$','\.hpp$','\.h$','\.inl$','\.cxx$','\.hrh$');
       
    37 my $totallinecount=0;
       
    38 my $countcomments=0;
       
    39 
       
    40 if (! -d $Logs_Dir)
       
    41 {
       
    42     die("$Logs_Dir does not exist \n");
       
    43 }
       
    44 
       
    45 $dir_left =~ m/^(\w+)\.[0-9a-fA-F]+/;
       
    46 my $package_name = $1;
       
    47 
       
    48 $dir_left =~ m/^\w+\.([0-9a-fA-F]+)/;
       
    49 my $changeset_left = $1;
       
    50 
       
    51 $dir_right =~ m/^\w+\.([0-9a-fA-F]+)/;
       
    52 my $changeset_right = $1;
       
    53 
       
    54 print "\nWorking on package: $package_name\n";
       
    55 print "\nProcessing $dir_left\n";
       
    56 find(\&process_files, $dir_left);
       
    57 #DEBUG INFO:
       
    58 print "\nTotal linecount for changed files in $dir_left is $totallinecount\n";
       
    59 my $code_size_left = $totallinecount;
       
    60 
       
    61 $totallinecount=0;
       
    62 print "\nProcessing $dir_right\n";
       
    63 find(\&process_files, $dir_right);
       
    64 #DEBUG INFO:
       
    65 print "\nTotal linecount for changed files in $dir_right is $totallinecount\n";    
       
    66 my $code_size_right = $totallinecount;
       
    67 
       
    68 my @diffs;
       
    69 
       
    70 if (-d $dir_tmp_left && -d $dir_tmp_left)
       
    71 {
       
    72 	@diffs = `diff -r -N $dir_tmp_left $dir_tmp_right`;
       
    73 }
       
    74 
       
    75 my $changed_lines=@diffs;
       
    76 my $diffsfile = $Logs_Dir.'\\'."dirdiffs.out";
       
    77 open (DIFFS, ">$diffsfile");
       
    78 print DIFFS @diffs;
       
    79 close (DIFFS);
       
    80 
       
    81 diffstat();
       
    82 
       
    83 $dir_tmp_left =~ s{/}{\\}g;
       
    84 $dir_tmp_right =~ s{/}{\\}g;
       
    85 
       
    86 if (-d $dir_tmp_left)
       
    87 {
       
    88 	system("rmdir /S /Q $dir_tmp_left");
       
    89 }
       
    90 
       
    91 if (-d $dir_tmp_right)
       
    92 {
       
    93 system("rmdir /S /Q $dir_tmp_right");
       
    94 }
       
    95 
       
    96 unlink $diffsfile;
       
    97 unlink "$Logs_Dir\\line_count_newdir.txt";
       
    98 
       
    99 print "\n** Finished processing $package_name **\n\n\n\n\n";
       
   100 
       
   101 exit(0);
       
   102 
       
   103 sub diffstat()
       
   104 {
       
   105 open (DIFFSFILE,"$diffsfile");
       
   106 
       
   107 my $curfile = "";
       
   108 my %changes = ();
       
   109 
       
   110 while (<DIFFSFILE>)
       
   111 {
       
   112 	my $line = $_;
       
   113 				# diff -r -N D:/mirror\fbf_churn_output\commsfw.000000000000\serialserver\c32serialserver\Test\te_C32Performance\USB PC Side Code\resource.h 
       
   114 				# diff -r <anything><changeset(12 chars)><slash><full_filename><optional_whitespace><EOL>
       
   115 	if ($line =~ m/^diff -r.*\.[A-Fa-f0-9]{12}[\/\\](.*)\s*$/)
       
   116 	{
       
   117 		$curfile = $1;
       
   118 		#DEBUG INFO:
       
   119 		#print "\t$curfile\n";
       
   120 		if (!defined $changes{$curfile})
       
   121 		{
       
   122 			$changes{$curfile} = {'a'=>0,'c'=>0,'d'=>0,'filetype'=>'unknown'};
       
   123 		}
       
   124 		
       
   125 		$curfile =~ m/\.(\w+)$/g;
       
   126 				
       
   127 		#if filetype known...
       
   128 		my $filetype = $+;
       
   129 		
       
   130 		$changes{$curfile}->{'filetype'}=uc($filetype);
       
   131 	}
       
   132 	elsif ($line =~ m/^(\d+)(,(\d+))?(d)\d+(,\d+)?/)
       
   133 	{	
       
   134 		if (defined $3)
       
   135 		{
       
   136 			$changes{$curfile}->{$4} += ($3-$1)+1;
       
   137 		}
       
   138 		else
       
   139 		{
       
   140 			$changes{$curfile}->{$4}++;
       
   141 		}
       
   142 	}
       
   143 	elsif ($line =~ m/^\d+(,\d+)?([ac])(\d+)(,(\d+))?/)
       
   144 	{	
       
   145 		if (defined $5)
       
   146 		{
       
   147 			$changes{$curfile}->{$2} += ($5-$3)+1;
       
   148 		}
       
   149 		else
       
   150 		{
       
   151 			$changes{$curfile}->{$2}++;
       
   152 		}	
       
   153 	}
       
   154 }
       
   155 
       
   156 close (DIFFSFILE);
       
   157 
       
   158 my %package_changes = ("CPP"=>0, "H"=>0, "HPP"=>0, "INL"=>0, "C"=>0, "CXX"=>0,"HRH"=>0,);
       
   159 my %package_deletions = ("CPP"=>0, "H"=>0, "HPP"=>0, "INL"=>0, "C"=>0, "CXX"=>0,"HRH"=>0,);
       
   160 my %package_additions = ("CPP"=>0, "H"=>0, "HPP"=>0, "INL"=>0, "C"=>0, "CXX"=>0,"HRH"=>0,);
       
   161 my $package_churn = 0;
       
   162 
       
   163 for my $file (keys %changes)
       
   164 {
       
   165 	$package_changes{$changes{$file}->{'filetype'}} += $changes{$file}->{'c'};
       
   166 	$package_deletions{$changes{$file}->{'filetype'}} += $changes{$file}->{'d'};
       
   167 	$package_additions{$changes{$file}->{'filetype'}} += $changes{$file}->{'a'};
       
   168 }
       
   169 
       
   170 
       
   171 #DEBUG INFO: For printing contents of hashes containing per filetype summary
       
   172 #print "\n\n\n\n";
       
   173 #print "package_changes:\n";
       
   174 #print map { "$_ => $package_changes{$_}\n" } keys %package_changes;
       
   175 #print "\n\n\n\n";
       
   176 #print "package_deletions:\n";
       
   177 #print map { "$_ => $package_deletions{$_}\n" } keys %package_deletions;
       
   178 #print "\n\n\n\n";
       
   179 #print "package_additions:\n";
       
   180 #print map { "$_ => $package_additions{$_}\n" } keys %package_additions;
       
   181 
       
   182 
       
   183 
       
   184 my $overall_changes = 0;
       
   185 for my $filetype (keys %package_changes)
       
   186 {
       
   187 	$overall_changes += $package_changes{$filetype};
       
   188 }
       
   189 
       
   190 my $overall_deletions = 0;
       
   191 for my $filetype (keys %package_deletions)
       
   192 {
       
   193 	$overall_deletions += $package_deletions{$filetype};
       
   194 }
       
   195 
       
   196 my $overall_additions = 0;
       
   197 for my $filetype (keys %package_additions)
       
   198 {
       
   199 	$overall_additions += $package_additions{$filetype};
       
   200 }
       
   201 
       
   202 
       
   203 $package_churn = $overall_changes + $overall_additions;
       
   204 
       
   205 print "\n\n\n\nSummary for Package: $package_name\n";
       
   206 print "-------------------\n";
       
   207 print "Changesets Compared: $dir_left and $dir_right\n";
       
   208 #print "Code Size for $dir_left = $code_size_left lines\n";
       
   209 #print "Code Size for $dir_right = $code_size_right lines\n";
       
   210 print "Total Lines Changed = $overall_changes\n";
       
   211 print "Total Lines Added = $overall_additions\n";
       
   212 print "Total Lines Deleted = $overall_deletions\n";
       
   213 print "Package Churn = $package_churn lines\n";
       
   214 
       
   215 my @header = qw(filetype a c d);
       
   216 
       
   217 my $outputfile = $Logs_Dir.'\\'."$package_name\_diffstat.csv";
       
   218 open(PKGSTATCSV, ">$outputfile") or die "Coudln't open $outputfile";
       
   219 
       
   220 
       
   221 
       
   222 print PKGSTATCSV " SF CODE-CHURN SUMMARY\n";
       
   223 print PKGSTATCSV "Package: $package_name\n";
       
   224 print PKGSTATCSV "Changesets Compared: $dir_left and $dir_right\n";
       
   225 #print PKGSTATCSV "Code Size for $dir_left = $code_size_left lines\n";
       
   226 #print PKGSTATCSV "Code Size for $dir_right = $code_size_right lines\n";
       
   227 print PKGSTATCSV "Total Lines Changed = $overall_changes\n";
       
   228 print PKGSTATCSV "Total Lines Added = $overall_additions\n";
       
   229 print PKGSTATCSV "Total Lines Deleted = $overall_deletions\n";
       
   230 print PKGSTATCSV "Package Churn = $package_churn lines\n\n\n\n\n";
       
   231 
       
   232 
       
   233 
       
   234 
       
   235 # print the header
       
   236 print PKGSTATCSV "FILENAME,";
       
   237 
       
   238 foreach my $name (@header)
       
   239 {
       
   240   if ($name eq 'filetype')
       
   241   {
       
   242 	print PKGSTATCSV uc($name).",";
       
   243   }  
       
   244   elsif ($name eq 'a')
       
   245  {
       
   246 	print PKGSTATCSV "LINES_ADDED,";
       
   247  }
       
   248   elsif ($name eq 'c')
       
   249  {
       
   250 	print PKGSTATCSV "LINES_CHANGED,";
       
   251  }
       
   252   elsif ($name eq 'd')
       
   253  {
       
   254 	print PKGSTATCSV "LINES_DELETED,";
       
   255  }
       
   256     
       
   257 }
       
   258 
       
   259 print PKGSTATCSV "\n";
       
   260 
       
   261 foreach my $file (sort keys %changes)
       
   262 {
       
   263   print PKGSTATCSV $file.",";
       
   264   foreach my $key (@header)
       
   265   {
       
   266     if(defined $changes{$file}->{$key})
       
   267     {
       
   268       print PKGSTATCSV $changes{$file}->{$key};
       
   269     }
       
   270     print PKGSTATCSV ",";
       
   271   }
       
   272   print PKGSTATCSV "\n";
       
   273 }
       
   274 
       
   275 close (PKGSTATCSV);
       
   276 
       
   277 
       
   278 
       
   279 my $diffstat_summary = $Logs_Dir.'\\'."diffstat_summary.csv";
       
   280 
       
   281 if (-e $diffstat_summary)
       
   282 { 
       
   283 	open(DIFFSTATCSV, ">>$diffstat_summary") or die "Coudln't open $outputfile";
       
   284 	print DIFFSTATCSV "$package_name,";
       
   285 	print DIFFSTATCSV "$changeset_left,";
       
   286 	print DIFFSTATCSV "$changeset_right,";
       
   287 	
       
   288 	#print DIFFSTATCSV ",";
       
   289 
       
   290 	foreach my $filetype (sort keys %package_changes)
       
   291 	{
       
   292 		if(defined $package_changes{$filetype})
       
   293 		{
       
   294 		  print DIFFSTATCSV $package_changes{$filetype}.",";
       
   295 		}
       
   296 	}
       
   297 
       
   298 	#print DIFFSTATCSV ",";
       
   299 	
       
   300 	foreach my $filetype (sort keys %package_additions)
       
   301 	{
       
   302 		if(defined $package_additions{$filetype})
       
   303 		{
       
   304 		  print DIFFSTATCSV $package_additions{$filetype}.",";
       
   305 		  
       
   306 		}
       
   307 	}
       
   308 	
       
   309 	#print DIFFSTATCSV ",";
       
   310 	
       
   311 	foreach my $filetype (sort keys %package_deletions)
       
   312 	{
       
   313 		if(defined $package_deletions{$filetype})
       
   314 		{
       
   315 		  print DIFFSTATCSV $package_deletions{$filetype}.",";
       
   316 		  #print DIFFSTATCSV ",";
       
   317 		}
       
   318 	}
       
   319 	
       
   320 	#print DIFFSTATCSV ",";
       
   321 	print DIFFSTATCSV "$overall_changes,";
       
   322 	print DIFFSTATCSV "$overall_additions,";
       
   323 	print DIFFSTATCSV "$overall_deletions,";
       
   324 	print DIFFSTATCSV "$package_churn,";
       
   325 
       
   326 	print DIFFSTATCSV "\n";
       
   327 	
       
   328 	close (DIFFSTATCSV);
       
   329 }
       
   330 else
       
   331 {
       
   332 	open(DIFFSTATCSV, ">$diffstat_summary") or die "Couldn't open $outputfile";
       
   333 
       
   334 	# print the header
       
   335 	print DIFFSTATCSV "PACKAGE_NAME,";
       
   336 	print DIFFSTATCSV "LEFT_CHANGESET,";
       
   337 	print DIFFSTATCSV "RIGHT_CHANGESET,";
       
   338 
       
   339 	#print DIFFSTATCSV ",";
       
   340 
       
   341 	foreach my $name (sort keys %package_changes)
       
   342 	{
       
   343 		print DIFFSTATCSV $name." CHANGES,";    
       
   344 	}
       
   345 	#print DIFFSTATCSV ",";
       
   346 
       
   347 
       
   348 	foreach my $name (sort keys %package_additions)
       
   349 	{
       
   350 		print DIFFSTATCSV $name." ADDITIONS,";    
       
   351 	}
       
   352 	#print DIFFSTATCSV ",";
       
   353 
       
   354 
       
   355 	foreach my $name (sort keys %package_deletions)
       
   356 	{
       
   357 		print DIFFSTATCSV $name." DELETIONS,";    
       
   358 	}
       
   359 	#print DIFFSTATCSV ",";
       
   360 	
       
   361 	print DIFFSTATCSV "PACKAGE_CHANGES,";
       
   362 	print DIFFSTATCSV "PACKAGE_ADDITIONS,";
       
   363 	print DIFFSTATCSV "PACKAGE_DELETIONS,";
       
   364 	print DIFFSTATCSV "PACKAGE_CHURN,";
       
   365 	print DIFFSTATCSV "\n";
       
   366 	
       
   367 	
       
   368 	print DIFFSTATCSV "$package_name,";
       
   369 	
       
   370 	print DIFFSTATCSV "$changeset_left,";
       
   371 	print DIFFSTATCSV "$changeset_right,";
       
   372 	
       
   373 	#print DIFFSTATCSV ",";
       
   374 
       
   375 	foreach my $filetype (sort keys %package_changes)
       
   376 	{
       
   377 		if(defined $package_changes{$filetype})
       
   378 		{
       
   379 		  print DIFFSTATCSV $package_changes{$filetype}.",";
       
   380 		}
       
   381 	}
       
   382 
       
   383 	#print DIFFSTATCSV ",";
       
   384 	
       
   385 	foreach my $filetype (sort keys %package_additions)
       
   386 	{
       
   387 		if(defined $package_additions{$filetype})
       
   388 		{
       
   389 		  print DIFFSTATCSV $package_additions{$filetype}.",";
       
   390 		  
       
   391 		}
       
   392 	}
       
   393 	
       
   394 	#print DIFFSTATCSV ",";
       
   395 	
       
   396 	foreach my $filetype (sort keys %package_deletions)
       
   397 	{
       
   398 		if(defined $package_deletions{$filetype})
       
   399 		{
       
   400 		  print DIFFSTATCSV $package_deletions{$filetype}.",";
       
   401 		}
       
   402 	}
       
   403 
       
   404 	#print DIFFSTATCSV ",";
       
   405 	print DIFFSTATCSV "$overall_changes,";
       
   406 	print DIFFSTATCSV "$overall_additions,";
       
   407 	print DIFFSTATCSV "$overall_deletions,";
       
   408 	print DIFFSTATCSV "$package_churn,";
       
   409 	
       
   410 	print DIFFSTATCSV "\n";
       
   411 	
       
   412 	close (DIFFSTATCSV);
       
   413 }
       
   414 
       
   415 
       
   416 
       
   417 }
       
   418 
       
   419 sub process_files() 
       
   420 {
       
   421     my $lfile = $_;
       
   422     my $lfile_fullpath=$File::Find::name;
       
   423     $lfile_fullpath =~ s#\/#\\#g;
       
   424     #print "$lfile\t\tFull path $lfile_fullpath\n" ;
       
   425     if (-f $lfile)
       
   426     { 
       
   427         foreach my $regpat (@file_pattern)
       
   428         {
       
   429             if (lc($lfile) =~ m/$regpat/)
       
   430             {
       
   431                 $lfile  =~ s#\/#\\#g;
       
   432                 #print "Processing file $lfile (Matched $regpat) \n"; #ck
       
   433                 #print `type $lfile`;
       
   434                 # We copy mathching files to a separate temp directory
       
   435                 # so that the final diff can simply diff the full dir
       
   436                 # Note :  RemoveNoneLOC routine edits the file in-situ.
       
   437                 my $lfile_abs = cwd().'\\'.$lfile;
       
   438                 my $lfile_local = $Logs_Dir.'\\'.$lfile_fullpath;
       
   439                 makepath($lfile_local);
       
   440                 print "%";
       
   441                 copy($lfile_abs,$lfile_local);
       
   442 				$totallinecount += RemoveNonLOC( $lfile, $lfile_local, "newdir" );
       
   443             }
       
   444         }
       
   445     }   
       
   446 }
       
   447 
       
   448 
       
   449 sub makepath()
       
   450 {
       
   451     my $absfile = shift; 
       
   452     $absfile =~ s#\\#\/#g;
       
   453     my @dirs = split /\//, $absfile;
       
   454     pop @dirs;  # throw away the filename
       
   455     my $path = "";
       
   456     foreach my $dir (@dirs)
       
   457     {
       
   458         $path = ($path eq "") ? $dir : "$path/$dir";
       
   459         if (!-d $path)
       
   460         {
       
   461 #          print "making $path \n";
       
   462           mkdir $path;
       
   463         }
       
   464     }
       
   465 }
       
   466 
       
   467 
       
   468 sub RemoveNonLOC($$$) {
       
   469 
       
   470     # Gather arguments
       
   471     my $file = shift;
       
   472     my $original_file  = shift;
       
   473     my $type_of_dir = shift;
       
   474     
       
   475 #    print("\nDebug: in ProcessFile, file is $file, full file + path is $original_file \n");
       
   476      
       
   477 	# Remove comments...
       
   478 	
       
   479     # Set up the temporary files that will be used to perform the processing steps
       
   480     my $temp1File = $original_file."temp1";
       
   481     my $temp2File = $original_file."temp2";
       
   482 	
       
   483     open(TEMP1, "+>$temp1File");
       
   484     
       
   485     if (!($countcomments)) {
       
   486     
       
   487      	# Remove any comments from the file
       
   488 		my $original_file_string;
       
   489      	open INPUT, "<", $original_file;
       
   490 		{
       
   491 			local $/ = undef;
       
   492 			$original_file_string = <INPUT>;
       
   493 		}
       
   494 		close INPUT;
       
   495  
       
   496      	my $dbl = qr/"[^"\\]*(?:\\.[^"\\]*)*"/s;
       
   497         my $sgl = qr/'[^'\\]*(?:\\.[^'\\]*)*'/s;
       
   498 
       
   499         my $C   = qr{/\*.*?\*/}s; # C style comments /*  */
       
   500         my $CPP = qr{//.*}; # C+ style comments //
       
   501         my $com = qr{$C|$CPP};
       
   502         my $other = qr{.[^/"'\\]*}s; # all other '"
       
   503         my $keep = qr{$sgl|$dbl|$other};
       
   504      
       
   505      	#Remove the comments (need to turn off warnings on the next regexp for unititialised variable)
       
   506 no warnings 'uninitialized';
       
   507 
       
   508         $original_file_string=~ s/$com|($keep)/$1/gom;  
       
   509         print TEMP1 "$original_file_string";
       
   510 
       
   511 use warnings 'uninitialized';
       
   512     }
       
   513     else {
       
   514     
       
   515         print("\n option --CountComments specified so comments will be included in the count\n");
       
   516         #Just copy over original with comments still in it
       
   517 		copy($original_file,$temp1File); 
       
   518     }
       
   519    	 
       
   520     close(TEMP1);
       
   521    	
       
   522  	  
       
   523     # Remove blank lines...
       
   524 #   print("\nDebug: Getting rid of blank lines in \n$temp1File to produce \n$temp2File \n");
       
   525     open (TEMP1, "+<$temp1File"); # include lines + pre-processed code
       
   526     open (TEMP2, "+>$temp2File"); 
       
   527     
       
   528     while (<TEMP1>) {
       
   529 		
       
   530         if (!(/^\s*\n$/)) { # if line isn't blank write it to the new file 
       
   531         print TEMP2 $_;
       
   532 	}
       
   533     }
       
   534     close(TEMP1);
       
   535     close(TEMP2);
       
   536      
       
   537     #Copy the final file to the original file. This updated file will form the input to diff later.
       
   538     #todo dont need chmod now?
       
   539     chmod(oct("0777"), $original_file) or warn "\nCannot chmod $original_file : $!\n";
       
   540 #   print("\nCopying $temp2File\n to \n$original_file\n");
       
   541     
       
   542     #system("copy /Y \"$temp2File\" \"$original_file\"") == 0
       
   543     #or print "\nERROR: Copy of $temp2File to $original_file failed\n";
       
   544     copy($temp2File,$original_file);
       
   545   	 
       
   546     # Store original file size
       
   547     
       
   548     open(LINECOUNT, ">>$Logs_Dir\\line_count_$type_of_dir.txt");
       
   549     open(SOURCEFILE, "<$original_file");
       
   550     
       
   551     my @source_code = <SOURCEFILE>;
       
   552     print  LINECOUNT "\n$original_file   ";
       
   553     my $linecount = scalar(@source_code);
       
   554 #	print  LINECOUNT scalar(@source_code);
       
   555     print  LINECOUNT $linecount; 
       
   556      
       
   557     close(LINECOUNT);
       
   558     close(SOURCEFILE);
       
   559     
       
   560     #system("del /F /Q $Logs_Dir\\line_count_$type_of_dir.txt");
       
   561 
       
   562     #Delete the temporary files
       
   563     unlink($temp1File);
       
   564     unlink($temp2File);
       
   565        
       
   566     return $linecount;   
       
   567 }