Re-apply changes to allow sources.csv to specify a revision by a *local* tag in the web repository.
Uses "hg id" instead of "hg in", so not affected by the aborts we had previously. And no need for an empty repo this time either.
#!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 ">";
}