common/tools/raptor/truclean.pl
changeset 270 48a6e55f691b
parent 242 51e429810aba
equal deleted inserted replaced
269:cdf0b7c501d2 270:48a6e55f691b
       
     1 # Copyright (c) 2009 Symbian Foundation Ltd
       
     2 # This component and the accompanying materials are made available
       
     3 # under the terms of the License "Eclipse Public License v1.0"
       
     4 # which accompanies this distribution, and is available
       
     5 # at the URL "http://www.eclipse.org/legal/epl-v10.html".
       
     6 #
       
     7 # Initial Contributors:
       
     8 # Symbian Foundation Ltd - initial contribution.
       
     9 #
       
    10 # Contributors:
       
    11 #
       
    12 # Description:
       
    13 # Extracts output text in <buildlog> context which doesn't belong to <recipe>'s
       
    14 
       
    15 use strict;
       
    16 use Getopt::Long;
       
    17 
       
    18 my $RELEASEABLES_DIR = "/releaseables";
       
    19 
       
    20 my $releaseablesdir = "";
       
    21 my $packageexpr = '';
       
    22 my $help = 0;
       
    23 GetOptions((
       
    24 	'packageexpr:s' => \$packageexpr,
       
    25 	'releaseablesdir:s' => \$RELEASEABLES_DIR,
       
    26 	'help!' => \$help
       
    27 ));
       
    28 
       
    29 $packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),;
       
    30 my $layer_expr = $1;
       
    31 my $package_expr = $2;
       
    32 $help = 1 if (!$layer_expr or !$package_expr);
       
    33 
       
    34 if ($help)
       
    35 {
       
    36 	print "Extracts text which doesn't belong to recipes from a raptor log file\n";
       
    37 	print "Usage: perl truclean.pl --packageexpr=LAYER_EXPR/PACKAGE_EXPR [OPTIONS]\n";
       
    38 	print "where:\n";
       
    39 	print "\tLAYER_EXPR can be * or the name of a layer\n";
       
    40 	print "\tPACKAGE_EXPR can be * or the name of a package\n";
       
    41 	print "and OPTIONS are:\n";
       
    42 	print "\t--releaseablesdir=DIR Use DIR as the root of the releaseables dir (default: $RELEASEABLES_DIR\n";
       
    43 	exit(0);
       
    44 }
       
    45 
       
    46 $RELEASEABLES_DIR = $releaseablesdir if ($releaseablesdir);
       
    47 
       
    48 my @layers = ();
       
    49 if ($layer_expr eq '*')
       
    50 {
       
    51 	opendir(DIR, $RELEASEABLES_DIR);
       
    52 	@layers = readdir(DIR);
       
    53 	closedir(DIR);
       
    54 	@layers = grep(!/^\.\.?$/, @layers);
       
    55 }
       
    56 else
       
    57 {
       
    58 	push(@layers, $layer_expr);
       
    59 }
       
    60 #for (@layers) {print "$_\n"};
       
    61 
       
    62 for my $layer (@layers)
       
    63 {
       
    64 	my @packages = ();
       
    65 	if ($package_expr eq '*')
       
    66 	{
       
    67 		opendir(DIR, "$RELEASEABLES_DIR/$layer");
       
    68 		@packages = readdir(DIR);
       
    69 		closedir(DIR);
       
    70 		@packages = grep(!/^\.\.?$/, @packages);
       
    71 	}
       
    72 	else
       
    73 	{
       
    74 		push(@packages, $package_expr);
       
    75 	}
       
    76 	#for (@pacakges) {print "$_\n"};
       
    77 	
       
    78 	for my $package (@packages)
       
    79 	{
       
    80 		print "Processing package $layer/$package...\n";
       
    81 
       
    82 		open(FILE, "$RELEASEABLES_DIR/$layer/$package/info.tsv");
       
    83 		while (<FILE>)
       
    84 		{
       
    85 			my $line = $_;
       
    86 			
       
    87 			if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),)
       
    88 			{
       
    89 				my $file = $1;
       
    90 				my $type = $2;
       
    91 				my $config = $3;
       
    92 				
       
    93 				if (-f $file)
       
    94 				{
       
    95 					print "removing file: '$file'\n";
       
    96 					unlink($file);
       
    97 				}
       
    98 				else
       
    99 				{
       
   100 					print "WARNING: file '$file' doesn't exist.\n";
       
   101 				}
       
   102 			}
       
   103 			else
       
   104 			{
       
   105 				print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n";
       
   106 			}
       
   107 		}
       
   108 		close(FILE);
       
   109 	}
       
   110 }