common/tools/csvToSysDef.pl
author Simon Howkins <simonh@symbian.org>
Thu, 10 Dec 2009 12:01:59 +0000
changeset 825 1de547e13d13
parent 344 348670fc497a
child 961 94716c328941
permissions -rw-r--r--
Updates to make the build environment check more reasonable: Mercurial v1.3 permitted The Java compiler is not a showstopping issue 7-zip can be installed in any location Update to Helium 5 Helium can be installed in PDT 1.*, not necessarily 1.0 Raptor installation path not significant Update to Raptor 2.9.* The Raptor patch to update the bundled version of python is no longer relevant BRAG calculations updated to ignore items not being in the system path, as this just doesn't matter. Overall effect is that the build environment check should pass on a machine that is able to do a build!

#!perl -w

use strict;

use FindBin;
use lib "$FindBin::Bin/lib";

use XML::Parser;
use Text::CSV;

my $sourcesCSV = shift or die "First arg must be source csv file";
my $backupBaseDir = shift or die "Second arg must be path to tree of package_definitions to use if not found in the source packages";
shift and die "No more than two arguments please";

# Load CSV
open my $csvText, "<", $sourcesCSV or die;
my $csv = Text::CSV->new();
my @keys;
my @packages;
while (my $line = <$csvText>)
{
	chomp $line;
	next unless $line;
	unless ($csv->parse($line))
	{
		my $err = $csv->error_input();
		die "Failed to parse line '$line': $err";
	}

	if (! @keys)
	{
		# First line - note the column names
		@keys =  $csv->fields();
	}
	else
	{
		# Already got the keys, so get the data
		my %package;
		# Read into a hash slice
		@package{@keys} = $csv->fields();
		push @packages, \%package;
	}
}
close $csvText;

my $parser = new XML::Parser(Style => "Objects") or die;
my $outTree;

# For each package in CSV...
foreach my $package (@packages)
{
	# If the sources.csv does not include a sys def for this package, it doesn't get built
	next unless $package->{sysdef};
	# If it's in the "backup" location, use that one (ie our copy overrides the package's own copy)
	my $pkgDef = "$package->{dst}/$package->{sysdef}";
	$pkgDef =~ s{^/sf/}{};
	$pkgDef =~ s{/[^/]*$}{};
	$pkgDef = "$backupBaseDir/$pkgDef/package_definition.xml";
	if (!-f $pkgDef)
	{
		# Not there, so look for the pkg defn in the root of the package tree
		warn "Warning: Package $package->{dst} does not appear on the local system\n" unless -d $package->{dst};
		$pkgDef = "$package->{dst}/$package->{sysdef}";
	}
	die "Unable to locate any package_definition at all for $package->{dst}" unless -f $pkgDef;

	warn "Including $pkgDef for $package->{dst}\n";
	my $pkgTree = eval { $parser->parsefile($pkgDef) } or die "Failed to parse $pkgDef : $@";
	if (!$outTree)
	{
		# The first file is taken verbatim
		$outTree = $pkgTree;
	}
	else
	{
		# Merge into output Tree
		mergeTrees($outTree->[0], $pkgTree->[0]);
	}
}

# Output total tree
print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
printTree($outTree->[0]);
print "\n";

exit;

sub mergeTrees
{
	my $baseTree = shift or die;
	my $extrasTree = shift or die;

	die ("Package Definitions do not match: ".(ref $baseTree)." vs ".(ref $extrasTree)) unless ref $baseTree eq ref $extrasTree;
	return if ref $baseTree eq "main::Characters";

	foreach my $extraChild (@{$extrasTree->{Kids}})
	{
		# Work out whether this child should be merged with a namesake, or appended
		my $mergeIt = undef;

		my $extraChildTag = ref $extraChild;
		$extraChildTag =~ s{^main::}{};
		
		if ($extraChildTag =~ m{^(SystemDefinition|systemModel)$})
		{
			# Should be merged if there's already one there
			# Look for a namesake in the base
			$mergeIt = matchTag($baseTree->{Kids}, $extraChild, undef);
		}
		elsif ($extraChildTag =~ m{layer|block|package|collection|component})
		{
			# Should be merged if there is another tag with the same "name" attribute
			# Look for a namesake in the base
			$mergeIt = matchTag($baseTree->{Kids}, $extraChild, "name");
		}

		if ($mergeIt)
		{
			# Merge children
			mergeTrees($mergeIt, $extraChild);
		}
		else
		{
			# Add this child
			push @{$baseTree->{Kids}}, $extraChild;
		}
	}
}

sub matchTag
{
	my $peers = shift;
	my $outsider = shift;
	my $attr = shift;

	foreach my $peer (@$peers)
	{
		if (ref $peer eq ref $outsider && (!defined $attr || $peer->{$attr} eq $outsider->{$attr}))
		{
			return $peer;
		}
	}
	
	return undef;
}

sub printTree
{
	my $tree = shift or die;
	die unless ref $tree;

	my $tagName = ref $tree;
	$tagName =~ s{^main::}{};
	if ($tagName eq "Characters")
	{
		print $tree->{Text};
		return;
	}
	
	print "<$tagName";

	foreach my $attr (
		sort {
			my $order = "name long-name tech_domain level span schema levels filter introduced deprecated purpose class plugin origin-model bldFile mrp version priority";
			my $ixA = index $order, $a;
			my $ixB = index $order, $b;
			die "$a $b" if $ixA + $ixB == -2;
			$ixA - $ixB;
		}
		grep {
			! ref $tree->{$_}
		}
		keys %$tree)
	{
		print " $attr=\"$tree->{$attr}\"";
	}

	my $children = $tree->{Kids};
	if (scalar @$children)
	{
		print ">";
		foreach my $child (@$children)
		{
			printTree($child);
		}
		print "</$tagName";
	}
	else
	{
		print "/"
	}

	print ">";
}