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 ">";
}