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