1 #!perl -w

     2 

     3 use strict;

     4 

     5 use XML::Parser;

     6 use Data::Dumper;

     7 use Text::CSV;

     8 

     9 my $sourcesCSV = shift or die "First arg must be source csv file";

    10 shift and die "No more than one argument please";

    11 

    12 # Load CSV

    13 open my $csvText, "<", $sourcesCSV or die;

    14 my $csv = Text::CSV->new();

    15 my @keys;

    16 my @packages;

    17 while (my $line = <$csvText>)

    18 {

    19 	chomp $line;

    20 	next unless $line;

    21 	unless ($csv->parse($line))

    22 	{

    23 		my $err = $csv->error_input();

    24 		die "Failed to parse line '$line': $err";

    25 	}

    26 

    27 	if (! @keys)

    28 	{

    29 		# First line - note the column names

    30 		@keys =  $csv->fields();

    31 	}

    32 	else

    33 	{

    34 		# Already got the keys, so get the data

    35 		my %package;

    36 		# Read into a hash slice

    37 		@package{@keys} = $csv->fields();

    38 		push @packages, \%package;

    39 	}

    40 }

    41 close $csvText;

    42 

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

    44 my $outTree;

    45 

    46 # For each package in CSV...

    47 foreach my $package (@packages)

    48 {

    49 	warn "Warning: Package $package->{dst} does not appear on the local system\n" unless -d $package->{dst};

    50 	# Look for the pkg defn in the root of the package tree

    51 	my $pkgDef = "$package->{dst}/$package->{sysdef}";

    52 	if (!-f $pkgDef)

    53 	{

    54 		# Not there, so try the "backup" location

    55 		$pkgDef =~ s{^/sf/}{};

    56 		$pkgDef =~ s{/[^/]*$}{};

    57 		# TODO: Where will this be on the build machine?

    58 		$pkgDef = "./packages/3k/$pkgDef/package_definition.xml";

    59 	}

    60 	die unless -f $pkgDef;

    61 

    62 	my $pkgTree = $parser->parsefile($pkgDef) or die;

    63 	if (!$outTree)

    64 	{

    65 		# The first file is taken verbatim

    66 		$outTree = $pkgTree;

    67 	}

    68 	else

    69 	{

    70 		# Merge into output Tree

    71 		mergeTrees($outTree->[0], $pkgTree->[0]);

    72 	}

    73 }

    74 

    75 #print Data::Dumper->Dump([$outTree->[0]], ["tree"]);

    76 

    77 # Output total tree

    78 print "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";

    79 printTree($outTree->[0]);

    80 print "\n";

    81 

    82 sub mergeTrees

    83 {

    84 	my $baseTree = shift or die;

    85 	my $extrasTree = shift or die;

    86 

    87 	die unless ref $baseTree eq ref $extrasTree;

    88 	return if ref $baseTree eq "main::Characters";

    89 

    90 	foreach my $extraChild (@{$extrasTree->{Kids}})

    91 	{

    92 		# Work out whether this child should be merged with a namesake, or appended

    93 		my $mergeIt = undef;

    94 

    95 		my $extraChildTag = ref $extraChild;

    96 		$extraChildTag =~ s{^main::}{};

    97 		

    98 		if ($extraChildTag =~ m{^(SystemDefinition|systemModel)$})

    99 		{

   100 			# Should be merged if there's already one there

   101 #			warn "Always merge $extraChildTag";

   102 			# Look for a namesake in the base

   103 			$mergeIt = matchTag($baseTree->{Kids}, $extraChild, undef);

   104 		}

   105 		elsif ($extraChildTag =~ m{layer|block|package|collection|component})

   106 		{

   107 			# Should be merged if there is another tag with the same "name" attribute

   108 #			warn "Sometimes merge $extraChildTag";

   109 			# Look for a namesake in the base

   110 			$mergeIt = matchTag($baseTree->{Kids}, $extraChild, "name");

   111 		}

   112 

   113 		if ($mergeIt)

   114 		{

   115 			# Merge children

   116 			mergeTrees($mergeIt, $extraChild);

   117 		}

   118 		else

   119 		{

   120 			# Add this child

   121 			push @{$baseTree->{Kids}}, $extraChild;

   122 		}

   123 	}

   124 }

   125 

   126 sub matchTag

   127 {

   128 	my $peers = shift;

   129 	my $outsider = shift;

   130 	my $attr = shift;

   131 

   132 	foreach my $peer (@$peers)

   133 	{

   134 		if (ref $peer eq ref $outsider && (!defined $attr || $peer->{$attr} eq $outsider->{$attr}))

   135 		{

   136 			return $peer;

   137 		}

   138 	}

   139 	

   140 	return undef;

   141 }

   142 

   143 sub printTree

   144 {

   145 	my $tree = shift or die;

   146 	die unless ref $tree;

   147 

   148 	my $tagName = ref $tree;

   149 	$tagName =~ s{^main::}{};

   150 	if ($tagName eq "Characters")

   151 	{

   152 		print $tree->{Text};

   153 		return;

   154 	}

   155 	

   156 	print "<$tagName";

   157 

   158 	foreach my $attr (grep { ! ref $tree->{$_} } keys %$tree)

   159 	{

   160 		print " $attr=\"$tree->{$attr}\"";

   161 	}

   162 

   163 	my $children = $tree->{Kids};

   164 	if (scalar @$children)

   165 	{

   166 		print ">";

   167 		foreach my $child (@$children)

   168 		{

   169 			printTree($child);

   170 		}

   171 		print "</$tagName";

   172 	}

   173 	else

   174 	{

   175 		print "/"

   176 	}

   177 

   178 	print ">";

   179 }

   180