#!/bin/perl -w

# Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies).

# All rights reserved.

# This component and the accompanying materials are made available

# under the terms of "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:

# Nokia Corporation - initial contribution.

#

# Contributors:

#

# Description:

# distillsrc.pm - compiles a list of source used in .mrp files, and deletes

# any unused source

# 

#

package CDistillSrc;

use strict;

use File::Spec;

use File::Path;

use File::Basename;

use FindBin;

use lib $FindBin::Bin;

use ReadMrp;

use lib File::Spec->catdir($FindBin::Bin, '..', 'makecbr');

use CConfig;

# Constructor

#

# Parameters:

#

# $aSrcRoot : The root from which all src statements are based

# $aSrcPath : The path under aSrcRoot to the source tree to be processed

# $aSrcPrefix : An optional prefix which can be stripped from all src statements

# $aPlatform : e.g 'beech' - used to locate the platform specific product directory

#

# Returns: The object (or undef if there was a problem)

#

sub New($$$$)

	{

	my $proto = shift;

	my ($aSrcRoot, $aSrcPath, $aSrcPrefix, $aPlatform, $aCheckCase) = @_;

	my $class = ref($proto) || $proto;

	my $self = {};

	bless($self, $class);

	my $error = 0;

	if (!defined($aSrcRoot))

		{

		print "ERROR: RealTimeBuild: A srcroot must be given, to specify where all 'source' declarations originate from\n";

		$error = 1;

		}

	if (!defined($aSrcPath))

		{

		print "ERROR: RealTimeBuild: A srcpath must be given, to specify which source under the srcroot is to be filtered. Use '\\' to filter the entire srcroot\n";

		$error = 1;

		}

	if (!defined($aPlatform))

		{

		print "ERROR: RealTimeBuild: A platform must be given, to locate the product directory\n";

		$error = 1;

		}

	if ($error)

		{

		print "\n";

		}

	else

		{

		if ($aSrcPath =~ /\.\./)

			{

			print "ERROR: RealTimeBuild: The source path must be relative to the srcroot, and must not contain '..'\n";

			$error = 1;

			}

		$self->iSrcRoot($aSrcRoot);

		$self->iSrcPath($aSrcPath);

		$self->iSrcPrefix($aSrcPrefix);

		$self->iPlatform($aPlatform);

		$self->iSrcItems({});

		$self->iCheckCase(!!$aCheckCase);

		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools/unref/orphan/cedprd/SuppKit", "non-shipped");

		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools/unref/orphan/cedprd/tools", "non-shipped");

		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools/unref/orphan/cedprd/DevKit", "non-shipped");

		$self->AddSrcItem("os/buildtools/toolsandutils/productionbldtools", "non-shipped");

		}

	if ($error)

		{

		$self = undef;

		}

	return $self;

	}

# Object data

#

sub iSrcRoot()

	{

	my $self = shift;

	if (@_) { $self->{iSRCROOT} = shift; }

	return $self->{iSRCROOT};

	}

sub iSrcPath()

	{

	my $self = shift;

	if (@_) { $self->{iSRCPATH} = shift; }

	return $self->{iSRCPATH};

	}

sub iSrcPrefix()

	{

	my $self = shift;

	if (@_) { $self->{iSRCPREFIX} = shift; }

	return $self->{iSRCPREFIX};

	}

sub iPlatform()

	{

	my $self = shift;

	if (@_) { $self->{iPLATFORM} = shift; }

	return $self->{iPLATFORM};

	}

sub iSrcItems()

	{

	my $self = shift;

	if (@_) { $self->{iSRCITEMS} = shift; }

	return $self->{iSRCITEMS};

	}

sub iCheckCase()

	{

	my $self = shift;

	if (@_) { $self->{iCHECKCASE} = shift; }

	return $self->{iCHECKCASE};

	}

sub iCorrectedCase()

	{

	my $self = shift;

	if (@_) { $self->{iCORRECTEDCASE} = shift; }

	return $self->{iCORRECTEDCASE};

	}

# LoadMrps - Records the source lines out of all .mrp files

#

# Parameters:

# $aConfig - optional configuration file, as used by makecbr

# $aLists - optional component lists, as used by makecbr

# $aMrps - optional .mrp files

#

# Returns: True, if the load was successful. False otherwise

#

sub LoadMrps($$$)

	{

	my $self = shift;

	my ($aConfig, $aLists, $aMrps) = @_;

	# Load in config file

	my @lists = @$aLists;

	my @mrps;

	foreach my $mrp (@$aMrps){

		{

		push @mrps, [$mrp, ''];

		}

	}

	my @configMrps = ();

    if (defined($aConfig))

		{

		my @configs = $self->_LoadConfig($aConfig);

		# Add mrps and lists (after planting them in srcroot)

		push @lists, map($self->_PlantFile($_), @{$configs[0]});

		@configMrps = map($self->_PlantFile($_), @{$configs[1]});

		foreach my $mrp (@configMrps)

			{

			push @mrps, [$mrp, ''];

			}

		}

	# Load in mrp lists

	foreach my $file (@lists)

		{

		if (open (MRPLIST, $file))

			{

			foreach my $line (<MRPLIST>)

				{

				chomp $line;

				$line =~ s/#.*$//; # Remove comments

				$line =~ s/^\s*//; # Remove extraneous spaces

				$line =~ s/\s*$//;

				if ($line ne "")

					{

					my @parms = split(/\s+/, $line);

					if (scalar(@parms) != 2)

						{

						warn "ERROR: RealTimeBuild: Entries in component list '$file' should be of the form 'name mrp_location'. Problem in line: $line\n";

						next;

						}

					else

						{

						# Ignore *nosource* entries

						next if ($parms[1] eq '*nosource*');

						push @mrps, [$self->_PlantFile($parms[1]), $parms[0]];

						}

					}

				}

			close MRPLIST or warn "ERROR: RealTimeBuild: Couldn't close '$file' : $!\n";

			}

		else

			{

			warn "Couldn't open '$file' : $!\n";	

			}

		}

	# Load all .mrp files

	if (scalar(@mrps) == 0)

		{

		die "ERROR: RealTimeBuild: No .mrp files were specified\n";

		}

	my $loaded = 1;

	foreach my $mrp (@mrps)

		{

		# Get path of mrp file (from here)

		my ($name, $path) = fileparse($mrp->[0]);

		# Convert to path from source root

		if (!($self->_RemoveBaseFromPath($self->iSrcRoot(), \$path)))

			{

			warn "ERROR: Mrp file $mrp->[0] isn't under the source root (".$self->iSrcRoot().")\n";

			next;

			}

		my $mrpobj;

        # To indicate the correct case and where the .mrp file comes from if failed to check letter case

        if (!($self->_CheckCase($mrp->[0]))) {

            my $mrp_error_source = "optional component list(by -f) or optional .mrp list(by -m)";

            foreach my $myName (@configMrps) {

                if ($myName eq $mrp->[0]) {

                    $mrp_error_source = "config file '".$aConfig."'";

                    last;

                }

            } 

            print "WARNING: Case of '".$mrp->[0]."' supplied in ".$mrp_error_source." does not match the file system. Should be ".$self->iCorrectedCase()."\n";

        }

		if (!eval { $mrpobj = New ReadMrp($mrp->[0]) })

			{

			$loaded = 0;

			my $message = $@;

			$message =~ s/^(ERROR:\s*)?/ERROR: RealTimeBuild: /i;

			print $message;

			}

		else

			{

			my $selfowned = 0;

			my $mrpComponentName = $mrpobj->GetComponent();

			if( ($mrp->[1] ne '') && (lc($mrp->[1]) ne lc($mrpComponentName)))

				{

				print "ERROR: RealTimeBuild: Component name \'$mrp->[1]\' does not match \'$mrpComponentName\' in $mrp->[0]\n";

				}

			foreach my $srcitem (@{$mrpobj->GetSrcItems()})

				{

				if ($srcitem =~ /^[\/\\]/)

					{

					# Remove source prefix

					$srcitem = $self->_StripFile($srcitem);

					}

				else

					{

					# Relative source item

					$srcitem = File::Spec->catdir($path, $srcitem);

					}

				my $rootedmrp = $path.$name;

				if ($self->_RemoveBaseFromPath($srcitem, \$rootedmrp))

					{

					$selfowned = 1;

					}

				$self->AddSrcItem($srcitem, $mrpComponentName);

				}

			if ($self->iCheckCase())

				{

				foreach my $binexpitem (@{$mrpobj->GetBinExpItems()})

					{

					# Check lower case

					if ($binexpitem =~ /[A-Z]/)

						{

						print "REMARK: [$mrpComponentName] Binary/export file $binexpitem should be lower case\n";

						}

					}

				}

			if (!$selfowned)

				{

				print "REMARK: .mrp file '$mrp->[0]' does not include itself as source\n"; 

				}

			}

		}

	return $loaded;

	}

# AddSrcItem - Records a source file, usually taken from an .mrp file

#

# Parameters:

# $aItem - the source file name

# $aComponent - the name of the component which claimed the file

#

# Returns: None

# Dies: Not normally; only if the source hash data structure gets corrupted

sub AddSrcItem($$)

	{

	my $self = shift;

	my ($aItem, $aComponent) = @_;

	my $item = $aItem;

	# Worth checking that the file exists

	my $truePath = File::Spec->catdir($self->iSrcRoot(), $item);

	if (($item !~ /^\\component_defs/i) && (!-e $truePath))

		{

		print "ERROR: RealTimeBuild: '$aComponent' owns $item, but that path doesn't exist\n";

		$item = ""; # No point adding this path to the tree	

		}

	else

		{

		# Check case consistency

		$self->_CheckCase($truePath) or print "WARNING: [$aComponent] Case of '".$truePath."' does not match the file system. Should be ".$self->iCorrectedCase()."\n";

		}

	$item =~ s/^[\/\\]*//; # Remove preceding slashes

	my @path = split(/[\/\\]+/,$item);

	my $dir = $self->iSrcItems();

	while ((scalar @path) > 0)

		{

		my $subdir = lc(shift @path);

		if (scalar(@path) == 0)

			{

			# Just enter the final path segment

			if (exists($dir->{$subdir}))

				{

				# Someone already owns at least part of this path

				if (!ref($dir->{$subdir}))

					{

					# Someone owns the whole of this path

					my $conflict = $dir->{$subdir};

					print "REMARK: $aComponent and $conflict both own $item\n";

					}

				else

					{

					if (ref($dir->{$subdir}) ne "HASH")

						{

						die "ERROR: Source hash is corrupted\n";

						}

					else

						{

						# Someone owns a child of this path

						my $childtree = $dir->{$subdir};

						my @conflicts = $self->_GetTreeComps($childtree);

						print "REMARK: $aComponent owns $item, which is already owned by the following component(s): ".join(", ",@conflicts)."\n";

						}

					}

				}

			$dir->{$subdir} = $aComponent;

			}

		else

			{

			# Need to enter another subdirectory

			if (exists($dir->{$subdir}))

				{

				if (ref($dir->{$subdir}))

					{

					# Someone already has - just do a quick integrity check

					if (ref($dir->{$subdir}) ne "HASH")

						{

						die "ERROR: Source hash is corrupted\n";

						}

					}

				else

					{

					# The path from this point on is already owned by a component

					my $conflict = $dir->{$subdir};

					print "REMARK: $aComponent and $conflict both own $item\n";

					last;

					}

				}

			else

				{

				$dir->{$subdir} = {};

				}

			}

		$dir = $dir->{$subdir};

		}

	}

# DistillSrc - Compare the recorded source lines against the source path. Delete anything which doesn't match.

#

# Parameters:

# $aDummy - A flag - non-zero means don't actually delete

#

# Returns: None

sub DistillSrc($$)

	{

	my $self = shift;

	my ($aDummy) = @_;

	my $tree = $self->iSrcItems();

	my $path = File::Spec->catdir($self->iSrcRoot(), $self->iSrcPath());

	$path=~s/[\/\\]+/\\/; # Remove multiple slashes

	# Pop the srcpath off the front of the tree

	my @path = split(/[\/\\]/,$self->iSrcPath());

	foreach my $dir (@path)

		{

		if ($dir eq ".")

			{

			next;

			}

		elsif (exists($tree->{lc($dir)}))

			{

			$tree = $tree->{lc($dir)};

			if (!ref($tree))

				{

				# Some component owns all of the srcpath

				last;

				}

			}

		else

			{

			# No mrp files claimed any of the source

			$tree = undef;

			last;

			}

		}

	# Now recurse into the tree and delete files

	if (defined($tree))

		{

		if (ref($tree))

			{

			$self->_DistillTree($tree, $path, $aDummy);

			}

		else

			{

			print "REMARK: All source owned by component '$tree'; no action\n";

			}

		}

	else

		{

		print "WARNING: No .mrp files claim any source; removing $path\n";

		$self->_DeletePath($path, $aDummy);

		}

	}

# Print - Display the source tree

#

# Parameters:

# $aDepth - The number of levels of the tree to show. 0 = all levels

#

# Returns: None

sub Print($$)

	{

	my $self = shift;

	my ($aDepth) = @_;

	$self->_PrintTree("", $self->iSrcItems(), $aDepth);

	}

# *** Private methods ***

# *** 

# _LoadConfig - (private) Reads a configuration file, as used by makecbr

#

# Parameters:

# $aConfig - filename of the configuration file

#

# Returns:

# (files, mrps) - where files and mrps are listrefs containing component lists and

# mrp files respectively

#

sub _LoadConfig($)

	{

	my $self = shift;

	my ($aConfig) = @_;

	my @files = ();

	my @mrps = ();

	my $config = New CConfig($aConfig);

	if (!defined $config)

		{

		die "Couldn't load config file '$aConfig'\n";