uh_parser/truclean.pl
changeset 297 822b287b5899
parent 281 b9b02349bd48
child 311 09f57a9bad07
--- a/uh_parser/truclean.pl	Tue Jun 29 12:05:37 2010 +0100
+++ b/uh_parser/truclean.pl	Tue Jun 29 14:20:36 2010 +0100
@@ -20,92 +20,85 @@
 
 my $releaseablesdir = "";
 my $packageexpr = '';
+my $dryrun = 0;
 my $help = 0;
 GetOptions((
 	'packageexpr:s' => \$packageexpr,
 	'releaseablesdir:s' => \$releaseablesdir,
+	'dryrun!' => \$dryrun,
 	'help!' => \$help
 ));
 
-$packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),;
-my $layer_expr = $1;
-my $package_expr = $2;
-$help = 1 if (!$layer_expr or !$package_expr);
+$help = 1 if (!$packageexpr);
 
 if ($help)
 {
-	print "Extracts text which doesn't belong to recipes from a raptor log file\n";
-	print "Usage: perl truclean.pl --packageexpr=LAYER_EXPR/PACKAGE_EXPR [OPTIONS]\n";
-	print "where:\n";
-	print "\tLAYER_EXPR can be * or the name of a layer\n";
-	print "\tPACKAGE_EXPR can be * or the name of a package\n";
-	print "and OPTIONS are:\n";
-	print "\t--releaseablesdir=DIR Use DIR as the root of the releaseables dir (default: $RELEASEABLES_DIR_DEFAULT\n";
+	print <<_EOH;
+truclean
+Performs a 'clean' build step, based on the releaseables information, i.e. the
+list of artifacts produced during a PDK build.
+This cleaning step ensures all the build artifacts produced by the build are
+actually removed even if the source code has changed since the PDK build. 
+
+Usage: truclean.pl -p PACKAGE_EXPR [-r RELEASABLES_DIR] [-d]
+
+Options:
+  -h, --help            Show this help message and exit
+  -p PACKAGE_EXPR       Clean (remove) build artifacts belonging to the package
+                        or packages indicated by PACKAGE_EXPR.
+                        PACKAGE_EXPR is the path (wildcards allowed) of the
+                        package, e.g. 'sf/app/camera' or 'sf/mw/*' or '*/*/*'.
+                        If the first directory level is not specified then 'sf'
+                        is assumed. 
+  -r RELEASABLES_DIR    Use RELEASEABLES_DIR as root of the releaseable files
+                        (default is $RELEASEABLES_DIR_DEFAULT).
+  -d                    Dry run (Do not remove files for real)
+_EOH
 	exit(0);
 }
 
 $releaseablesdir = $RELEASEABLES_DIR_DEFAULT if (!$releaseablesdir);
 
-my @layers = ();
-if ($layer_expr eq '*')
+$packageexpr =~ s,\\,/,g;
+$packageexpr =~ s,//,/,g;
+$packageexpr =~ s,^/,,;
+if (-d "$releaseablesdir/sf")
 {
-	opendir(DIR, $releaseablesdir);
-	@layers = readdir(DIR);
-	closedir(DIR);
-	@layers = grep(!/^\.\.?$/, @layers);
-}
-else
-{
-	push(@layers, $layer_expr);
+	$packageexpr = "sf/$packageexpr" if ($packageexpr =~ m,^(adaptation|app|mw|os|tools),);
 }
-#for (@layers) {print "$_\n"};
 
-for my $layer (@layers)
+my @targetfiles = grep {-f$_} glob("$releaseablesdir/$packageexpr/info.tsv");
+print join("\n", @targetfiles);
+
+for my $targetfile (@targetfiles)
 {
-	my @packages = ();
-	if ($package_expr eq '*')
-	{
-		opendir(DIR, "$releaseablesdir/$layer");
-		@packages = readdir(DIR);
-		closedir(DIR);
-		@packages = grep(!/^\.\.?$/, @packages);
-	}
-	else
+	print "Processing $targetfile...\n";
+
+	open(FILE, $targetfile);
+	while (<FILE>)
 	{
-		push(@packages, $package_expr);
-	}
-	#for (@pacakges) {print "$_\n"};
-	
-	for my $package (@packages)
-	{
-		print "Processing package $layer/$package...\n";
-
-		open(FILE, "$releaseablesdir/$layer/$package/info.tsv");
-		while (<FILE>)
+		my $line = $_;
+		
+		if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),)
 		{
-			my $line = $_;
+			my $file = $1;
+			my $type = $2;
+			my $config = $3;
 			
-			if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),)
+			if (-f $file)
 			{
-				my $file = $1;
-				my $type = $2;
-				my $config = $3;
-				
-				if (-f $file)
-				{
-					print "removing file: '$file'\n";
-					unlink($file);
-				}
-				else
-				{
-					print "WARNING: file '$file' doesn't exist.\n";
-				}
+				print "removing file: '$file'\n";
+				unlink($file) if (!$dryrun);
 			}
 			else
 			{
-				print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n";
+				print "WARNING: file '$file' doesn't exist.\n";
 			}
 		}
-		close(FILE);
+		else
+		{
+			print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n";
+		}
 	}
-}
\ No newline at end of file
+	close(FILE);
+}