diff -r 57a2cac6870f -r 0c558d696e7a common/tools/csvToSysDef.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/common/tools/csvToSysDef.pl	Mon Aug 24 11:01:37 2009 +0100
@@ -0,0 +1,195 @@
+#!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 ">";
+}
+