common/tools/csvToSysDef.pl
changeset 271 06c2c867c6ad
child 272 f2e8947e085a
equal deleted inserted replaced
270:913e5db0bdb6 271:06c2c867c6ad
       
     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