|
1 #!perl -w |
|
2 # Copyright (c) 2009 Symbian Foundation Ltd |
|
3 # This component and the accompanying materials are made available |
|
4 # under the terms of the License "Eclipse Public License v1.0" |
|
5 # which accompanies this distribution, and is available |
|
6 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
7 # |
|
8 # Initial Contributors: |
|
9 # Symbian Foundation Ltd - initial contribution. |
|
10 # |
|
11 # Contributors: |
|
12 # |
|
13 # Description: |
|
14 # Merge a set of XML files |
|
15 |
|
16 use strict; |
|
17 |
|
18 use XML::Parser; |
|
19 use Getopt::Long; |
|
20 |
|
21 # Read option arguments |
|
22 my $howtoString; |
|
23 my $xslLink; |
|
24 my $help; |
|
25 GetOptions(( |
|
26 'xsl=s' => \$xslLink, |
|
27 'merge=s' => \$howtoString, |
|
28 'help!' => \$help, |
|
29 )); |
|
30 |
|
31 my $wrongArgs = 0; |
|
32 unless ($help) |
|
33 { |
|
34 $wrongArgs += warn "No merge string specified to indicate how the files should be merged\n" unless defined $howtoString; |
|
35 $wrongArgs += warn "No files to be merged\n" unless scalar @ARGV; |
|
36 } |
|
37 if ($help || $wrongArgs) |
|
38 { |
|
39 print <<"EOT"; |
|
40 |
|
41 mergeXML.pl --xsl=brag.xsl --merge=SystemDefinition,systemModel,layer(name),block(name),package(name) sysModel1.xml [model2.xml ...] > output.xml |
|
42 EOT |
|
43 exit(0 + !$help); |
|
44 } |
|
45 |
|
46 # Hash of tags that should be merged, with optional attribute consideration |
|
47 my $mergeTags; |
|
48 foreach my $term (split m{\s*,\s*}, $howtoString) |
|
49 { |
|
50 my ($tag, $attribute) = $term =~ m{(\w+)\((\w+)\)}; |
|
51 $tag ||= $term; |
|
52 $mergeTags->{$tag} = $attribute; |
|
53 } |
|
54 |
|
55 # Merge all the trees together |
|
56 my $outTree = mergeMultipleTrees($mergeTags, @ARGV); |
|
57 |
|
58 # Output total tree |
|
59 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; |
|
60 print "<?xml-stylesheet type=\"text/xsl\" href=\"$xslLink\"?>\n" if $xslLink; |
|
61 printTree($outTree->[0]); |
|
62 print "\n"; |
|
63 |
|
64 exit(0); |
|
65 |
|
66 sub mergeMultipleTrees |
|
67 { |
|
68 my $mergeTags = shift or die; |
|
69 |
|
70 # Create an XML parser |
|
71 my $parser = new XML::Parser(Style => "Objects") or die; |
|
72 |
|
73 my $outTree; |
|
74 # For each XML file to merge... |
|
75 foreach my $xmlFile (@_) |
|
76 { |
|
77 my $tree = eval { $parser->parsefile($xmlFile) } or die "Failed to parse $xmlFile : $@"; |
|
78 if (!$outTree) |
|
79 { |
|
80 # The first file is taken verbatim |
|
81 $outTree = $tree; |
|
82 } |
|
83 else |
|
84 { |
|
85 # Merge into output Tree |
|
86 mergeTwoTrees($outTree->[0], $tree->[0], $mergeTags); |
|
87 } |
|
88 } |
|
89 |
|
90 return $outTree; |
|
91 } |
|
92 |
|
93 sub mergeTwoTrees |
|
94 { |
|
95 my $baseTree = shift or die; |
|
96 my $extrasTree = shift or die; |
|
97 my $mergeTags = shift or die; |
|
98 |
|
99 die ("Trees do not match: ".(ref $baseTree)." vs ".(ref $extrasTree)) unless ref $baseTree eq ref $extrasTree; |
|
100 return if ref $baseTree eq "main::Characters"; |
|
101 |
|
102 foreach my $extraChild (@{$extrasTree->{Kids}}) |
|
103 { |
|
104 # Work out whether this child should be merged with a namesake, or appended |
|
105 my $mergeIt; |
|
106 |
|
107 my $extraChildTag = ref $extraChild; |
|
108 $extraChildTag =~ s{^main::}{}; |
|
109 |
|
110 if (exists $mergeTags->{$extraChildTag}) |
|
111 { |
|
112 # Should be merged if there's already one there |
|
113 # Look for a namesake in the base |
|
114 $mergeIt = matchTag($baseTree->{Kids}, $extraChild, $mergeTags->{$extraChildTag}); |
|
115 } |
|
116 |
|
117 if ($mergeIt) |
|
118 { |
|
119 # Merge children |
|
120 mergeTwoTrees($mergeIt, $extraChild, $mergeTags); |
|
121 } |
|
122 else |
|
123 { |
|
124 # Add this child |
|
125 push @{$baseTree->{Kids}}, $extraChild; |
|
126 } |
|
127 } |
|
128 } |
|
129 |
|
130 sub matchTag |
|
131 { |
|
132 my $peers = shift; |
|
133 my $outsider = shift; |
|
134 my $attr = shift; |
|
135 |
|
136 foreach my $peer (@$peers) |
|
137 { |
|
138 if (ref $peer eq ref $outsider && (!defined $attr || $peer->{$attr} eq $outsider->{$attr})) |
|
139 { |
|
140 return $peer; |
|
141 } |
|
142 } |
|
143 |
|
144 return undef; |
|
145 } |
|
146 |
|
147 sub printTree |
|
148 { |
|
149 my $tree = shift or die; |
|
150 die unless ref $tree; |
|
151 |
|
152 my $tagName = ref $tree; |
|
153 $tagName =~ s{^main::}{}; |
|
154 if ($tagName eq "Characters") |
|
155 { |
|
156 print $tree->{Text}; |
|
157 return; |
|
158 } |
|
159 |
|
160 print "<$tagName"; |
|
161 |
|
162 foreach my $attr ( |
|
163 sort |
|
164 grep { |
|
165 ! ref $tree->{$_} |
|
166 } |
|
167 keys %$tree) |
|
168 { |
|
169 print " $attr=\"$tree->{$attr}\""; |
|
170 } |
|
171 |
|
172 my $children = $tree->{Kids}; |
|
173 if (scalar @$children) |
|
174 { |
|
175 print ">"; |
|
176 foreach my $child (@$children) |
|
177 { |
|
178 printTree($child); |
|
179 } |
|
180 print "</$tagName"; |
|
181 } |
|
182 else |
|
183 { |
|
184 print "/" |
|
185 } |
|
186 |
|
187 print ">"; |
|
188 } |
|
189 |
|
190 |