655
|
1 |
# Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies).
|
|
2 |
# All rights reserved.
|
|
3 |
# This component and the accompanying materials are made available
|
|
4 |
# under the terms of "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 |
# Nokia Corporation - initial contribution.
|
|
10 |
#
|
|
11 |
# Contributors:
|
|
12 |
#
|
|
13 |
# Description:
|
|
14 |
#
|
|
15 |
|
|
16 |
package GenXml;
|
|
17 |
|
|
18 |
use strict;
|
|
19 |
|
|
20 |
use FindBin;
|
|
21 |
use lib "$FindBin::Bin/lib";
|
|
22 |
use XML::DOM;
|
|
23 |
use XML::DOM::ValParser;
|
|
24 |
|
|
25 |
# produces the "Use of uninitialized value in concatenation (.) or string" warning
|
|
26 |
use XML::XQL;
|
|
27 |
use XML::XQL::DOM;
|
|
28 |
|
|
29 |
# Variable to indicate the version of xml file used. It will be set by subroutine Parse_xml
|
|
30 |
my $iVer = 1;
|
|
31 |
|
|
32 |
# Used by debug prints
|
|
33 |
#my $count;
|
|
34 |
|
|
35 |
my ($gHiResTimer) = 0; #Flag - true (1) if HiRes Timer module available
|
|
36 |
my ($gLogFileH); # Log file handle
|
|
37 |
my ($gEmbeddedLog) = 0; # Flag false (0) if logging must include scanlog headers etc
|
|
38 |
my ($gValidateFailed) = 0; # Flag true (1) if the XML validation has failed
|
|
39 |
my ($gValidate) = 0; # Flag true (1) if to do XML validation only
|
|
40 |
|
|
41 |
#assign STDERR to STDOUT so both are printed in the same file, without overwriting lines
|
|
42 |
open (STDERR, ">&STDOUT") or die("ERROR: Unable to redirect STDERR to STDOUT: $!");
|
|
43 |
select((select(STDOUT), $|=1)[0]);
|
|
44 |
select((select(STDERR), $|=1)[0]);
|
|
45 |
|
|
46 |
|
|
47 |
# Check if HiRes Timer is available
|
|
48 |
if (eval "require Time::HiRes;") {
|
|
49 |
$gHiResTimer = 1;
|
|
50 |
} else {
|
|
51 |
print "Cannot load HiResTimer Module, install the Perl module Time-HiRes for more accurate timing data\n";
|
|
52 |
}
|
|
53 |
|
|
54 |
# Start
|
|
55 |
#
|
|
56 |
# Inputs
|
|
57 |
# $iXMLSource - ref to array of XML filenames, to be merged into one
|
|
58 |
# $iLogFile - name of logfile
|
|
59 |
# $iSourceDir - root of the current source tree
|
|
60 |
# $iEffectiveDir - root of source tree in which output files will be used
|
|
61 |
# $iValidate - if true, validate the input and then stop
|
|
62 |
#
|
|
63 |
# $iFilter - (optional) filter the merged file against this value
|
|
64 |
# $iMergedXml - (optional) create file of this name containing the merged XML
|
|
65 |
# $iConfName - name of the configuration: needed by subsequent arguments
|
|
66 |
# $iDataOutput - (optional) create file of this name containing the XML build commands
|
|
67 |
# $iTextOutput - (optional) create file of this name containing the list of components
|
|
68 |
# $iCBROutput - (optional) create file of this name containing the list of MRP files
|
|
69 |
#
|
|
70 |
# Description
|
|
71 |
# This function merges multiple XML files into one document, then optionally outputs various
|
|
72 |
# files.
|
|
73 |
#
|
|
74 |
sub Start
|
|
75 |
{
|
|
76 |
my ($iXmlSource, $iDataOutput, $iLogFile, $iSourceDir, $iConfName, $iMergedXml, $iValidate, $iTextOutput, $iCBROutput, $iFilter, $iEffectiveDir) = @_;
|
|
77 |
|
|
78 |
# Set global validation Flag
|
|
79 |
$GenXml::gValidate = $iValidate;
|
|
80 |
|
|
81 |
my $doc;
|
|
82 |
|
|
83 |
if ($iLogFile)
|
|
84 |
{
|
|
85 |
# Open Log file
|
|
86 |
$GenXml::gLogFileH = IO::File->new("> $iLogFile")
|
|
87 |
or die "ERROR: RealTimeBuild: Couldn't open $iLogFile for writing: $!\n";
|
|
88 |
$gEmbeddedLog = 0; # Generate scanlog-compatible log format
|
|
89 |
} else {
|
|
90 |
$GenXml::gLogFileH = *STDOUT;
|
|
91 |
$gEmbeddedLog = 1; # Assume that we are embedded in a scanlog-format log file
|
|
92 |
}
|
|
93 |
|
|
94 |
if (!$gEmbeddedLog)
|
|
95 |
{
|
|
96 |
# Logfile headers
|
|
97 |
print $GenXml::gLogFileH "===-------------------------------------------------\n";
|
|
98 |
print $GenXml::gLogFileH "=== Genxml\n";
|
|
99 |
print $GenXml::gLogFileH "===-------------------------------------------------\n";
|
|
100 |
print $GenXml::gLogFileH "=== Genxml started ".localtime()."\n";
|
|
101 |
}
|
|
102 |
|
|
103 |
# $iSourceDir must end in a \
|
|
104 |
# Add a \ if not present
|
|
105 |
# And make sure they are in windows style
|
|
106 |
if ($iSourceDir !~ /\\$/)
|
|
107 |
{
|
|
108 |
$iSourceDir =~ s/\//\\/g;
|
|
109 |
$iSourceDir .= "\\";
|
|
110 |
}
|
|
111 |
if ($iEffectiveDir !~ /\\$/)
|
|
112 |
{
|
|
113 |
$iEffectiveDir =~ s/\//\\/g;
|
|
114 |
$iEffectiveDir .= "\\";
|
|
115 |
}
|
|
116 |
|
|
117 |
# Parse all the files into one DOM doc
|
|
118 |
$doc = &Parse_files($iXmlSource, \$iVer);
|
|
119 |
# ... XML::DOM::Document was created sucessfully ...
|
|
120 |
|
|
121 |
# Exit here if validating only
|
|
122 |
exit if ($GenXml::gValidate);
|
|
123 |
|
|
124 |
# Try normalising it
|
|
125 |
$doc->normalize;
|
|
126 |
|
|
127 |
# filter it, if desired
|
|
128 |
if ($iFilter && $iVer == 1) {
|
|
129 |
&logfileHeader("Filtering model against $iFilter");
|
|
130 |
&Filter_doc($doc, $iFilter);
|
|
131 |
&logfileFooter();
|
|
132 |
} elsif ($iFilter && $iVer == 2) {
|
|
133 |
&logfileHeader("Filtering model against $iFilter");
|
|
134 |
&Filter_doc2($doc, $iFilter);
|
|
135 |
&logfileFooter();
|
|
136 |
}
|
|
137 |
|
|
138 |
|
|
139 |
# Debug dump new doc to file
|
|
140 |
#~ $doc->printToFile("$iMergedXml") if ($iMergedXml);
|
|
141 |
|
|
142 |
#################write only non-empty lines################
|
|
143 |
if ($iMergedXml)
|
|
144 |
{
|
|
145 |
open(HANDLE, "+> $iMergedXml") or die "Error: Can't open $iMergedXml: $!";
|
|
146 |
my $MergedXMLString = $doc->toString;
|
|
147 |
my @lines = split(/\n/,$MergedXMLString);
|
|
148 |
my @tempLines = ();
|
|
149 |
foreach (@lines)
|
|
150 |
{
|
|
151 |
push @tempLines, $_ if $_ !~ /^[\s]*$/;
|
|
152 |
}
|
|
153 |
|
|
154 |
$MergedXMLString = join("\n",@tempLines);
|
|
155 |
seek(HANDLE,0,0);
|
|
156 |
print HANDLE $MergedXMLString;
|
|
157 |
truncate(HANDLE,tell(HANDLE));
|
|
158 |
close HANDLE;
|
|
159 |
}
|
|
160 |
#################################
|
|
161 |
if ($iConfName)
|
|
162 |
{
|
|
163 |
# Process the configuration to get the lists of units, tasks and options
|
|
164 |
&logfileHeader("Processing configuration $iConfName");
|
|
165 |
my ($topunits, $subunits, $options, $tasks) = &process_configuration($doc,$iConfName, $iVer);
|
|
166 |
my @topbldList = &compute_bldList($iSourceDir,$iEffectiveDir,$topunits, $iVer);
|
|
167 |
|
|
168 |
&logfileFooter();
|
|
169 |
|
|
170 |
if ($iTextOutput)
|
|
171 |
{
|
|
172 |
&logfileHeader("Generating text output $iTextOutput");
|
|
173 |
|
|
174 |
# Generate old-style text output
|
|
175 |
&write_component_list($doc, $iTextOutput, $iConfName, \@topbldList, $options, $tasks, $iEffectiveDir, $iVer);
|
|
176 |
|
|
177 |
&logfileFooter();
|
|
178 |
}
|
|
179 |
|
|
180 |
if ($iCBROutput)
|
|
181 |
{
|
|
182 |
&logfileHeader("Generating CBR component list $iCBROutput");
|
|
183 |
|
|
184 |
# Generate list of CBR components for "makecbr"
|
|
185 |
my @allunits;
|
|
186 |
#if ($iVer == 1) {
|
|
187 |
@allunits = (@$topunits, @$subunits);
|
|
188 |
#} else {
|
|
189 |
# @allunits = (@$topunits); # No subunits required for the new version of system_definition.xml
|
|
190 |
#}
|
|
191 |
my @fullbldList = &compute_bldList($iSourceDir,$iEffectiveDir,\@allunits, $iVer);
|
|
192 |
|
|
193 |
&write_CBR_list($iCBROutput, \@fullbldList);
|
|
194 |
|
|
195 |
&logfileFooter();
|
|
196 |
}
|
|
197 |
|
|
198 |
if ($iDataOutput)
|
|
199 |
{
|
|
200 |
&logfileHeader("Generating output XML $iDataOutput");
|
|
201 |
|
|
202 |
# Generate the output document by applying the tasks to the bldList
|
|
203 |
|
|
204 |
my $ID = 1; # Execute Element ID counter
|
|
205 |
my $Stage = 1; # Execute Element Stage counter
|
|
206 |
|
|
207 |
my ($outDoc, $docElem, $commands) = &start_output_doc($iConfName, $iVer);
|
|
208 |
|
|
209 |
process_prebuilt(\$outDoc, \$commands, \$ID, \$Stage, $topunits, 'N', $iVer);
|
|
210 |
foreach my $task (@{$tasks})
|
|
211 |
{
|
|
212 |
&process_task($task, $doc, \$outDoc, \$commands, \$ID, \$Stage, \@topbldList, $options, $iSourceDir, $iEffectiveDir, $iVer);
|
|
213 |
}
|
|
214 |
process_prebuilt(\$outDoc, \$commands, \$ID, \$Stage, $topunits, 'Y', $iVer);
|
|
215 |
|
|
216 |
$docElem->appendChild($commands);
|
|
217 |
$docElem->addText("\n");
|
|
218 |
#print $outDoc->toString;
|
|
219 |
$outDoc->printToFile($iDataOutput);
|
|
220 |
$outDoc->dispose;
|
|
221 |
|
|
222 |
&logfileFooter();
|
|
223 |
}
|
|
224 |
}
|
|
225 |
|
|
226 |
if (!$gEmbeddedLog)
|
|
227 |
{
|
|
228 |
# Print Genxml log footer
|
|
229 |
print $GenXml::gLogFileH "=== Genxml finished ".localtime()."\n";
|
|
230 |
}
|
|
231 |
|
|
232 |
# Close file handles
|
|
233 |
close($GenXml::gLogFileH);
|
|
234 |
|
|
235 |
$doc->dispose;
|
|
236 |
|
|
237 |
}
|
|
238 |
|
|
239 |
# Error Processing function for the XML Validation
|
|
240 |
#
|
|
241 |
# Throws an exception (with die) when an error is encountered, this
|
|
242 |
# will stop the parsing process.
|
|
243 |
# Don't die if a warning or info message is encountered, just print a message.
|
|
244 |
sub my_fail
|
|
245 |
{
|
|
246 |
my $code = shift;
|
|
247 |
|
|
248 |
if ($code < 200)
|
|
249 |
{
|
|
250 |
print $GenXml::gLogFileH "ERROR: ".XML::Checker::error_string ($code, @_);
|
|
251 |
# Set Flag so all the errors are reported before dieing
|
|
252 |
$GenXml::gValidateFailed = 1;
|
|
253 |
}
|
|
254 |
|
|
255 |
# Useful debug output
|
|
256 |
print $GenXml::gLogFileH XML::Checker::error_string ($code, @_) if ($GenXml::gValidate);
|
|
257 |
}
|
|
258 |
|
|
259 |
sub my_Unparsed_handler
|
|
260 |
{
|
|
261 |
my ($Parser, $Entity, $Base, $Sysid, $Pubid, $Notation) = @_;
|
|
262 |
print $GenXml::gLogFileH "$Entity Unparsed";
|
|
263 |
die "ERROR: RealTimeBuild: Processing error\n";
|
|
264 |
}
|
|
265 |
|
|
266 |
# Parse_files
|
|
267 |
#
|
|
268 |
# Inputs
|
|
269 |
# $iXMLSource - ref to array of filenames
|
|
270 |
# $iVersion - Version of xml file (new or old) ?
|
|
271 |
#
|
|
272 |
# Outputs
|
|
273 |
# $doc - XML DOM doc
|
|
274 |
#
|
|
275 |
# Description
|
|
276 |
# This function merges multiple XML files into one document
|
|
277 |
sub Parse_files
|
|
278 |
{
|
|
279 |
my ($iXmlSource, $iVersion) = @_; # Version info passed for conditional processing of xml files
|
|
280 |
my (@docs);
|
|
281 |
|
|
282 |
# Load the XML document
|
|
283 |
my %expat_options = (KeepCDATA => 1,
|
|
284 |
Handlers => [ Unparsed => \&my_Unparsed_handler ]);
|
|
285 |
|
|
286 |
for (my $i = 0; $i < scalar(@$iXmlSource); $i++)
|
|
287 |
{
|
|
288 |
# Create header for parsing each file
|
|
289 |
&logfileHeader(@$iXmlSource[$i]);
|
|
290 |
|
|
291 |
my $parser = new XML::DOM::ValParser (%expat_options);
|
|
292 |
XML::DOM::ignoreReadOnly (1);
|
|
293 |
local $XML::Checker::FAIL = \&my_fail;
|
|
294 |
|
|
295 |
# Useful debug output
|
|
296 |
#print "Parsing ".@$iXmlSource[$i]."\n";
|
|
297 |
|
|
298 |
$docs[$i] = $parser->parsefile (@$iXmlSource[$i]);
|
|
299 |
|
|
300 |
# Create footer for parsing each file
|
|
301 |
&logfileFooter();
|
|
302 |
}
|
|
303 |
|
|
304 |
# Check to see if any of the XML files failed validation and die
|
|
305 |
die "ERROR: RealTimeBuild: Validation failed\n" if ($GenXml::gValidateFailed);
|
|
306 |
|
|
307 |
# Set the appropriate version number
|
|
308 |
for (my $i = 0; $i < scalar(@docs); $i++)
|
|
309 |
{ if((scalar(@docs))>1) {
|
|
310 |
if ($docs[$i]->getDocumentElement->getAttribute('schema') =~ /^2\./ &&
|
|
311 |
$docs[$i]->getDocumentElement->getTagName eq "SystemDefinition" &&
|
|
312 |
$docs[1]->getDocumentElement->getTagName eq "SystemBuild")
|
|
313 |
{
|
|
314 |
$$iVersion = 2;
|
|
315 |
last;
|
|
316 |
}
|
|
317 |
}
|
|
318 |
else
|
|
319 |
{
|
|
320 |
if ($docs[$i]->getDocumentElement->getAttribute('schema') =~ /^2\./ &&
|
|
321 |
$docs[$i]->getDocumentElement->getTagName eq "SystemDefinition")
|
|
322 |
{
|
|
323 |
$$iVersion = 2;
|
|
324 |
last;
|
|
325 |
}
|
|
326 |
}
|
|
327 |
}
|
|
328 |
|
|
329 |
if ($$iVersion == 1) { # Docs load now merge into $docs[0] if $iVersion is 1 (i.e. old version of xml file)
|
|
330 |
for (my $i = 1; $i < scalar(@docs); $i++) {
|
|
331 |
# Create header for merging each file
|
|
332 |
&logfileHeader("Merging in XML file ".@$iXmlSource[$i]);
|
|
333 |
&process_node(\($docs[0]->getElementsByTagName("SystemDefinition")),\($docs[$i]->getElementsByTagName("SystemDefinition")), \($docs[0]));
|
|
334 |
|
|
335 |
# Re-validate merged file
|
|
336 |
local $XML::Checker::FAIL = \&my_fail;
|
|
337 |
$docs[0]->check();
|
|
338 |
|
|
339 |
# Create footer for merging each file
|
|
340 |
&logfileFooter();
|
|
341 |
# Check to see if any of the XML files failed validation and die
|
|
342 |
die "ERROR: RealTimeBuild: Merged Validation failed\n" if ($GenXml::gValidateFailed);
|
|
343 |
}
|
|
344 |
} elsif ($$iVersion == 2) { # Docs load now merge into $docs[$#docs + 1] if $iVersion is 2 (i.e. new version of xml file)
|
|
345 |
for (my $i = 1; $i < scalar(@docs); $i++) {
|
|
346 |
# Create header for merging each file
|
|
347 |
&logfileHeader("Merging in XML file ".@$iXmlSource[$i]);
|
|
348 |
my $mergedDoc = &process_node2(\($docs[0]), \($docs[$i]));
|
|
349 |
|
|
350 |
# Re-validate merged file
|
|
351 |
local $XML::Checker::FAIL = \&my_fail;
|
|
352 |
$mergedDoc->check();
|
|
353 |
|
|
354 |
# Create footer for merging each file
|
|
355 |
&logfileFooter();
|
|
356 |
# Check to see if any of the XML files failed validation and die
|
|
357 |
die "ERROR: RealTimeBuild: Merged Validation failed\n" if ($GenXml::gValidateFailed);
|
|
358 |
|
|
359 |
$docs[0] = $mergedDoc;
|
|
360 |
}
|
|
361 |
}
|
|
362 |
return $docs[0];
|
|
363 |
}
|
|
364 |
|
|
365 |
# process_node
|
|
366 |
#
|
|
367 |
# Inputs
|
|
368 |
# $node1 - ref to a node from the master
|
|
369 |
# $node2 - ref to a node from the slave
|
|
370 |
# $doc1 - ref to the doc of node1 so we can set the doc owner to the (not DOM spec) to get around WRONG_DOCUMENT_ERR restriction
|
|
371 |
#
|
|
372 |
# Outputs
|
|
373 |
#
|
|
374 |
# Description
|
|
375 |
# This function processes a node in two DOM documents, if any children match then it calls itself to process
|
|
376 |
# the children nodes further
|
|
377 |
sub process_node
|
|
378 |
{
|
|
379 |
my ($node1, $node2, $doc1) = @_;
|
|
380 |
|
|
381 |
# Some nodes need special processing e.g. SystemDefinition
|
|
382 |
# This is because there can only be a certain number of these nodes
|
|
383 |
# child node / element rules outlined below, this rules are applied to the children of the node in question
|
|
384 |
# Child Node / element tag Rule
|
|
385 |
# ------------------------ ----
|
|
386 |
# SystemDefinition Merge the name and revision/schema CDATA as there can be only one of this element
|
|
387 |
# systemModel Always processed further as there can only be 1 or 0 of these
|
|
388 |
# layer Same name process further otherwise append child
|
|
389 |
# logicalset Same name process further otherwise append child
|
|
390 |
# logicalsubset Same name process further otherwise append child
|
|
391 |
# module Same name process further otherwise append child
|
|
392 |
# component Same name process further otherwise append child
|
|
393 |
# unit Same unitID generate ERROR and not replace child, otherwise append child
|
|
394 |
# sub elements of unit No processing needed as these cannot be merged
|
|
395 |
# package Same name process further otherwise append child
|
|
396 |
|
|
397 |
# build Always processed further as there can only be 1 or 0 of these
|
|
398 |
# unitList Same name process further otherwise append child
|
|
399 |
# unitRef Same unit ignore, different unit append child
|
|
400 |
# targetList Same name generate ERROR and not replace child, otherwise append child
|
|
401 |
# target Same name generate ERROR and not replace child, otherwise append child
|
|
402 |
# option Same name generate ERROR and not replace child, otherwise append child
|
|
403 |
# configuration Same name generate ERROR and not replace child, otherwise append child
|
|
404 |
# sub elements of configuration No processing needed as these cannot be merged
|
|
405 |
|
|
406 |
|
|
407 |
# All other nodes Append child
|
|
408 |
|
|
409 |
# Useful debug stuff
|
|
410 |
#$GenXml::count++;
|
|
411 |
#print "enter $GenXml::count\n";
|
|
412 |
|
|
413 |
# Handle the special case for the first call to this function with the node containing the SystemDefinition
|
|
414 |
if (($$node1->getTagName eq "SystemDefinition") && ($$node2->getTagName eq "SystemDefinition"))
|
|
415 |
{
|
|
416 |
# Get the name attributes
|
|
417 |
my ($name1) = $$node1->getAttribute('name');
|
|
418 |
my ($name2) = $$node2->getAttribute('name');
|
|
419 |
# Combine the two and set the attribute into the merged file
|
|
420 |
$$node1->setAttribute('name',$name1." + ".$name2);
|
|
421 |
|
|
422 |
# Get the revision attributes
|
|
423 |
my ($revision1) = $$node1->getAttribute('revision');
|
|
424 |
my ($revision2) = $$node2->getAttribute('revision');
|
|
425 |
# Get the schema attributes
|
|
426 |
my ($schema1) = $$node1->getAttribute('schema');
|
|
427 |
my ($schema2) = $$node2->getAttribute('schema');
|
|
428 |
# If both schema attributes are defined, combine the two and set the attribute into the merged file
|
|
429 |
# Note that even if an attribute does not exist in the XML file, XML::DOM returns an empty string (not undef)
|
|
430 |
if (($schema1) and ($schema2))
|
|
431 |
{ # Both files have "new DTD".
|
|
432 |
if (($revision1) or ($revision2))
|
|
433 |
{
|
|
434 |
print $GenXml::gLogFileH "ERROR: Cannot define both schema and revison attributes in same file. Merged file will probably not be usable.\n";
|
|
435 |
}
|
|
436 |
if ($schema1 eq $schema2)
|
|
437 |
{ # Both files have same schema attribute. Assign it to merged file
|
|
438 |
$$node1->setAttribute('schema',$schema1);
|
|
439 |
}
|
|
440 |
else
|
|
441 |
{ # Files have different schema attributes. Combine and assign it to merged file. Warn!!
|
|
442 |
print $GenXml::gLogFileH "WARNING: Source file schema attribute values differ ($schema1 vs $schema2). Merged file may not be usable.\n";
|
|
443 |
$$node1->setAttribute('schema',$schema1." + ".$schema2);
|
|
444 |
}
|
|
445 |
}
|
|
446 |
# If both revision attributes are defined, combine the two and set the attribute into the merged file
|
|
447 |
elsif (($revision1) and ($revision2))
|
|
448 |
{ # Both files have "old DTD". Retain this code for compatibility
|
|
449 |
print $GenXml::gLogFileH "REMARK: Both source files have \"old style\" DTDs. See SystemDefinition \"revision\" attribute.\n";
|
|
450 |
$$node1->setAttribute('revision',$revision1." + ".$revision2);
|
|
451 |
}
|
|
452 |
else
|
|
453 |
{ # Files have different DTDs. Use attribute found in first file. report as ERROR!!
|
|
454 |
print $GenXml::gLogFileH "ERROR: Source file schema/revison attributes conflict. Merged file will probably not be usable.\n";
|
|
455 |
if ($schema1)
|
|
456 |
{ # First file had new DTD and had a schema attribute
|
|
457 |
$$node1->setAttribute('schema',$schema1);
|
|
458 |
}
|
|
459 |
elsif ($revision1)
|
|
460 |
{ # First file had old DTD and had a revision attribute (not a schema)
|
|
461 |
$$node1->setAttribute('revision',$revision1);
|
|
462 |
}
|
|
463 |
}
|
|
464 |
}
|
|
465 |
|
|
466 |
# Get the children of the parent nodes
|
|
467 |
|
|
468 |
my $nodelist1 = $$node1->getChildNodes;
|
|
469 |
my $nodelist2 = $$node2->getChildNodes;
|
|
470 |
|
|
471 |
# Useful debug stuff
|
|
472 |
#print "has ".$nodelist2->getLength." children\n";
|
|
473 |
|
|
474 |
# Itterate throught the children of node2 check to see if they are present / rule match in node 1
|
|
475 |
my $ni = $nodelist2->getLength;
|
|
476 |
for (my $i = 0; $i < $ni; $i++)
|
|
477 |
{
|
|
478 |
# Useful debug stuff
|
|
479 |
#print "node $i ".$nodelist2->item($i)->getNodeTypeName."\n";
|
|
480 |
if ($nodelist2->item($i)->getNodeTypeName eq "ELEMENT_NODE")
|
|
481 |
{
|
|
482 |
# Handle rule match on ELEMENTS
|
|
483 |
my $tagname2 = $nodelist2->item($i)->getTagName;
|
|
484 |
|
|
485 |
# Useful debug stuff
|
|
486 |
# print "Tagname = $tagname\n";
|
|
487 |
if (($tagname2 eq "systemModel") || ($tagname2 eq "build") )
|
|
488 |
{
|
|
489 |
my $iBuildIndx;
|
|
490 |
# find the $node1 for this elements
|
|
491 |
my $nj = $nodelist1->getLength;
|
|
492 |
my $match = 0;
|
|
493 |
for (my $j = 0; $j < $nj; $j++)
|
|
494 |
{
|
|
495 |
if ($nodelist1->item($j)->getNodeTypeName eq "ELEMENT_NODE")
|
|
496 |
{
|
|
497 |
my $tagname1 = $nodelist1->item($j)->getTagName;
|
|
498 |
if ($tagname1 eq $tagname2)
|
|
499 |
{
|
|
500 |
# process further
|
|
501 |
|
|
502 |
# Useful debug stuff
|
|
503 |
#print "processing $tagname further\n";
|
|
504 |
&process_node(\($nodelist1->item($j)), \($nodelist2->item($i)), $doc1);
|
|
505 |
$match = 1;
|
|
506 |
}
|
|
507 |
else
|
|
508 |
{
|
|
509 |
if ($tagname1 eq 'build')
|
|
510 |
{
|
|
511 |
$iBuildIndx = $j;
|
|
512 |
}
|
|
513 |
if ((($tagname2 eq 'systemModel') and ($tagname1 ne 'systemModel')) or ((($tagname2 eq 'build') and ($tagname1 ne 'build'))))
|
|
514 |
{
|
|
515 |
next;
|
|
516 |
}
|
|
517 |
# no systemModel or build element found so append child
|
|
518 |
&append_child($node1, \($nodelist2->item($i)), $doc1)
|
|
519 |
}
|
|
520 |
}
|
|
521 |
}
|
|
522 |
unless ($match)
|
|
523 |
{
|
|
524 |
# no systemModel or build element found so append child
|
|
525 |
# In the special case of adding an instance of 'systemModel' we must specify that this goes before any instance of 'build'
|
|
526 |
my $iRefChildRef = ($tagname2 eq 'systemModel')? $nodelist1->item($iBuildIndx): undef;
|
|
527 |
&append_child($node1, \($nodelist2->item($i)), $doc1, $iRefChildRef);
|
|
528 |
}
|
|
529 |
} elsif (($tagname2 eq "layer") || ($tagname2 eq "logicalset") || ($tagname2 eq "logicalsubset") || ($tagname2 eq "module") || ($tagname2 eq "component") || ($tagname2 eq "package") || ($tagname2 eq "unitList"))
|
|
530 |
{
|
|
531 |
# Check the $node1 for elements with the same "name"
|
|
532 |
my $match; # Flag for matching element found
|
|
533 |
my $nj = $nodelist1->getLength;
|
|
534 |
for (my $j = 0; $j < $nj; $j++)
|
|
535 |
{
|
|
536 |
# Only look at element nodes in node1
|
|
537 |
if ($nodelist1->item($j)->getNodeTypeName eq "ELEMENT_NODE")
|
|
538 |
{
|
|
539 |
if ($nodelist2->item($i)->getAttribute('name') eq $nodelist1->item($j)->getAttribute('name'))
|
|
540 |
{
|
|
541 |
# Process further match found
|
|
542 |
$match = 1;
|
|
543 |
|
|
544 |
# Useful debug stuff
|
|
545 |
#print "processing j=$j $tagname2 further ".$nodelist2->item($i)->getAttribute('name')."\n";
|
|
546 |
|
|
547 |
&process_node(\($nodelist1->item($j)), \($nodelist2->item($i)), $doc1);
|
|
548 |
}
|
|
549 |
}
|
|
550 |
}
|
|
551 |
# If no match found Append child
|
|
552 |
|
|
553 |
# Useful debug stuff
|
|
554 |
#print "new $tagname2 added\n" if (!$match);
|
|
555 |
|
|
556 |
&append_child($node1, \($nodelist2->item($i)), $doc1) if (!$match);
|
|
557 |
|
|
558 |
} elsif (($tagname2 eq "unit") || ($tagname2 eq "targetList") || ($tagname2 eq "target") || ($tagname2 eq "option") || ($tagname2 eq "configuration")) {
|
|
559 |
# Check the $node1 for elements with the same ID attribute (Global check for ID clashes)
|
|
560 |
my $idAttrib;
|
|
561 |
if ($tagname2 eq "unit")
|
|
562 |
{
|
|
563 |
# Special case of the unit element as this has uses the attribute of unitID instead of name
|
|
564 |
$idAttrib = "unitID";
|
|
565 |
} else {
|
|
566 |
$idAttrib = "name";
|
|
567 |
}
|
|
568 |
|
|
569 |
my $ID = $nodelist2->item($i)->getAttribute($idAttrib);
|
|
570 |
# Search for the XML ID in $doc1
|
|
571 |
if( scalar(XML::XQL::solve ("//*[\@$idAttrib = '$ID']", $$doc1)))
|
|
572 |
{
|
|
573 |
print $GenXml::gLogFileH "REMARK: $ID already exists, not merging this $tagname2 element\n";
|
|
574 |
} else {
|
|
575 |
# unitID not found so append elememnt
|
|
576 |
|
|
577 |
# Useful debug stuff
|
|
578 |
# print "new $tagname2 added\n";
|
|
579 |
|
|
580 |
&append_child($node1, \($nodelist2->item($i)), $doc1);
|
|
581 |
}
|
|
582 |
} elsif ($tagname2 eq "unitRef") {
|
|
583 |
# Check the $node1 for elements with the same "name"
|
|
584 |
my $match; # Flag for matching element found
|
|
585 |
my $nj = $nodelist1->getLength;
|
|
586 |
for (my $j = 0; $j < $nj; $j++)
|
|
587 |
{
|
|
588 |
# Only look at element nodes in node1
|
|
589 |
if ($nodelist1->item($j)->getNodeTypeName eq "ELEMENT_NODE")
|
|
590 |
{
|
|
591 |
if ($nodelist2->item($i)->getAttribute('unit') eq $nodelist1->item($j)->getAttribute('unit'))
|
|
592 |
{
|
|
593 |
# Ignore the unitRef element as it is a duplicate
|
|
594 |
$match = 1;
|
|
595 |
print $GenXml::gLogFileH "WARNING: Duplicate unitRef ".$nodelist2->item($i)->getAttribute('unit')." not merging\n";
|
|
596 |
}
|
|
597 |
}
|
|
598 |
}
|
|
599 |
# No match found Append Child
|
|
600 |
|
|
601 |
# Useful debug stuff
|
|
602 |
# print "New unitRef\n" if (!$match);
|
|
603 |
|
|
604 |
&append_child($node1, \($nodelist2->item($i)), $doc1) if (!$match);
|
|
605 |
|
|
606 |
} else {
|
|
607 |
# Element not recognised so append child
|
|
608 |
&append_child($node1, \($nodelist2->item($i)), $doc1);
|
|
609 |
}
|
|
610 |
} else {
|
|
611 |
# Handle non element nodes (append child of node2 to node 1)
|
|
612 |
# At the moment adding in non element nodes adds a lot of whitespace
|
|
613 |
# TODO: correctly handle non element nodes
|
|
614 |
# This is not important at the moment as there are no important non element nodes for the merge
|
|
615 |
#&append_child($node1, \($nodelist2->item($i)), $doc1);
|
|
616 |
}
|
|
617 |
}
|
|
618 |
|
|
619 |
#print "return $GenXml::count\n";
|
|
620 |
#$GenXml::count--;
|
|
621 |
}
|
|
622 |
|
|
623 |
# append_child
|
|
624 |
#
|
|
625 |
# Inputs
|
|
626 |
# $node1 - is already a ref of the node to append to
|
|
627 |
# $node2 - ref of node from nodelist2 to append to $node1
|
|
628 |
# $doc1 - ref to document to merge the node into (need for non DOM operation of changing owner of node)
|
|
629 |
# $refnode - ref to node in fromt of which to insert node2 (If undef, append node2)
|
|
630 |
#
|
|
631 |
# Description
|
|
632 |
# ???
|
|
633 |
sub append_child
|
|
634 |
{
|
|
635 |
my ($node1, $node2, $doc1, $refnode) = @_;
|
|
636 |
|
|
637 |
# Clone the node
|
|
638 |
my $clone = $$node2->cloneNode(1);
|
|
639 |
# Fix the owner of node
|
|
640 |
$clone->setOwnerDocument($$doc1);
|
|
641 |
# Append a line return for more tidy xml
|
|
642 |
$$node1->addText("\n");
|
|
643 |
# Append (or insert) the node
|
|
644 |
# Note: it seems that insertBefore($clone,undef) is identical to appendChild($clone)
|
|
645 |
$$node1->insertBefore($clone,$refnode);
|
|
646 |
}
|
|
647 |
|
|
648 |
# write_component_list
|
|
649 |
#
|
|
650 |
# Inputs
|
|
651 |
# $doc - Reference to input document
|
|
652 |
# $iTextOutput - Name of output file
|
|
653 |
# $iConfName - Name of configuration being described
|
|
654 |
# $bldList - Reference to the bldList array
|
|
655 |
# $options - Reference to the options array
|
|
656 |
# $tasks - Reference to the tasks array
|
|
657 |
# $iEffectiveDir - Root of source tree in which file will be used
|
|
658 |
# $iVersion - Version of xml file (new or old) ?
|
|
659 |
#
|
|
660 |
# Description:
|
|
661 |
# Write out old-style "list of components" build description for the configuration
|
|
662 |
#
|
|
663 |
sub write_component_list
|
|
664 |
{
|
|
665 |
my ($doc, $iTextOutput, $iConfName, $bldList, $options, $tasks, $iEffectiveDir, $iVersion) = @_;
|
|
666 |
|
|
667 |
# process list of tasks to find build targets and bootstrap info
|
|
668 |
my %targets;
|
|
669 |
my $bootflag = 0;
|
|
670 |
|
|
671 |
foreach my $task (@$tasks)
|
|
672 |
{
|
|
673 |
# Read all the task
|
|
674 |
my @children = $task->getChildNodes;
|
|
675 |
foreach my $child (@children)
|
|
676 |
{
|
|
677 |
next if ($child->getNodeTypeName ne "ELEMENT_NODE");
|
|
678 |
if ($child->getTagName eq "specialInstructions")
|
|
679 |
{
|
|
680 |
# "setupprj" in the command is taken to mean "bootstrap E32ToolP"
|
|
681 |
$bootflag = 1 if ($child->getAttribute("command") =~ /setupprj/i);
|
|
682 |
next;
|
|
683 |
}
|
|
684 |
my $targetlist = $child->getAttributeNode("targetList");
|
|
685 |
if (defined $targetlist)
|
|
686 |
{
|
|
687 |
my @targetnames = &find_targetList_by_ID($doc, $targetlist->getValue);
|
|
688 |
foreach my $target (@targetnames)
|
|
689 |
{
|
|
690 |
$targets{$target}= 1;
|
|
691 |
}
|
|
692 |
}
|
|
693 |
}
|
|
694 |
}
|
|
695 |
|
|
696 |
# create output file
|
|
697 |
open TEXTFILE, "> $iTextOutput" or die "ERROR: RealTimeBuild: Couldn't open $iTextOutput for writing: $!\n";
|
|
698 |
|
|
699 |
print TEXTFILE <<HEADER_TXT;
|
|
700 |
#
|
|
701 |
# ****************************** IMPORTANT NOTE ************************************
|
|
702 |
#
|
|
703 |
# The configuration was specified as: $iConfName
|
|
704 |
#
|
|
705 |
# **********************************************************************************
|
|
706 |
#
|
|
707 |
|
|
708 |
HEADER_TXT
|
|
709 |
|
|
710 |
print TEXTFILE "# Optional variations in the generated scripts\n\n";
|
|
711 |
|
|
712 |
my $column2pos = 8;
|
|
713 |
foreach my $option (@$options) {
|
|
714 |
my $name = '<option ????>';
|
|
715 |
if ($option =~ /^-(.+)/) {$name = "<option $1>"}
|
|
716 |
my $len = length $name;
|
|
717 |
while ($len > $column2pos) { $column2pos += 8; }
|
|
718 |
printf TEXTFILE "%-*s\t# use abld %s\n", $column2pos, $name, $option;
|
|
719 |
}
|
|
720 |
|
|
721 |
$column2pos = 8;
|
|
722 |
foreach my $target (sort keys %targets) {
|
|
723 |
# abld targets are only one word
|
|
724 |
next if ($target =~ /\w+\s+\w+/);
|
|
725 |
my $name;
|
|
726 |
if ($target =~ /(misa|mint|mcot|mtemplate|meig)/i) {
|
|
727 |
$name = "<option arm_assp $target>";
|
|
728 |
} else {
|
|
729 |
$name = "<option $target>";
|
|
730 |
}
|
|
731 |
my $len = length $name;
|
|
732 |
while ($len > $column2pos) { $column2pos += 8; }
|
|
733 |
printf TEXTFILE "%-*s\t#\n", $column2pos, $name;
|
|
734 |
}
|
|
735 |
|
|
736 |
print TEXTFILE "\n";
|
|
737 |
print TEXTFILE "# List of components required \n";
|
|
738 |
print TEXTFILE "#\n# Name abld_directory\n";
|
|
739 |
|
|
740 |
if($bootflag) {
|
|
741 |
print TEXTFILE "#\n# Bootstrapping....\n\n";
|
|
742 |
print TEXTFILE "<special bldfiles E32Toolp group> # Special installation for E32ToolP\n\n";
|
|
743 |
print TEXTFILE "# Components:\n";
|
|
744 |
}
|
|
745 |
print TEXTFILE "#\n";
|
|
746 |
|
|
747 |
|
|
748 |
my $srcprefix = quotemeta($iEffectiveDir);
|
|
749 |
|
|
750 |
$column2pos = 8;
|
|
751 |
foreach my $component (@$bldList) {
|
|
752 |
my $bldinfdir = $component->[1];
|
|
753 |
next if ($bldinfdir eq ""); # skip MRP-only entries
|
|
754 |
|
|
755 |
$bldinfdir =~ s/^$srcprefix//o;
|
|
756 |
my $len = length $component->[0];
|
|
757 |
while ($len > $column2pos) { $column2pos += 8; }
|
|
758 |
printf TEXTFILE "%-*s\t%s\n", $column2pos, $component->[0], $bldinfdir;
|
|
759 |
}
|
|
760 |
close TEXTFILE
|
|
761 |
}
|
|
762 |
|
|
763 |
# write_CBR_list
|
|
764 |
#
|
|
765 |
# Inputs
|
|
766 |
# $iCBROutput - Name of output file
|
|
767 |
# $bldList - Reference to the bldList array
|
|
768 |
#
|
|
769 |
# Description:
|
|
770 |
# Write out "list of CBR components" for the configuration
|
|
771 |
#
|
|
772 |
sub write_CBR_list
|
|
773 |
{
|
|
774 |
my ($iCBROutput, $bldList) = @_;
|
|
775 |
|
|
776 |
my @components = ();
|
|
777 |
foreach my $component (@$bldList)
|
|
778 |
{
|
|
779 |
my $mrp = $component->[2];
|
|
780 |
next if ($mrp eq ""); # skip entries without MRP files
|
|
781 |
|
|
782 |
push @components, sprintf("%s\t%s\n", $component->[0], $mrp);
|
|
783 |
}
|
|
784 |
|
|
785 |
# create output file
|
|
786 |
open TEXTFILE, "> $iCBROutput" or die "ERROR: RealTimeBuild: Couldn't open $iCBROutput for writing: $!\n";
|
|
787 |
print TEXTFILE sort @components;
|
|
788 |
close TEXTFILE
|
|
789 |
}
|
|
790 |
|
|
791 |
# start_output_doc
|
|
792 |
#
|
|
793 |
# Inputs
|
|
794 |
# $iConfName - Configuration name used
|
|
795 |
# $iVersion - Version of xml file (new or old) ?
|
|
796 |
#
|
|
797 |
# Outputs
|
|
798 |
# $outDoc - document
|
|
799 |
# $docElem - root element
|
|
800 |
# $commands - command node
|
|
801 |
#
|
|
802 |
# Description
|
|
803 |
# This function produces the static parts of the output XML file
|
|
804 |
sub start_output_doc
|
|
805 |
{
|
|
806 |
my ($iConfName, $iVersion) = @_;
|
|
807 |
|
|
808 |
my ($outParser, $outDoc, $docElem, $commands);
|
|
809 |
|
|
810 |
# set the doctype based on which version of file is passed.
|
|
811 |
my $doctype;
|
|
812 |
if ($iVersion == 1) {
|
|
813 |
$doctype = "Build";
|
|
814 |
} elsif ($iVersion == 2) {
|
|
815 |
$doctype = "SystemBuild" ;
|
|
816 |
}
|
|
817 |
|
|
818 |
$outParser = new XML::DOM::Parser;
|
|
819 |
|
|
820 |
my $str = <<END;
|
|
821 |
<?xml version="1.0"?>
|
|
822 |
<!DOCTYPE $doctype [
|
|
823 |
<!ELEMENT Product (Commands)>
|
|
824 |
<!ATTLIST Product name CDATA #REQUIRED>
|
|
825 |
<!ELEMENT Commands (Execute+ | SetEnv*)>
|
|
826 |
<!ELEMENT Execute EMPTY>
|
|
827 |
<!ATTLIST Execute
|
|
828 |
ID CDATA #REQUIRED
|
|
829 |
Stage CDATA #REQUIRED
|
|
830 |
Component CDATA #REQUIRED
|
|
831 |
Cwd CDATA #REQUIRED
|
|
832 |
CommandLine CDATA #REQUIRED>
|
|
833 |
<!ELEMENT SetEnv EMPTY>
|
|
834 |
<!ATTLIST SetEnv
|
|
835 |
Order ID #REQUIRED
|
|
836 |
Name CDATA #REQUIRED
|
|
837 |
Value CDATA #REQUIRED>
|
|
838 |
]>
|
|
839 |
<Product>
|
|
840 |
</Product>
|
|
841 |
END
|
|
842 |
|
|
843 |
$outDoc = $outParser->parse($str);
|
|
844 |
|
|
845 |
# get the document element
|
|
846 |
$docElem = $outDoc->getDocumentElement;
|
|
847 |
$docElem->setAttribute('name', $iConfName);
|
|
848 |
# Add the Commands Node
|
|
849 |
$commands = $outDoc->createElement('Commands');
|
|
850 |
$commands->addText("\n");
|
|
851 |
# create the default SetEnv elements
|
|
852 |
my $SetEnv1 = $outDoc->createElement('SetEnv');
|
|
853 |
$SetEnv1->setAttribute('Order', '1');
|
|
854 |
$SetEnv1->setAttribute('Name', 'EPOCROOT');
|
|
855 |
$SetEnv1->setAttribute('Value', '\\');
|
|
856 |
$commands->appendChild($SetEnv1);
|
|
857 |
$commands->addText("\n");
|
|
858 |
my $SetEnv2 = $outDoc->createElement('SetEnv');
|
|
859 |
$SetEnv2->setAttribute('Order', '2');
|
|
860 |
$SetEnv2->setAttribute('Name', 'PATH');
|
|
861 |
$SetEnv2->setAttribute('Value', '\\epoc32\\gcc\\bin;\\epoc32\\tools;%PATH%');
|
|
862 |
$commands->appendChild($SetEnv2);
|
|
863 |
$commands->addText("\n");
|
|
864 |
|
|
865 |
return ($outDoc, $docElem, $commands);
|
|
866 |
}
|
|
867 |
|
|
868 |
# process_prebuilt
|
|
869 |
#
|
|
870 |
# Inputs
|
|
871 |
# $outDoc - Reference to output document
|
|
872 |
# $commands - Reference to the command node
|
|
873 |
# $ID - Reference to theExecute ID counter
|
|
874 |
# $Stage - Reference to the Execute Stage counter
|
|
875 |
# $topunits - Reference to the list of unit, package & prebuilt elements
|
|
876 |
# $late - Selects on the "late" attribute of prebuilt elements
|
|
877 |
# $iVersion - Version of xml file (new or old) ?
|
|
878 |
#
|
|
879 |
# Outputs
|
|
880 |
#
|
|
881 |
# Description
|
|
882 |
# Generates the "getrel" commands for prebuilt elements
|
|
883 |
sub process_prebuilt
|
|
884 |
{
|
|
885 |
my ($outDoc, $commands, $ID, $Stage, $topunits, $late, $iVersion) = @_;
|
|
886 |
|
|
887 |
my ($name, $version, $islate);
|
|
888 |
foreach my $unit (@$topunits)
|
|
889 |
{
|
|
890 |
my @prebuilt; # a list of all <prebuilt> or <unit prebuilt="...">
|
|
891 |
if ($iVersion == 1) {
|
|
892 |
if ($unit->getTagName eq "prebuilt")
|
|
893 |
{
|
|
894 |
push(@prebuilt, $unit);
|
|
895 |
}
|
|
896 |
} elsif ($iVersion == 2) {
|
|
897 |
my @subunits = $unit->getElementsByTagName("unit");
|
|
898 |
foreach my $subunit (@subunits)
|
|
899 |
{
|
|
900 |
if ($subunit->getAttribute("prebuilt"))
|
|
901 |
{
|
|
902 |
push(@prebuilt, $subunit);
|
|
903 |
}
|
|
904 |
}
|
|
905 |
}
|
|
906 |
foreach my $unit (@prebuilt)
|
|
907 |
{
|
|
908 |
$version = $unit->getAttribute("version");
|
|
909 |
$islate = $unit->getAttribute("late");
|
|
910 |
$name = $unit->getAttribute(($iVersion == 1) ? "name" : "prebuilt");
|
|
911 |
|
|
912 |
$islate = "N" if (!defined $islate || $islate eq "");
|
|
913 |
|
|
914 |
next if ($late ne $islate);
|
|
915 |
next if (!$late && $islate eq "Y");
|
|
916 |
|
|
917 |
# Create the element
|
|
918 |
my $task_elem = $$outDoc->createElement('Execute');
|
|
919 |
$task_elem->setAttribute('ID', $$ID);
|
|
920 |
$$ID++; # The ID must always be incremented
|
|
921 |
$task_elem->setAttribute('Stage', $$Stage);
|
|
922 |
$$Stage++; # getrel operations are serial
|
|
923 |
|
|
924 |
$task_elem->setAttribute('Component',$name);
|
|
925 |
$task_elem->setAttribute('Cwd','%EPOCROOT%');
|
|
926 |
$task_elem->setAttribute('CommandLine',"getrel $name $version");
|
|
927 |
|
|
928 |
$$commands->appendChild($task_elem);
|
|
929 |
$$commands->addText("\n");
|
|
930 |
}
|
|
931 |
}
|
|
932 |
}
|
|
933 |
|
|
934 |
# process_task
|
|
935 |
#
|
|
936 |
# Inputs
|
|
937 |
# $task - task node
|
|
938 |
# $doc - Reference to input document
|
|
939 |
# $outDoc - Reference to output document
|
|
940 |
# $commands - Reference to the command node
|
|
941 |
# $ID - Reference to theExecute ID counter
|
|
942 |
# $Stage - Reference to the Execute Stage counter
|
|
943 |
# $bldList - Reference to the bldList array
|
|
944 |
# $options - Reference to the options array
|
|
945 |
# $iSourceDir - root of the current source tree
|
|
946 |
# $iEffectiveDir - root from which the source tree will be used
|
|
947 |
# $iVersion - Version of xml file (new or old) ?
|
|
948 |
#
|
|
949 |
# Outputs
|
|
950 |
#
|
|
951 |
# Description
|
|
952 |
# This function processes the task nodes
|
|
953 |
sub process_task
|
|
954 |
{
|
|
955 |
my ($task, $doc, $outDoc, $commands, $ID, $Stage, $bldList, $options, $iSourceDir, $iEffectiveDir, $iVersion) = @_;
|
|
956 |
|
|
957 |
my @targets;
|
|
958 |
my @localBldList; # Used for task specific unit list overrides
|
|
959 |
|
|
960 |
# re-process the $iSourceDir & $iSourceDir based on version of xml file along with value for unitListRef and unitList
|
|
961 |
my ($unitListRef, $unitList);
|
|
962 |
if($iVersion == 1) {
|
|
963 |
$unitListRef = "unitListRef";
|
|
964 |
$unitList = "unitList";
|
|
965 |
} elsif ($iVersion == 2) {
|
|
966 |
$unitListRef = "listRef";
|
|
967 |
$unitList = "list";
|
|
968 |
}
|
|
969 |
|
|
970 |
# Read all the task
|
|
971 |
my @children = $task->getChildNodes;
|
|
972 |
foreach my $child (@children)
|
|
973 |
{
|
|
974 |
if ($child->getNodeTypeName eq "ELEMENT_NODE")
|
|
975 |
{
|
|
976 |
# Check for unitListRef for task unit list override
|
|
977 |
if ($child->getTagName eq $unitListRef)
|
|
978 |
{
|
|
979 |
#Processes the unitListRefs to build up a complete list of units which are IDREFs
|
|
980 |
my @localUnits= &find_unitList_by_ID($doc, $child->getAttribute($unitList), $iVersion);
|
|
981 |
push @localBldList, &compute_bldList($iSourceDir,$iEffectiveDir,\@localUnits, $iVersion);
|
|
982 |
# Overwrite Ref $bldList with new Ref to @localBldList
|
|
983 |
$bldList = \@localBldList;
|
|
984 |
}
|
|
985 |
|
|
986 |
if ($child->getTagName eq "specialInstructions")
|
|
987 |
{
|
|
988 |
#Processes the unitListRefs to build up a complete list of units which are IDREFs
|
|
989 |
my $task_elem = $$outDoc->createElement('Execute');
|
|
990 |
$task_elem->setAttribute('ID', $$ID);
|
|
991 |
$$ID++; # The ID must always be incremented
|
|
992 |
$task_elem->setAttribute('Stage', $$Stage);
|
|
993 |
$$Stage++; # All specialInstructions are done sequentially
|
|
994 |
$task_elem->setAttribute('Component', $child->getAttributeNode("name")->getValue);
|
|
995 |
my ($cwd) = $child->getAttributeNode("cwd")->getValue;
|
|
996 |
# Replace any Environment variables
|
|
997 |
my ($cwdtemp) = $cwd;
|
|
998 |
$cwdtemp =~ s/%(\w+)%/$ENV{$1}/g;
|
|
999 |
# If $cwd does not starts with a drive letter or absolute path then add the source Directory on the front
|
|
1000 |
if (!(($cwdtemp =~ /^\w:[\\]/) || ($cwdtemp =~ /^\\/)))
|
|
1001 |
{
|
|
1002 |
$cwd = $iEffectiveDir . $cwd;
|
|
1003 |
}
|
|
1004 |
$task_elem->setAttribute('Cwd', $cwd);
|
|
1005 |
$task_elem->setAttribute('CommandLine', $child->getAttributeNode("command")->getValue);
|
|
1006 |
$$commands->appendChild($task_elem);
|
|
1007 |
$$commands->addText("\n");
|
|
1008 |
} elsif ($child->getTagName eq "buildLayer") {
|
|
1009 |
# targetParallel & unitParallel are optional so check that they exist before trying to get the value.
|
|
1010 |
my $unitP = $child->getAttribute("unitParallel");
|
|
1011 |
my $targetP = $child->getAttribute("targetParallel") if ($child->getAttributeNode("targetParallel"));
|
|
1012 |
my $abldCommand = $child->getAttribute("command");
|
|
1013 |
|
|
1014 |
# Build the list of targets, targets are optional
|
|
1015 |
if ($child->getAttributeNode("targetList"))
|
|
1016 |
{
|
|
1017 |
@targets = &find_targetList_by_ID($doc, $child->getAttributeNode("targetList")->getValue);
|
|
1018 |
} else {
|
|
1019 |
# There are no targets associated with this buildlayer
|
|
1020 |
$targetP = "NA"; # Not applicable
|
|
1021 |
}
|
|
1022 |
|
|
1023 |
# Build the correct option string
|
|
1024 |
my $optionStr = "";
|
|
1025 |
foreach my $option (@$options)
|
|
1026 |
{
|
|
1027 |
# only add -savespace if the command abld target or abld build take this option
|
|
1028 |
# don't add -keepgoing if -what or -check are part of the command
|
|
1029 |
if ((($option =~ /\s*-savespace\s*/i) || ($option =~ /\s*-s\s*/i) ) && (($abldCommand =~ /^\s*abld\s+makefile/i) || ($abldCommand =~ /^\s*abld\s+target/i) || ($abldCommand =~ /^\s*abld\s+build/i)))
|
|
1030 |
{
|
|
1031 |
$optionStr .= " $option" ;
|
|
1032 |
}
|
|
1033 |
if (($option =~ /\s*-keepgoing\s*/i) || ($option =~ /\s*-k\s*/i) )
|
|
1034 |
{
|
|
1035 |
if (!(($abldCommand =~ /^\s*abld\s+\w*\s*\w*\s*-check\s*/i) || ($abldCommand =~ /^\s*abld\s+\w*\s*\w*\s*-c\s*/i) || ($abldCommand =~ /^\s*abld\s+\w*\s*\w*\s*-what\s*/i) || ($abldCommand =~ /^\s*abld\s+\w*\s*\w*\s*-w\s*/i)))
|
|
1036 |
{
|
|
1037 |
$optionStr .= " $option" ;
|
|
1038 |
}
|
|
1039 |
}
|
|
1040 |
# This allows us to either build symbol files or not build symbols to save build time.
|
|
1041 |
# only add -no_debug if the command abld makefile
|
|
1042 |
if (($option =~ /\s*-no_debug\s*/i) && ($abldCommand =~ /^\s*abld\s+makefile/i))
|
|
1043 |
{
|
|
1044 |
$optionStr .= " $option" ;
|
|
1045 |
}
|
|
1046 |
}
|
|
1047 |
|
|
1048 |
# Remove the mrp-only entries from the bldList
|
|
1049 |
my @bldInfList;
|
|
1050 |
foreach my $array (@{$bldList})
|
|
1051 |
{
|
|
1052 |
push @bldInfList, $array if ($$array[1] ne "");
|
|
1053 |
}
|
|
1054 |
|
|
1055 |
# Cover all the combinations of units and targets
|
|
1056 |
my ($Ref1, $Ref2, $loop1, $loop2);
|
|
1057 |
|
|
1058 |
if ($targetP eq "N")
|
|
1059 |
{
|
|
1060 |
# Got to switch order of looping
|
|
1061 |
$Ref2 = \@bldInfList;
|
|
1062 |
$Ref1 = \@targets;
|
|
1063 |
$loop2 = $unitP;
|
|
1064 |
$loop1 = $targetP;
|
|
1065 |
} else {
|
|
1066 |
$Ref1 = \@bldInfList;
|
|
1067 |
$Ref2 = \@targets;
|
|
1068 |
$loop1 = $unitP;
|
|
1069 |
$loop2 = $targetP;
|
|
1070 |
}
|
|
1071 |
|
|
1072 |
for (my $i = 0; $i < scalar(@$Ref1); $i++)
|
|
1073 |
{
|
|
1074 |
if ($targetP ne "NA")
|
|
1075 |
{
|
|
1076 |
for (my $j = 0; $j < scalar(@$Ref2); $j++)
|
|
1077 |
{
|
|
1078 |
# Create the element
|
|
1079 |
my $task_elem = $$outDoc->createElement('Execute');
|
|
1080 |
$task_elem->setAttribute('ID', $$ID);
|
|
1081 |
$$ID++; # The ID must always be incremented
|
|
1082 |
$task_elem->setAttribute('Stage', $$Stage);
|
|
1083 |
|
|
1084 |
if ($targetP eq "N") {
|
|
1085 |
# loops swapped but the order of unitP and targetP need to be swapped back
|
|
1086 |
# unit (Component) name is the 0 element of the sub array, source location in element 1
|
|
1087 |
$task_elem->setAttribute('Component',$$Ref2[$j][0]);
|
|
1088 |
# Find the bldFile directory and set as Cwd
|
|
1089 |
$task_elem->setAttribute('Cwd',$$Ref2[$j][1]);
|
|
1090 |
|
|
1091 |
$task_elem->setAttribute('CommandLine',$abldCommand.$optionStr." ".$$Ref1[$i]);
|
|
1092 |
$$commands->appendChild($task_elem);
|
|
1093 |
$$commands->addText("\n");
|
|
1094 |
} else {
|
|
1095 |
# unit (Component) name is the 0 element of the sub array, source location in element 1
|
|
1096 |
$task_elem->setAttribute('Component',$$Ref1[$i][0]);
|
|
1097 |
# Find the bldFile directory and set as Cwd
|
|
1098 |
$task_elem->setAttribute('Cwd',$$Ref1[$i][1]);
|
|
1099 |
|
|
1100 |
$task_elem->setAttribute('CommandLine',$abldCommand.$optionStr." ".$$Ref2[$j]);
|
|
1101 |
$$commands->appendChild($task_elem);
|
|
1102 |
$$commands->addText("\n");
|
|
1103 |
}
|
|
1104 |
$$Stage++ if (($loop1 eq "N") && ($loop2 eq "N"));
|
|
1105 |
}
|
|
1106 |
$$Stage++ if (($loop1 eq "N") && ($loop2 eq "Y"));
|
|
1107 |
} else {
|
|
1108 |
# Create the element
|
|
1109 |
my $task_elem = $$outDoc->createElement('Execute');
|
|
1110 |
$task_elem->setAttribute('ID', $$ID);
|
|
1111 |
$$ID++; # The ID must always be incremented
|
|
1112 |
$task_elem->setAttribute('Stage', $$Stage);
|
|
1113 |
|
|
1114 |
# unit (Component) name is the 0 element of the sub array, source location in element 1
|
|
1115 |
$task_elem->setAttribute('Component',$$Ref1[$i][0]);
|
|
1116 |
# Find the bldFile directory and set as Cwd
|
|
1117 |
$task_elem->setAttribute('Cwd',$$Ref1[$i][1]);
|
|
1118 |
|
|
1119 |
$task_elem->setAttribute('CommandLine',$abldCommand.$optionStr);
|
|
1120 |
$$commands->appendChild($task_elem);
|
|
1121 |
$$commands->addText("\n");
|
|
1122 |
|
|
1123 |
$$Stage++ if ($loop1 ne "Y");
|
|
1124 |
}
|
|
1125 |
}
|
|
1126 |
# Add the * (stage++) for the combinations that don't get this done by the loops
|
|
1127 |
$$Stage++ if ($loop1 eq "Y");
|
|
1128 |
}
|
|
1129 |
}
|
|
1130 |
}
|
|
1131 |
}
|
|
1132 |
|
|
1133 |
# delete_unmatched_units
|
|
1134 |
#
|
|
1135 |
# Inputs
|
|
1136 |
# $node - node in the system model
|
|
1137 |
# $deletedref - reference to hash of deleted unitIDs
|
|
1138 |
#
|
|
1139 |
# Outputs
|
|
1140 |
# Returns 1 if all significant children of the node have been removed
|
|
1141 |
#
|
|
1142 |
# Description
|
|
1143 |
# This function simplifies the XML by removing anything which wasn't marked as MATCHED.
|
|
1144 |
# It's called recursively so that it can "clean up" the structure if whole subtrees have
|
|
1145 |
# all of their significant content removed.
|
|
1146 |
sub delete_unmatched_units
|
|
1147 |
{
|
|
1148 |
my ($node, $deletedUnitsRef) = @_;
|
|
1149 |
my @children = $node->getChildNodes;
|
|
1150 |
return 0 if (scalar @children == 0);
|
|
1151 |
my $now_empty = 1;
|
|
1152 |
my $deleted_something = 0;
|
|
1153 |
foreach my $child (@children)
|
|
1154 |
{
|
|
1155 |
if ($child->getNodeTypeName ne "ELEMENT_NODE")
|
|
1156 |
{
|
|
1157 |
# text and comments don't count
|
|
1158 |
next;
|
|
1159 |
}
|
|
1160 |
my $tag = $child->getTagName;
|
|
1161 |
my $deletedThis = 0;
|
|
1162 |
if ((($tag eq "unit" || $tag eq "package" || $tag eq "prebuilt") && $iVer == 1) || (($tag eq "component" || $tag eq "unit") && $iVer == 2))
|
|
1163 |
{
|
|
1164 |
# only units,prebuilts & packages are tagged
|
|
1165 |
if (!$child->getAttribute("MATCHED"))
|
|
1166 |
{
|
|
1167 |
if ($tag eq "unit")
|
|
1168 |
{
|
|
1169 |
my $unitID = $child->getAttribute("unitID");
|
|
1170 |
$$deletedUnitsRef{$unitID} = 1;
|
|
1171 |
}
|
|
1172 |
if($tag eq "unit" && $iVer == 2)
|
|
1173 |
{
|
|
1174 |
my $version = $child->getAttribute("version");
|
|
1175 |
printf $GenXml::gLogFileH "Simplification removed $tag %s %s\n", ($version eq '') ? 'from' : "v$version of" ,$node->getAttribute("name");
|
|
1176 |
}
|
|
1177 |
else
|
|
1178 |
{
|
|
1179 |
printf $GenXml::gLogFileH "Simplification removed $tag %s\n", $child->getAttribute("name");
|
|
1180 |
}
|
|
1181 |
$node->removeChild($child);
|
|
1182 |
$deletedThis = 1;
|
|
1183 |
$deleted_something = 1;
|
|
1184 |
}
|
|
1185 |
else
|
|
1186 |
{
|
|
1187 |
$child->removeAttribute("MATCHED");
|
|
1188 |
$now_empty = 0; # something left in due to this child
|
|
1189 |
}
|
|
1190 |
}
|
|
1191 |
# keep going to filter child units
|
|
1192 |
if (!$deletedThis && $tag ne "unit" && $tag ne "package" && $tag ne "prebuilt")
|
|
1193 |
{
|
|
1194 |
if (delete_unmatched_units($child,$deletedUnitsRef) == 1)
|
|
1195 |
{
|
|
1196 |
# Child was empty and can be removed
|
|
1197 |
$node->removeChild($child);
|
|
1198 |
$deleted_something = 1;
|
|
1199 |
}
|
|
1200 |
else
|
|
1201 |
{
|
|
1202 |
$now_empty = 0; # something left in due to this child
|
|
1203 |
}
|
|
1204 |
}
|
|
1205 |
}
|
|
1206 |
return 0 unless ($deleted_something);
|
|
1207 |
return $now_empty;
|
|
1208 |
}
|
|
1209 |
|
|
1210 |
|
|
1211 |
# Filter_doc
|
|
1212 |
#
|
|
1213 |
# Inputs
|
|
1214 |
# $doc - Reference to input document
|
|
1215 |
# $iFilter - filter to apply
|
|
1216 |
#
|
|
1217 |
# Outputs
|
|
1218 |
#
|
|
1219 |
# Description
|
|
1220 |
# This function simplifies the XML by removing anything which fails to pass the filter.
|
|
1221 |
# The resulting doc is then useful for tools which don't understand the filter attributes.
|
|
1222 |
sub Filter_doc
|
|
1223 |
{
|
|
1224 |
my ($doc, $iFilter) = @_;
|
|
1225 |
|
|
1226 |
# the filtering will have to be
|
|
1227 |
# - find the configurations which pass the filter (and delete the rest)
|
|
1228 |
# - identify items which are kept by some configuration
|
|
1229 |
# - remove the ones which aren't kept by any configuration.
|
|
1230 |
|
|
1231 |
# deal with the <configuration> items, checking their filters
|
|
1232 |
my %unitLists;
|
|
1233 |
my @nodes = $doc->getElementsByTagName ("configuration");
|
|
1234 |
foreach my $node (@nodes)
|
|
1235 |
{
|
|
1236 |
my $configname = $node->getAttribute("name");
|
|
1237 |
my @configspec = split /,/,$node->getAttribute("filter");
|
|
1238 |
my $failed = check_filter($iFilter,\@configspec);
|
|
1239 |
if ($failed ne "")
|
|
1240 |
{
|
|
1241 |
print $GenXml::gLogFileH "Simplification removed configuration $configname ($failed)\n";
|
|
1242 |
$node->getParentNode->removeChild($node);
|
|
1243 |
next;
|
|
1244 |
}
|
|
1245 |
# find all the units for this configuration and mark them as MATCHED
|
|
1246 |
print $GenXml::gLogFileH "Analysing configuration $configname...\n";
|
|
1247 |
my $units = get_configuration_units($doc, $node, 0, 0);
|
|
1248 |
foreach my $unit (@$units)
|
|
1249 |
{
|
|
1250 |
$unit->setAttribute("MATCHED", 1);
|
|
1251 |
}
|
|
1252 |
# note all the unitLists referenced by this configuration
|
|
1253 |
foreach my $unitListRef ($node->getElementsByTagName("unitListRef"))
|
|
1254 |
{
|
|
1255 |
my $unitList = $unitListRef->getAttribute("unitList");
|
|
1256 |
$unitLists{$unitList} = 1;
|
|
1257 |
}
|
|
1258 |
}
|
|
1259 |
# walk the model, removing the "MATCHED" attribute and deleting any which weren't marked
|
|
1260 |
my %deletedUnits;
|
|
1261 |
delete_unmatched_units($doc, \%deletedUnits);
|
|
1262 |
|
|
1263 |
# clean up the unitlists
|
|
1264 |
my @unitLists = $doc->getElementsByTagName("unitList");
|
|
1265 |
foreach my $unitList (@unitLists)
|
|
1266 |
{
|
|
1267 |
my $name = $unitList->getAttribute("name");
|
|
1268 |
if (!defined $unitLists{$name})
|
|
1269 |
{
|
|
1270 |
print $GenXml::gLogFileH "Simplification removed unitList $name\n";
|
|
1271 |
$unitList->getParentNode->removeChild($unitList);
|
|
1272 |
next;
|
|
1273 |
}
|
|
1274 |
foreach my $unitRef ($unitList->getElementsByTagName("unitRef"))
|
|
1275 |
{
|
|
1276 |
my $id = $unitRef->getAttribute("unit");
|
|
1277 |
if (defined $deletedUnits{$id})
|
|
1278 |
{
|
|
1279 |
$unitList->removeChild($unitRef); # reference to deleted unit
|
|
1280 |
}
|
|
1281 |
}
|
|
1282 |
}
|
|
1283 |
|
|
1284 |
}
|
|
1285 |
|
|
1286 |
# find_configuration
|
|
1287 |
#
|
|
1288 |
# Inputs
|
|
1289 |
# $doc - DOM document model
|
|
1290 |
# $iConfName - configuration name
|
|
1291 |
#
|
|
1292 |
# Outputs
|
|
1293 |
# $configuration - the node of the named configuration
|
|
1294 |
#
|
|
1295 |
# Description
|
|
1296 |
# This function locates and returns the named configuration node
|
|
1297 |
sub find_configuration
|
|
1298 |
{
|
|
1299 |
my ($doc, $iConfName) = @_;
|
|
1300 |
|
|
1301 |
# Find the named configuration
|
|
1302 |
my @nodes = $doc->getElementsByTagName ("configuration");
|
|
1303 |
foreach my $node (@nodes)
|
|
1304 |
{
|
|
1305 |
my $name = $node->getAttributeNode ("name");
|
|
1306 |
if ($name->getValue eq $iConfName)
|
|
1307 |
{
|
|
1308 |
return $node;
|
|
1309 |
}
|
|
1310 |
}
|
|
1311 |
|
|
1312 |
# If no configuration has been found the produce ERROR message
|
|
1313 |
die "ERROR: RealTimeBuild: Named configuration $iConfName not found\n";
|
|
1314 |
}
|
|
1315 |
|
|
1316 |
# process_configuration
|
|
1317 |
#
|
|
1318 |
# Inputs
|
|
1319 |
# $doc - DOM document model
|
|
1320 |
# $iConfName - name of the configuration
|
|
1321 |
# $iVersion - Version of xml file (new or old) ?
|
|
1322 |
#
|
|
1323 |
# Outputs
|
|
1324 |
# $topunits - reference to a list of units in the main configuration
|
|
1325 |
# $subunits - reference to a list of local units contained within subtasks
|
|
1326 |
# \@options - reference to a list of options which apply (curently global options)
|
|
1327 |
# \@tasks - reference to a list of the task nodes for the configuration
|
|
1328 |
#
|
|
1329 |
# Description
|
|
1330 |
# This function locates the named configuration and processes it into
|
|
1331 |
# a list of units, the build options which apply, and the task elements in
|
|
1332 |
# the configuration.
|
|
1333 |
sub process_configuration
|
|
1334 |
{
|
|
1335 |
my ($doc, $iConfName, $iVersion) = @_;
|
|
1336 |
|
|
1337 |
my @options; # list of global options
|
|
1338 |
my @units; # list of individual buildable items
|
|
1339 |
|
|
1340 |
# NB. getElementsByTagName in list context returns a list, so
|
|
1341 |
# the following statement gets only the first element of the list
|
|
1342 |
my ($build, @nodes);
|
|
1343 |
if ($iVersion == 1) {
|
|
1344 |
$build = $doc->getElementsByTagName("build");
|
|
1345 |
} else {
|
|
1346 |
$build = $doc->getElementsByTagName("SystemBuild");
|
|
1347 |
}
|
|
1348 |
|
|
1349 |
@nodes = $build->[0]->getElementsByTagName("option");
|
|
1350 |
|
|
1351 |
# Read the global options (savespace and keepgoing)
|
|
1352 |
foreach my $node (@nodes)
|
|
1353 |
{
|
|
1354 |
my $name = $node->getAttributeNode("abldOption");
|
|
1355 |
my $enable = $node->getAttributeNode("enable")->getValue;
|
|
1356 |
push @options, $name->getValue if ($enable =~ /Y/i);
|
|
1357 |
}
|
|
1358 |
|
|
1359 |
# Find named configuration
|
|
1360 |
my $configuration = find_configuration($doc, $iConfName);
|
|
1361 |
|
|
1362 |
# Get the list of tasks
|
|
1363 |
my @tasks = $configuration->getElementsByTagName("task");
|
|
1364 |
|
|
1365 |
my ($topunits, $subunits);
|
|
1366 |
# Get the filtered list of units
|
|
1367 |
if ($iVersion == 1) {
|
|
1368 |
$topunits = get_configuration_units($doc, $configuration, 1, 1);
|
|
1369 |
$subunits = get_configuration_units($doc, $configuration, 1, 2);
|
|
1370 |
} elsif ($iVersion == 2) {
|
|
1371 |
$topunits = get_configuration_units2($doc, $configuration, 1, 1);
|
|
1372 |
|
|
1373 |
$subunits = get_configuration_units2($doc, $configuration, 1, 2);
|
|
1374 |
}
|
|
1375 |
|
|
1376 |
return ($topunits, $subunits,\@options,\@tasks);
|
|
1377 |
}
|
|
1378 |
|
|
1379 |
# check_filter
|
|
1380 |
#
|
|
1381 |
# Inputs
|
|
1382 |
# $item_filter - filter specification (comma-separated list of words)
|
|
1383 |
# $configspec - configuration specification (reference to list of words)
|
|
1384 |
#
|
|
1385 |
# Outputs
|
|
1386 |
# $failed - filter item which did not agree with the configuration (if any)
|
|
1387 |
# An empty string is returned if the configspec passed the filter
|
|
1388 |
#
|
|
1389 |
# Description
|
|
1390 |
# This function checks the configspec list of words against the words in the
|
|
1391 |
# filter. If a word is present in the filter, then it must also be present in
|
|
1392 |
# the configspec. If "!word" is present in the filter, then "word" must not
|
|
1393 |
# be present in the configspec.
|
|
1394 |
sub check_filter($$) {
|
|
1395 |
my ($item_filter, $configspec) = @_;
|
|
1396 |
my $failed = "";
|
|
1397 |
foreach my $word (split /,/,$item_filter) {
|
|
1398 |
if ($word =~ /^!/) {
|
|
1399 |
# word must NOT be present in configuration filter list
|
|
1400 |
my $notword = substr $word, 1;
|
|
1401 |
$failed = $word if grep(/^$notword$/, @$configspec);
|
|
1402 |
}
|
|
1403 |
else {
|
|
1404 |
# word must be present in configuration filter list
|
|
1405 |
$failed = $word unless grep(/^$word$/, @$configspec);
|
|
1406 |
}
|
|
1407 |
}
|
|
1408 |
return $failed;
|
|
1409 |
}
|
|
1410 |
|
|
1411 |
# get_configuration_units
|
|
1412 |
#
|
|
1413 |
# Inputs
|
|
1414 |
# $doc - DOM document model
|
|
1415 |
# $configuration - configuration node
|
|
1416 |
# $verbose - enable/disable logging
|
|
1417 |
# $level - 0 = all units, 1 = top-level units, 2 = local units within tasks
|
|
1418 |
#
|
|
1419 |
# Outputs
|
|
1420 |
# \@units - reference to a list of unit,package & prebuilt nodes which implement this configuration
|
|
1421 |
#
|
|
1422 |
# Description
|
|
1423 |
# This function processes the specified configuration to get the list of unit or package
|
|
1424 |
# nodes that implement this configuration.
|
|
1425 |
sub get_configuration_units ($$$$)
|
|
1426 |
{
|
|
1427 |
my ($doc, $configuration, $verbose, $level) = @_;
|
|
1428 |
my @units; # list of individual buildable items
|
|
1429 |
|
|
1430 |
my ($model) = $doc->getElementsByTagName("SystemDefinition");
|
|
1431 |
|
|
1432 |
# Start with the units specified via unitListRefs, then append the
|
|
1433 |
# units specified via layerRefs - they will be sorted afterwards anyway
|
|
1434 |
|
|
1435 |
my @unitlistrefs = $configuration->getElementsByTagName("unitListRef");
|
|
1436 |
foreach my $child (@unitlistrefs) {
|
|
1437 |
my $issublevel = $child->getParentNode->getTagName ne "configuration";
|
|
1438 |
next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
|
|
1439 |
push @units, &find_unitList_by_ID($doc, $child->getAttribute("unitList"), 1);
|
|
1440 |
}
|
|
1441 |
my @layerrefs = $configuration->getElementsByTagName("layerRef");
|
|
1442 |
foreach my $child (@layerrefs) {
|
|
1443 |
my $issublevel = $child->getParentNode->getTagName ne "configuration";
|
|
1444 |
next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
|
|
1445 |
my $layerName = $child->getAttribute("layerName");
|
|
1446 |
# Find the named object and enumerate the units it contains
|
|
1447 |
my ($layer) = XML::XQL::solve("//*[\@name = '$layerName']", $model);
|
|
1448 |
if (!defined($layer)) {
|
|
1449 |
print $GenXml::gLogFileH "ERROR: no match for \"$layerName\"\n";
|
|
1450 |
next;
|
|
1451 |
}
|
|
1452 |
my @newunits = $layer->getElementsByTagName("unit",1);
|
|
1453 |
my @newpackages = $layer->getElementsByTagName("package",1);
|
|
1454 |
my @newprebuilts = $layer->getElementsByTagName("prebuilt",1);
|
|
1455 |
if ($verbose) {
|
|
1456 |
printf $GenXml::gLogFileH "Layer \"$layerName\" contained %d units, %d packages and %d prebuilt\n",
|
|
1457 |
scalar @newunits, scalar @newpackages, scalar @newprebuilts;
|
|
1458 |
}
|
|
1459 |
push @newunits, @newpackages, @newprebuilts;
|
|
1460 |
if (scalar @newunits == 0) {
|
|
1461 |
print $GenXml::gLogFileH "WARNING: layerRef $layerName contains no units\n";
|
|
1462 |
}
|
|
1463 |
push @units, @newunits;
|
|
1464 |
}
|
|
1465 |
|
|
1466 |
my @configspec = split /,/,$configuration->getAttribute("filter");
|
|
1467 |
my @filtered_units;
|
|
1468 |
|
|
1469 |
# Scan the list, eliminating duplicates and elements which fail the filtering
|
|
1470 |
my %mrpfiles;
|
|
1471 |
foreach my $element (@units) {
|
|
1472 |
my $name = $element->getAttribute("name");
|
|
1473 |
my $filter = $element->getAttribute("filter");
|
|
1474 |
|
|
1475 |
if ($filter) {
|
|
1476 |
my $failed = &check_filter($filter,\@configspec);
|
|
1477 |
if ($failed ne "") {
|
|
1478 |
print $GenXml::gLogFileH "Filtered out $name ($failed)\n" if ($verbose);
|
|
1479 |
next;
|
|
1480 |
}
|
|
1481 |
}
|
|
1482 |
|
|
1483 |
my $mrp = $element->getAttribute("mrp");
|
|
1484 |
if ($mrp) {
|
|
1485 |
my $unitID = $element->getAttribute("unitID");
|
|
1486 |
if (defined($mrpfiles{$mrp})) {
|
|
1487 |
# eliminate duplicates
|
|
1488 |
next if ($mrpfiles{$mrp} eq $unitID);
|
|
1489 |
# report (and eliminate) conflicts
|
|
1490 |
printf $GenXml::gLogFileH "WARNING: $mrp exists in %s and %s - skipping $unitID\n", $unitID, $mrpfiles{$mrp};
|
|
1491 |
next;
|
|
1492 |
}
|
|
1493 |
$mrpfiles{$mrp} = $unitID;
|
|
1494 |
}
|
|
1495 |
push @filtered_units, $element;
|
|
1496 |
}
|
|
1497 |
|
|
1498 |
if ($verbose) {
|
|
1499 |
printf $GenXml::gLogFileH "%s contains %d units at level %d\n",
|
|
1500 |
$configuration->getAttribute("name"), scalar @filtered_units, $level;
|
|
1501 |
}
|
|
1502 |
return \@filtered_units;
|
|
1503 |
}
|
|
1504 |
|
|
1505 |
# compute_bldList
|
|
1506 |
#
|
|
1507 |
# Inputs
|
|
1508 |
# $iSourceDir - root of the current source tree
|
|
1509 |
# $iEffectiveDir - root of the source tree when used
|
|
1510 |
# $elements - reference to list of units, packages & prebuilts which can be part of the configuration
|
|
1511 |
# $iVersion - Version of xml file (new or old) ?
|
|
1512 |
#
|
|
1513 |
# Outputs
|
|
1514 |
# @bldList - a list of [name, bld.inf_dir, mrpfile] arrays, using $iEffectiveDir
|
|
1515 |
#
|
|
1516 |
# Description
|
|
1517 |
# This function processes a list of unit and package elements, extracting from
|
|
1518 |
# them the location of the associated bld.inf files. If bld.inf_dir is "" then
|
|
1519 |
# no bld.inf was specified (e.g. a package) or the bld.inf file does not exist.
|
|
1520 |
# If mrpfile is "" then no mrp file was specified.
|
|
1521 |
# <prebuilt> elements return "*nosource*" as the mrpfile
|
|
1522 |
sub compute_bldList
|
|
1523 |
{
|
|
1524 |
my ($iSourceDir, $iEffectiveDir, $elements, $iVersion) = @_;
|
|
1525 |
my @bldList;
|
|
1526 |
my %priorityLists;
|
|
1527 |
my ($name, $bldFile, $mrp, $priority, $unitID, $effmrp, $effbldFile, $packageName);
|
|
1528 |
my ($count, $unit, @childNodes, @unitNames);
|
|
1529 |
foreach my $element (@$elements)
|
|
1530 |
{
|
|
1531 |
# Variable holding the previous values and so giving wrong results. Lets undefine them.
|
|
1532 |
undef $name; undef $bldFile; undef $mrp; undef $priority; undef $unitID; undef $effmrp; undef $effbldFile;
|
|
1533 |
if ($iVersion == 1) {
|
|
1534 |
push(@childNodes,$element);
|
|
1535 |
} elsif ($iVersion == 2) {
|
|
1536 |
my @units = $element->getElementsByTagName("unit");
|
|
1537 |
for ( @units )
|
|
1538 |
{
|
|
1539 |
push(@childNodes, $_);
|
|
1540 |
push(@unitNames, $element->getElementsByTagName("name"));
|
|
1541 |
}
|
|
1542 |
}
|
|
1543 |
}
|
|
1544 |
|
|
1545 |
# should only be one childNodes, but this will make sure we handle all in case there are any
|
|
1546 |
for my $index ( 0 .. $#childNodes ) {
|
|
1547 |
my $unit = $childNodes[$index];
|
|
1548 |
my $unitName = $unitNames[$index];
|
|
1549 |
if ($iVersion == 1) {
|
|
1550 |
$name = $unit->getAttribute("name");
|
|
1551 |
$bldFile = $unit->getAttribute("bldFile");
|
|
1552 |
$mrp = $unit->getAttribute("mrp");
|
|
1553 |
$priority = $unit->getAttribute("priority");
|
|
1554 |
$unitID = $unit->getAttribute("unitID");
|
|
1555 |
$effmrp = $mrp;
|
|
1556 |
$effbldFile = $bldFile;
|
|
1557 |
} elsif ($iVersion == 2) {
|
|
1558 |
$name = $unitName;
|
|
1559 |
$bldFile = $unit->getAttribute("bldFile");
|
|
1560 |
$mrp = $unit->getAttribute("mrp");
|
|
1561 |
$priority = $unit->getAttribute("priority");
|
|
1562 |
$mrp =~ /.+\\([\w_-]+)\.mrp/;
|
|
1563 |
$packageName = $1;
|
|
1564 |
$effmrp = $mrp;
|
|
1565 |
$effbldFile = $bldFile;
|
|
1566 |
$unitID = $name;
|
|
1567 |
}
|
|
1568 |
|
|
1569 |
if ($mrp)
|
|
1570 |
{
|
|
1571 |
if ($mrp !~ /^\\/)
|
|
1572 |
{
|
|
1573 |
# watch out for mrp="\product\..."
|
|
1574 |
$mrp = $iSourceDir.$mrp;
|
|
1575 |
$effmrp = $iEffectiveDir.$effmrp;
|
|
1576 |
}
|
|
1577 |
if (-f $mrp)
|
|
1578 |
{
|
|
1579 |
# get the component name
|
|
1580 |
open MRPFILE, "<$mrp"
|
|
1581 |
or print $GenXml::gLogFileH "ERROR: Cannot read $mrp - skipping \"$unitID\"\n" and next;
|
|
1582 |
my $mrpline;
|
|
1583 |
while ($mrpline = <MRPFILE>)
|
|
1584 |
{
|
|
1585 |
if ($mrpline =~ /^\s*component\s+(\S+)/)
|
|
1586 |
{
|
|
1587 |
$name = $1;
|
|
1588 |
last;
|
|
1589 |
}
|
|
1590 |
}
|
|
1591 |
close MRPFILE;
|
|
1592 |
} else {
|
|
1593 |
# print $GenXml::gLogFileH "ERROR: $mrp does not exist - skipping \"$unitID\"\n";
|
|
1594 |
# next;
|
|
1595 |
$name = $packageName if defined $packageName;
|
|
1596 |
# Unfortunately, we need to cope with the pkgdefs components which are created later
|
|
1597 |
print $GenXml::gLogFileH "REMARK: $mrp does not exist - assuming $name is correct...\n";
|
|
1598 |
}
|
|
1599 |
} else {
|
|
1600 |
$mrp = "";
|
|
1601 |
$effmrp = "";
|
|
1602 |
}
|
|
1603 |
if ($bldFile)
|
|
1604 |
{
|
|
1605 |
if ($bldFile =~ /^\w:\\/)
|
|
1606 |
{
|
|
1607 |
print "Warning:Bldfile path should not contain drive letters.The build may continue with problems\n";
|
|
1608 |
}
|
|
1609 |
else
|
|
1610 |
{
|
|
1611 |
if ($bldFile =~ /^\\/)
|
|
1612 |
{
|
|
1613 |
# No need to add the source dir path
|
|
1614 |
}
|
|
1615 |
else
|
|
1616 |
{
|
|
1617 |
$bldFile = $iSourceDir.$bldFile;
|
|
1618 |
$effbldFile = $iEffectiveDir.$effbldFile;
|
|
1619 |
}
|
|
1620 |
}
|
|
1621 |
if (!-f "$bldFile\\BLD.INF")
|
|
1622 |
{
|
|
1623 |
print $GenXml::gLogFileH "ERROR: $bldFile\\BLD.INF does not exist - skipping \"$unitID\"\n";
|
|
1624 |
next;
|
|
1625 |
}
|
|
1626 |
} else {
|
|
1627 |
$bldFile = "";
|
|
1628 |
$effbldFile = "";
|
|
1629 |
}
|
|
1630 |
|
|
1631 |
if ($mrp eq "" && $bldFile eq "") {
|
|
1632 |
if ($iVersion == 1) {
|
|
1633 |
if ($unit->getTagName eq "prebuilt") {
|
|
1634 |
$mrp = "*nosource*";
|
|
1635 |
$effmrp = $mrp;
|
|
1636 |
}
|
|
1637 |
} elsif ($iVersion == 2) {
|
|
1638 |
if ($unit->getAttribute("prebuilt")) {
|
|
1639 |
$mrp = "*nosource*";
|
|
1640 |
$effmrp = $mrp;
|
|
1641 |
$name = $unit->getAttribute("prebuilt");
|
|
1642 |
}
|
|
1643 |
}
|
|
1644 |
}
|
|
1645 |
if($mrp eq "" && $bldFile eq "") {
|
|
1646 |
#print $GenXml::gLogFileH "ERROR: no MRP file, no BLD.INF directory - skipping \"$unitID\"\n";
|
|
1647 |
next;
|
|
1648 |
}
|
|
1649 |
|
|
1650 |
if (!$priority)
|
|
1651 |
{
|
|
1652 |
$priority = 1000;
|
|
1653 |
}
|
|
1654 |
|
|
1655 |
if (! defined($priorityLists{$priority}))
|
|
1656 |
{
|
|
1657 |
$priorityLists{$priority} = ();
|
|
1658 |
}
|
|
1659 |
push @{$priorityLists{$priority}}, [$name,$effbldFile,$effmrp];
|
|
1660 |
}
|
|
1661 |
|
|
1662 |
# concatenate the lists in (ascending numerical) priority order
|
|
1663 |
foreach my $priority (sort {$a <=> $b} keys %priorityLists)
|
|
1664 |
{
|
|
1665 |
push @bldList, @{$priorityLists{$priority}};
|
|
1666 |
}
|
|
1667 |
|
|
1668 |
return @bldList;
|
|
1669 |
}
|
|
1670 |
|
|
1671 |
# find_unitList_by_ID
|
|
1672 |
#
|
|
1673 |
# Inputs
|
|
1674 |
# $doc - DOM document model
|
|
1675 |
# $id - the IDREF of the unitList
|
|
1676 |
# $iVersion - Version of xml file (new or old) ?
|
|
1677 |
#
|
|
1678 |
# Outputs
|
|
1679 |
# @units - a list of unit elements referenced in the specified unit list
|
|
1680 |
#
|
|
1681 |
# Description
|
|
1682 |
# This function is used to convert a unitListRef into the corresponding
|
|
1683 |
# list of units.
|
|
1684 |
sub find_unitList_by_ID()
|
|
1685 |
{
|
|
1686 |
my ($doc, $id, $iVersion) = @_;
|
|
1687 |
|
|
1688 |
my (@units, @element); # List of units in unitList and elements
|
|
1689 |
my ($unitList, $unitRef, $attribute);
|
|
1690 |
if ($iVersion == 1) {
|
|
1691 |
$unitList = "unitList" ;
|
|
1692 |
$unitRef = "unitRef";
|
|
1693 |
$attribute = "unit";
|
|
1694 |
@element = XML::XQL::solve("//unitList[\@name = '$id']", $doc);
|
|
1695 |
} elsif ($iVersion == 2) {
|
|
1696 |
$unitList = "list" ;
|
|
1697 |
$unitRef = "ref";
|
|
1698 |
$attribute = "item";
|
|
1699 |
@element = XML::XQL::solve("//list[\@name = '$id']", $doc);
|
|
1700 |
}
|
|
1701 |
|
|
1702 |
# Should only return one element because the Validating Parser will not allow multiple DTD ID's
|
|
1703 |
if (!($element[0]))
|
|
1704 |
{
|
|
1705 |
print $GenXml::gLogFileH "ERROR: Cannot find $unitList $id\n";
|
|
1706 |
die "ERROR: RealTimeBuild: Cannot find $unitList $id\n";
|
|
1707 |
}
|
|
1708 |
my @unitRefs = $element[0]->getElementsByTagName("$unitRef",1);
|
|
1709 |
if (scalar @unitRefs == 0)
|
|
1710 |
{
|
|
1711 |
print $GenXml::gLogFileH "WARNING: $unitList $id contains no units\n";
|
|
1712 |
}
|
|
1713 |
foreach my $unitRef (@unitRefs)
|
|
1714 |
{
|
|
1715 |
my $unitID = $unitRef->getAttribute("$attribute");
|
|
1716 |
my (@element);
|
|
1717 |
if ($iVersion == 1) {
|
|
1718 |
(@element) = XML::XQL::solve ("//unit[\@unitID = '$unitID']", $doc);
|
|
1719 |
} elsif ($iVersion == 2) {
|
|
1720 |
(@element) = XML::XQL::solve ("//component[\@name = '$unitID']", $doc);
|
|
1721 |
}
|
|
1722 |
if (!($element[0]))
|
|
1723 |
{
|
|
1724 |
print $GenXml::gLogFileH "ERROR: $unitList $id refers to non-existent $attribute $unitID, not building\n";
|
|
1725 |
next;
|
|
1726 |
}
|
|
1727 |
push @units,$element[0];
|
|
1728 |
}
|
|
1729 |
return @units;
|
|
1730 |
}
|
|
1731 |
|
|
1732 |
# find_targetList_by_ID
|
|
1733 |
#
|
|
1734 |
# Inputs
|
|
1735 |
# $doc - reference to DOM document model
|
|
1736 |
# $id - value of the IDREFS to find (multiple whitespace ID's)
|
|
1737 |
#
|
|
1738 |
# Outputs
|
|
1739 |
# @targets - a list of targets referenced in the specified targetList
|
|
1740 |
#
|
|
1741 |
# Description
|
|
1742 |
# This function finds a list of units and full source location
|
|
1743 |
sub find_targetList_by_ID
|
|
1744 |
{
|
|
1745 |
my ($doc, $idrefs) = @_;
|
|
1746 |
|
|
1747 |
my $n; # Number of Nodes
|
|
1748 |
my @targets; # List of units in targetList
|
|
1749 |
|
|
1750 |
# Split on whitespace to get ID's from IDREFS
|
|
1751 |
my @ids = split(/\s+/, $idrefs);
|
|
1752 |
|
|
1753 |
for (my $i = 0; $i < scalar(@ids); $i++)
|
|
1754 |
{
|
|
1755 |
my ($id) = $ids[$i];
|
|
1756 |
my (@element) = XML::XQL::solve("//targetList[\@name = '$id']", $doc);
|
|
1757 |
# Should only return one element because the Validating Parser will not allow multiple DTD ID's
|
|
1758 |
# target attrib is another IDREFS list of target
|
|
1759 |
if (!($element[0]))
|
|
1760 |
{
|
|
1761 |
print $GenXml::gLogFileH "ERROR: Cannot find targetList $id\n";
|
|
1762 |
die "ERROR: RealTimeBuild: Cannot find targetList $id\n";
|
|
1763 |
}
|
|
1764 |
my $targetIDREFS;
|
|
1765 |
if ($element[0])
|
|
1766 |
{
|
|
1767 |
$targetIDREFS = $element[0]->getAttributeNode("target")->getValue;
|
|
1768 |
} else {
|
|
1769 |
print $GenXml::gLogFileH "ERROR: Cannot find targetList of $id\n";
|
|
1770 |
die "ERROR: RealTimeBuild: Processing error\n";
|
|
1771 |
}
|
|
1772 |
|
|
1773 |
# Split on whitespace to get ID's from IDREFS
|
|
1774 |
my @targetsID = split(/\s+/, $targetIDREFS);
|
|
1775 |
for (my $j = 0; $j < scalar(@targetsID); $j++)
|
|
1776 |
{
|
|
1777 |
my ($target) = $targetsID[$j];
|
|
1778 |
my (@target_element) = XML::XQL::solve("//target[\@name = '$target']", $doc);
|
|
1779 |
# Should only return one element because the Validating Parser will not allow multiple DTD ID's
|
|
1780 |
if ($target_element[0])
|
|
1781 |
{
|
|
1782 |
push @targets, $target_element[0]->getAttributeNode("abldTarget")->getValue;
|
|
1783 |
} else {
|
|
1784 |
print $GenXml::gLogFileH "ERROR: Cannot find target of $target\n";
|
|
1785 |
die "ERROR: RealTimeBuild: Processing error\n";
|
|
1786 |
}
|
|
1787 |
}
|
|
1788 |
}
|
|
1789 |
|
|
1790 |
return @targets;
|
|
1791 |
}
|
|
1792 |
|
|
1793 |
# logfileHeader
|
|
1794 |
#
|
|
1795 |
# Inputs
|
|
1796 |
# $comp - string to place in the "component" section of the header
|
|
1797 |
#
|
|
1798 |
# Outputs
|
|
1799 |
#
|
|
1800 |
# Description
|
|
1801 |
# This function print the log file header to te global logfile handle
|
|
1802 |
sub logfileHeader
|
|
1803 |
{
|
|
1804 |
my ($comp) = @_;
|
|
1805 |
|
|
1806 |
if ($gEmbeddedLog)
|
|
1807 |
{
|
|
1808 |
print $GenXml::gLogFileH "*** $comp\n";
|
|
1809 |
return;
|
|
1810 |
}
|
|
1811 |
|
|
1812 |
# Log file headers for each log file loading
|
|
1813 |
print $GenXml::gLogFileH "=== Genxml == $comp\n";
|
|
1814 |
|
|
1815 |
print $GenXml::gLogFileH "-- Genxml\n";
|
|
1816 |
# Add the per command start timestamp
|
|
1817 |
print $GenXml::gLogFileH "++ Started at ".localtime()."\n";
|
|
1818 |
# Add the per command start HiRes timestamp if available
|
|
1819 |
if ($gHiResTimer == 1)
|
|
1820 |
{
|
|
1821 |
print $GenXml::gLogFileH "+++ HiRes Start ".Time::HiRes::time()."\n";
|
|
1822 |
} else {
|
|
1823 |
# Add the HiRes timer missing statement
|
|
1824 |
print $GenXml::gLogFileH "+++ HiRes Time Unavailable\n";
|
|
1825 |
}
|
|
1826 |
$GenXml::gLogFileH->flush;
|
|
1827 |
}
|
|
1828 |
|
|
1829 |
# logfileFooter
|
|
1830 |
#
|
|
1831 |
# Inputs
|
|
1832 |
#
|
|
1833 |
# Outputs
|
|
1834 |
#
|
|
1835 |
# Description
|
|
1836 |
# This function print the log file footer to the global logfile handle
|
|
1837 |
sub logfileFooter
|
|
1838 |
{
|
|
1839 |
return if ($gEmbeddedLog);
|
|
1840 |
|
|
1841 |
# Add the per command end HiRes timestamp if available
|
|
1842 |
print $GenXml::gLogFileH "+++ HiRes End ".Time::HiRes::time()."\n" if ($gHiResTimer == 1);
|
|
1843 |
# Add the per command end timestamp
|
|
1844 |
print $GenXml::gLogFileH "++ Finished at ".localtime()."\n";
|
|
1845 |
$GenXml::gLogFileH->flush;
|
|
1846 |
}
|
|
1847 |
|
|
1848 |
|
|
1849 |
#####################################################################################
|
|
1850 |
#
|
|
1851 |
# v2 api's for new SystemDefinition
|
|
1852 |
#
|
|
1853 |
#####################################################################################
|
|
1854 |
|
|
1855 |
# process_node2
|
|
1856 |
#
|
|
1857 |
# Inputs
|
|
1858 |
# $node1 - ref to the master doc
|
|
1859 |
# $node2 - ref to the slave doc
|
|
1860 |
# $doc1 - ref to the merged doc so we can set the doc owner to the (not DOM spec) to get around WRONG_DOCUMENT_ERR restriction
|
|
1861 |
#
|
|
1862 |
# Outputs
|
|
1863 |
#
|
|
1864 |
# Description
|
|
1865 |
# This function processes a node in two DOM documents, if any children match then it calls itself to process
|
|
1866 |
# the children nodes further
|
|
1867 |
sub process_node2
|
|
1868 |
{
|
|
1869 |
my ($doc1, $doc2) = @_;
|
|
1870 |
|
|
1871 |
my $merged = new XML::DOM::Parser;
|
|
1872 |
|
|
1873 |
# Some nodes need special processing e.g. SystemDefinition
|
|
1874 |
# This is because there can only be a certain number of these nodes
|
|
1875 |
# child node / element rules outlined below, this rules are applied to the children of the node in question
|
|
1876 |
|
|
1877 |
my ($node1, $node2);
|
|
1878 |
|
|
1879 |
# All other nodes Append child
|
|
1880 |
|
|
1881 |
# Useful debug stuff
|
|
1882 |
#$GenXml::count++;
|
|
1883 |
#print "enter $GenXml::count\n";
|
|
1884 |
|
|
1885 |
# Handle the special case for the first call to this function with the node containing the SystemDefinition
|
|
1886 |
if (($$doc1->getDocumentElement->getTagName eq "SystemDefinition")
|
|
1887 |
&& ($$doc2->getDocumentElement->getTagName eq "SystemBuild"))
|
|
1888 |
{
|
|
1889 |
# Process the DTD and merge
|
|
1890 |
my $dtd1 = $$doc1->getDoctype->toString;
|
|
1891 |
my $dtd2 = $$doc2->getDoctype->toString;
|
|
1892 |
my $mergeddtd = &Merge_dtd($dtd1, $dtd2);
|
|
1893 |
$mergeddtd .= $$doc1->getDocumentElement->toString;
|
|
1894 |
$merged = $merged->parse($mergeddtd);
|
|
1895 |
|
|
1896 |
$node1 = \($merged->getElementsByTagName("SystemDefinition"));
|
|
1897 |
$node2 = \($$doc2->getElementsByTagName("SystemBuild"));
|
|
1898 |
|
|
1899 |
my $tagname = $$node2->getTagName;
|
|
1900 |
for my $item ($$doc2->getChildNodes) {
|
|
1901 |
if ($item->toString =~ /^\s*<$tagname .+>/isg) {
|
|
1902 |
&append_child($node1, \($item), \$merged);
|
|
1903 |
last;
|
|
1904 |
}
|
|
1905 |
}
|
|
1906 |
}
|
|
1907 |
|
|
1908 |
return $merged;
|
|
1909 |
}
|
|
1910 |
|
|
1911 |
# Merge_dtd
|
|
1912 |
sub Merge_dtd {
|
|
1913 |
my ($doctype1, $doctype2) = @_;
|
|
1914 |
my $mergeddtd;
|
|
1915 |
|
|
1916 |
# split them into an array of values
|
|
1917 |
my @doctypeValues1 = split '\n', $doctype1;
|
|
1918 |
my @doctypeValues2 = split '\n', $doctype2;
|
|
1919 |
my $elementNameToAdd;
|
|
1920 |
|
|
1921 |
my $count = 1;
|
|
1922 |
for my $line (@doctypeValues2) {
|
|
1923 |
if ( $line =~ /<!ELEMENT (\w+) .+>/ ) {
|
|
1924 |
$elementNameToAdd = $1;
|
|
1925 |
last;
|
|
1926 |
}
|
|
1927 |
$count++;
|
|
1928 |
}
|
|
1929 |
splice @doctypeValues2, 0, $count-1;
|
|
1930 |
|
|
1931 |
my $i;
|
|
1932 |
for ($i=0; $#doctypeValues1; $i++) {
|
|
1933 |
last if ( $doctypeValues1[$i] =~ /<!ELEMENT SystemDefinition .+>/);
|
|
1934 |
}
|
|
1935 |
$doctypeValues1[$i] =~ s/(.+) \)>$/$1?, $elementNameToAdd? )>/;
|
|
1936 |
|
|
1937 |
$#doctypeValues1 = $#doctypeValues1 -1;
|
|
1938 |
|
|
1939 |
push @doctypeValues1, @doctypeValues2;
|
|
1940 |
|
|
1941 |
unshift @doctypeValues1, '<?xml version="1.0" encoding="UTF-8"?>';
|
|
1942 |
$mergeddtd = join "\n", @doctypeValues1;
|
|
1943 |
|
|
1944 |
return $mergeddtd;
|
|
1945 |
}
|
|
1946 |
|
|
1947 |
|
|
1948 |
# Filter_doc2
|
|
1949 |
#
|
|
1950 |
# Inputs
|
|
1951 |
# $doc - Reference to input document
|
|
1952 |
# $iFilter - filter to apply
|
|
1953 |
#
|
|
1954 |
# Outputs
|
|
1955 |
#
|
|
1956 |
# Description
|
|
1957 |
# This function simplifies the XML by removing anything which fails to pass the filter.
|
|
1958 |
# The resulting doc is then useful for tools which don't understand the filter attributes.
|
|
1959 |
sub Filter_doc2 {
|
|
1960 |
my ($doc, $iFilter) = @_;
|
|
1961 |
|
|
1962 |
# the filtering will have to be
|
|
1963 |
# - find the configurations which pass the filter (and delete the rest)
|
|
1964 |
# - identify items which are kept by some configuration
|
|
1965 |
# - remove the ones which aren't kept by any configuration.
|
|
1966 |
|
|
1967 |
# deal with the <configuration> items, checking their filters
|
|
1968 |
my %lists;
|
|
1969 |
my @nodes = $doc->getElementsByTagName ("configuration");
|
|
1970 |
foreach my $node (@nodes) {
|
|
1971 |
my $configname = $node->getAttribute("name");
|
|
1972 |
my @configspec = split /,/,$node->getAttribute("filter");
|
|
1973 |
my $failed = check_filter($iFilter,\@configspec);
|
|
1974 |
if ($failed ne "") {
|
|
1975 |
print $GenXml::gLogFileH "Simplification removed configuration $configname ($failed)\n";
|
|
1976 |
$node->getParentNode->removeChild($node);
|
|
1977 |
next;
|
|
1978 |
}
|
|
1979 |
# find all the units for this configuration and mark them as MATCHED
|
|
1980 |
print $GenXml::gLogFileH "Analysing configuration $configname...\n";
|
|
1981 |
my $unfiltered_items = get_configuration_units2($doc, $node, 0, 0); # Replace the arg 1 with 0 to put the debug off
|
|
1982 |
foreach my $unit (@$unfiltered_items) {
|
|
1983 |
$unit->setAttribute("MATCHED", 1);
|
|
1984 |
}
|
|
1985 |
# note all the lists referenced by this configuration
|
|
1986 |
foreach my $listRef ($node->getElementsByTagName("listRef")) {
|
|
1987 |
my $list = $listRef->getAttribute("list");
|
|
1988 |
$lists{$list} = 1;
|
|
1989 |
}
|
|
1990 |
}
|
|
1991 |
|
|
1992 |
# walk the model, removing the "MATCHED" attribute and deleting any which weren't marked
|
|
1993 |
my %deletedUnits;
|
|
1994 |
delete_unmatched_units($doc, \%deletedUnits);
|
|
1995 |
|
|
1996 |
# clean up the lists
|
|
1997 |
my @lists = $doc->getElementsByTagName("list");
|
|
1998 |
foreach my $list (@lists) {
|
|
1999 |
my $name = $list->getAttribute("name");
|
|
2000 |
if (!defined $lists{$name}) {
|
|
2001 |
print $GenXml::gLogFileH "Simplification removed list $name\n";
|
|
2002 |
$list->getParentNode->removeChild($list);
|
|
2003 |
next;
|
|
2004 |
}
|
|
2005 |
foreach my $ref ($list->getElementsByTagName("ref")) {
|
|
2006 |
my $id = $ref->getAttribute("item");
|
|
2007 |
if (defined $deletedUnits{$id}) {
|
|
2008 |
$list->removeChild($ref); # reference to deleted unit
|
|
2009 |
}
|
|
2010 |
}
|
|
2011 |
}
|
|
2012 |
|
|
2013 |
}
|
|
2014 |
|
|
2015 |
# get_configuration_units2
|
|
2016 |
#
|
|
2017 |
# Inputs
|
|
2018 |
# $doc - DOM document model
|
|
2019 |
# $configuration - configuration node
|
|
2020 |
# $verbose - enable/disable logging
|
|
2021 |
# $level - 0 = all units, 1 = top-level units, 2 = local units within tasks
|
|
2022 |
#
|
|
2023 |
# Outputs
|
|
2024 |
# \@units - reference to a list of unit,package & prebuilt nodes which implement this configuration
|
|
2025 |
#
|
|
2026 |
# Description
|
|
2027 |
# This function processes the specified configuration to get the list of unit or package
|
|
2028 |
# nodes that implement this configuration.
|
|
2029 |
sub get_configuration_units2 ($$$$) {
|
|
2030 |
my ($doc, $configuration, $verbose, $level) = @_;
|
|
2031 |
my @filterable_items; # list of individual buildable items
|
|
2032 |
my ($mrp, $bldFile);
|
|
2033 |
|
|
2034 |
my ($model) = $doc->getElementsByTagName("systemModel");
|
|
2035 |
|
|
2036 |
# Start with the units specified via listRefs, then append the
|
|
2037 |
# units specified via layerRefs - they will be sorted afterwards anyway
|
|
2038 |
my @listrefs = $configuration->getElementsByTagName("listRef");
|
|
2039 |
foreach my $child (@listrefs) {
|
|
2040 |
my $issublevel = $child->getParentNode->getTagName ne "configuration";
|
|
2041 |
next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
|
|
2042 |
push @filterable_items, &find_unitList_by_ID($doc, $child->getAttribute("list"), 2);
|
|
2043 |
}
|
|
2044 |
my @refs = $configuration->getElementsByTagName("ref");
|
|
2045 |
foreach my $child (@refs) {
|
|
2046 |
my $issublevel = $child->getParentNode->getTagName ne "configuration";
|
|
2047 |
next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
|
|
2048 |
my $item = $child->getAttribute("item");
|
|
2049 |
# Find the named object and enumerate the items it contains
|
|
2050 |
my ($layer) = XML::XQL::solve("//*[\@name = '$item']", $model);
|
|
2051 |
if (!defined($layer)) {
|
|
2052 |
print $GenXml::gLogFileH "ERROR: no match for \"$item\"\n";
|
|
2053 |
next;
|
|
2054 |
}
|
|
2055 |
my @newunits = $layer->getElementsByTagName("unit",1);
|
|
2056 |
my @components = $layer->getElementsByTagName("component",1);
|
|
2057 |
|
|
2058 |
if ($verbose) {
|
|
2059 |
printf $GenXml::gLogFileH "Layer \"$item\" contained %d untis in %d components, \n",
|
|
2060 |
scalar @newunits, scalar @components;
|
|
2061 |
}
|
|
2062 |
if (scalar @newunits == 0) {
|
|
2063 |
print $GenXml::gLogFileH "WARNING: ref $item contains no units\n";
|
|
2064 |
}
|
|
2065 |
if (scalar @components == 0) {
|
|
2066 |
print $GenXml::gLogFileH "WARNING: ref $item contains no components\n";
|
|
2067 |
}
|
|
2068 |
push @filterable_items, @components, @newunits;
|
|
2069 |
}
|
|
2070 |
|
|
2071 |
my @configspec = split /,/,$configuration->getAttribute("filter");
|
|
2072 |
my @unfiltered_items;
|
|
2073 |
|
|
2074 |
# Scan the list, eliminating duplicates and elements which fail the filtering
|
|
2075 |
my %mrpfiles;
|
|
2076 |
foreach my $element (@filterable_items) {
|
|
2077 |
my $name = $element->getAttribute("name");
|
|
2078 |
my $filter = $element->getAttribute("filter");
|
|
2079 |
my $class = $element->getAttribute("class");
|
|
2080 |
|
|
2081 |
if ($filter) {
|
|
2082 |
my $failed = &check_filter($filter,\@configspec);
|
|
2083 |
if ($failed ne "") {
|
|
2084 |
print $GenXml::gLogFileH "Filtered out $name ($failed)\n" if ($verbose);
|
|
2085 |
next;
|
|
2086 |
}
|
|
2087 |
}
|
|
2088 |
if($element->getTagName eq 'unit')
|
|
2089 |
{
|
|
2090 |
# if it's not been filtered out, then substitute the unix syle path to windows style.
|
|
2091 |
$bldFile = $element->getAttribute("bldFile");
|
|
2092 |
if ($bldFile ne "") {
|
|
2093 |
$bldFile =~ s/\//\\/g;
|
|
2094 |
$element->setAttribute("bldFile", $bldFile) ;
|
|
2095 |
}
|
|
2096 |
$mrp = $element->getAttribute("mrp");
|
|
2097 |
if ($mrp ne "") {
|
|
2098 |
$mrp =~ s/\//\\/g;
|
|
2099 |
$element->setAttribute("mrp", $mrp) ;
|
|
2100 |
}
|
|
2101 |
|
|
2102 |
if ($mrp) {
|
|
2103 |
#my $elementName = $element->getAttribute("name");
|
|
2104 |
if (defined($mrpfiles{$mrp})) {
|
|
2105 |
# eliminate duplicates
|
|
2106 |
next if ($mrpfiles{$mrp} eq $name);
|
|
2107 |
# report (and eliminate) conflicts
|
|
2108 |
printf $GenXml::gLogFileH "WARNING: $mrp exists in %s and %s - skipping $name\n",
|
|
2109 |
$name, $mrpfiles{$mrp};
|
|
2110 |
next;
|
|
2111 |
}
|
|
2112 |
$mrpfiles{$mrp} = $name;
|
|
2113 |
}
|
|
2114 |
}
|
|
2115 |
push @unfiltered_items, $element;
|
|
2116 |
}
|
|
2117 |
|
|
2118 |
if ($verbose) {
|
|
2119 |
printf $GenXml::gLogFileH "%s contains %d units and components at level %d\n",
|
|
2120 |
$configuration->getAttribute("name"), scalar @unfiltered_items, $level;
|
|
2121 |
}
|
|
2122 |
|
|
2123 |
# Process the tag "<specialInstructions" in the given configuration. Need to convert the attribut "CWD" to windows style
|
|
2124 |
foreach my $child ($configuration->getElementsByTagName("specialInstructions")) {
|
|
2125 |
my $command = $child->getAttribute("cwd");
|
|
2126 |
$command =~ s/\//\\/g;
|
|
2127 |
$child->setAttribute("cwd", $command);
|
|
2128 |
}
|
|
2129 |
return \@unfiltered_items;
|
|
2130 |
}
|
|
2131 |
|
|
2132 |
|
|
2133 |
1;
|