uh_parser/truclean.pl
changeset 271 822b287b5899
parent 258 b9b02349bd48
child 284 09f57a9bad07
equal deleted inserted replaced
270:7f69aca41ac4 271:822b287b5899
    18 
    18 
    19 my $RELEASEABLES_DIR_DEFAULT = "\\build_info\\logs\\releaseables";
    19 my $RELEASEABLES_DIR_DEFAULT = "\\build_info\\logs\\releaseables";
    20 
    20 
    21 my $releaseablesdir = "";
    21 my $releaseablesdir = "";
    22 my $packageexpr = '';
    22 my $packageexpr = '';
       
    23 my $dryrun = 0;
    23 my $help = 0;
    24 my $help = 0;
    24 GetOptions((
    25 GetOptions((
    25 	'packageexpr:s' => \$packageexpr,
    26 	'packageexpr:s' => \$packageexpr,
    26 	'releaseablesdir:s' => \$releaseablesdir,
    27 	'releaseablesdir:s' => \$releaseablesdir,
       
    28 	'dryrun!' => \$dryrun,
    27 	'help!' => \$help
    29 	'help!' => \$help
    28 ));
    30 ));
    29 
    31 
    30 $packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),;
    32 $help = 1 if (!$packageexpr);
    31 my $layer_expr = $1;
       
    32 my $package_expr = $2;
       
    33 $help = 1 if (!$layer_expr or !$package_expr);
       
    34 
    33 
    35 if ($help)
    34 if ($help)
    36 {
    35 {
    37 	print "Extracts text which doesn't belong to recipes from a raptor log file\n";
    36 	print <<_EOH;
    38 	print "Usage: perl truclean.pl --packageexpr=LAYER_EXPR/PACKAGE_EXPR [OPTIONS]\n";
    37 truclean
    39 	print "where:\n";
    38 Performs a 'clean' build step, based on the releaseables information, i.e. the
    40 	print "\tLAYER_EXPR can be * or the name of a layer\n";
    39 list of artifacts produced during a PDK build.
    41 	print "\tPACKAGE_EXPR can be * or the name of a package\n";
    40 This cleaning step ensures all the build artifacts produced by the build are
    42 	print "and OPTIONS are:\n";
    41 actually removed even if the source code has changed since the PDK build. 
    43 	print "\t--releaseablesdir=DIR Use DIR as the root of the releaseables dir (default: $RELEASEABLES_DIR_DEFAULT\n";
    42 
       
    43 Usage: truclean.pl -p PACKAGE_EXPR [-r RELEASABLES_DIR] [-d]
       
    44 
       
    45 Options:
       
    46   -h, --help            Show this help message and exit
       
    47   -p PACKAGE_EXPR       Clean (remove) build artifacts belonging to the package
       
    48                         or packages indicated by PACKAGE_EXPR.
       
    49                         PACKAGE_EXPR is the path (wildcards allowed) of the
       
    50                         package, e.g. 'sf/app/camera' or 'sf/mw/*' or '*/*/*'.
       
    51                         If the first directory level is not specified then 'sf'
       
    52                         is assumed. 
       
    53   -r RELEASABLES_DIR    Use RELEASEABLES_DIR as root of the releaseable files
       
    54                         (default is $RELEASEABLES_DIR_DEFAULT).
       
    55   -d                    Dry run (Do not remove files for real)
       
    56 _EOH
    44 	exit(0);
    57 	exit(0);
    45 }
    58 }
    46 
    59 
    47 $releaseablesdir = $RELEASEABLES_DIR_DEFAULT if (!$releaseablesdir);
    60 $releaseablesdir = $RELEASEABLES_DIR_DEFAULT if (!$releaseablesdir);
    48 
    61 
    49 my @layers = ();
    62 $packageexpr =~ s,\\,/,g;
    50 if ($layer_expr eq '*')
    63 $packageexpr =~ s,//,/,g;
       
    64 $packageexpr =~ s,^/,,;
       
    65 if (-d "$releaseablesdir/sf")
    51 {
    66 {
    52 	opendir(DIR, $releaseablesdir);
    67 	$packageexpr = "sf/$packageexpr" if ($packageexpr =~ m,^(adaptation|app|mw|os|tools),);
    53 	@layers = readdir(DIR);
       
    54 	closedir(DIR);
       
    55 	@layers = grep(!/^\.\.?$/, @layers);
       
    56 }
    68 }
    57 else
    69 
       
    70 my @targetfiles = grep {-f$_} glob("$releaseablesdir/$packageexpr/info.tsv");
       
    71 print join("\n", @targetfiles);
       
    72 
       
    73 for my $targetfile (@targetfiles)
    58 {
    74 {
    59 	push(@layers, $layer_expr);
    75 	print "Processing $targetfile...\n";
    60 }
       
    61 #for (@layers) {print "$_\n"};
       
    62 
    76 
    63 for my $layer (@layers)
    77 	open(FILE, $targetfile);
    64 {
    78 	while (<FILE>)
    65 	my @packages = ();
       
    66 	if ($package_expr eq '*')
       
    67 	{
    79 	{
    68 		opendir(DIR, "$releaseablesdir/$layer");
    80 		my $line = $_;
    69 		@packages = readdir(DIR);
    81 		
    70 		closedir(DIR);
    82 		if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),)
    71 		@packages = grep(!/^\.\.?$/, @packages);
       
    72 	}
       
    73 	else
       
    74 	{
       
    75 		push(@packages, $package_expr);
       
    76 	}
       
    77 	#for (@pacakges) {print "$_\n"};
       
    78 	
       
    79 	for my $package (@packages)
       
    80 	{
       
    81 		print "Processing package $layer/$package...\n";
       
    82 
       
    83 		open(FILE, "$releaseablesdir/$layer/$package/info.tsv");
       
    84 		while (<FILE>)
       
    85 		{
    83 		{
    86 			my $line = $_;
    84 			my $file = $1;
       
    85 			my $type = $2;
       
    86 			my $config = $3;
    87 			
    87 			
    88 			if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),)
    88 			if (-f $file)
    89 			{
    89 			{
    90 				my $file = $1;
    90 				print "removing file: '$file'\n";
    91 				my $type = $2;
    91 				unlink($file) if (!$dryrun);
    92 				my $config = $3;
       
    93 				
       
    94 				if (-f $file)
       
    95 				{
       
    96 					print "removing file: '$file'\n";
       
    97 					unlink($file);
       
    98 				}
       
    99 				else
       
   100 				{
       
   101 					print "WARNING: file '$file' doesn't exist.\n";
       
   102 				}
       
   103 			}
    92 			}
   104 			else
    93 			else
   105 			{
    94 			{
   106 				print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n";
    95 				print "WARNING: file '$file' doesn't exist.\n";
   107 			}
    96 			}
   108 		}
    97 		}
   109 		close(FILE);
    98 		else
       
    99 		{
       
   100 			print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n";
       
   101 		}
   110 	}
   102 	}
       
   103 	close(FILE);
   111 }
   104 }