# Copyright (c) 2009 Symbian Foundation Ltd
# This component and the accompanying materials are made available
# under the terms of the License "Eclipse Public License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
#
# Initial Contributors:
# Symbian Foundation Ltd - initial contribution.
#
# Contributors:
#
# Description:
# Extracts output text in <buildlog> context which doesn't belong to <recipe>'s

use strict;
use Getopt::Long;

my $DELIVERABLES_DIR = "/deliverables";

my $deliverablesdir = "";
my $packageexpr = '';
my $help = 0;
GetOptions((
	'packageexpr:s' => \$packageexpr,
	'deliverablesdir:s' => \$DELIVERABLES_DIR,
	'help!' => \$help
));

$packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),;
my $layer_expr = $1;
my $package_expr = $2;
$help = 1 if (!$layer_expr or !$package_expr);

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--deliverablesdir=DIR Use DIR as the root of the deliverables dir (default: $DELIVERABLES_DIR\n";
	exit(0);
}

$DELIVERABLES_DIR = $deliverablesdir if ($deliverablesdir);

my @layers = ();
if ($layer_expr eq '*')
{
	opendir(DIR, $DELIVERABLES_DIR);
	@layers = readdir(DIR);
	closedir(DIR);
	@layers = grep(!/^\.\.?$/, @layers);
}
else
{
	push(@layers, $layer_expr);
}
#for (@layers) {print "$_\n"};

for my $layer (@layers)
{
	my @packages = ();
	if ($package_expr eq '*')
	{
		opendir(DIR, "$DELIVERABLES_DIR/$layer");
		@packages = readdir(DIR);
		closedir(DIR);
		@packages = grep(!/^\.\.?$/, @packages);
	}
	else
	{
		push(@packages, $package_expr);
	}
	#for (@pacakges) {print "$_\n"};
	
	for my $package (@packages)
	{
		print "Processing package $layer/$package...\n";

		open(FILE, "$DELIVERABLES_DIR/$layer/$package/info.tsv");
		while (<FILE>)
		{
			my $line = $_;
			
			if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),)
			{
				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";
				}
			}
			else
			{
				print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n";
			}
		}
		close(FILE);
	}
}