--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/deprecated/buildtools/buildsystemtools/GenXml.pm Mon Oct 18 16:16:46 2010 +0800
@@ -0,0 +1,2133 @@
+# Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies).
+# All rights reserved.
+# This component and the accompanying materials are made available
+# under the terms of "Eclipse Public License v1.0"
+# which accompanies this distribution, and is available
+# at the URL "http://www.eclipse.org/legal/epl-v10.html".
+#
+# Initial Contributors:
+# Nokia Corporation - initial contribution.
+#
+# Contributors:
+#
+# Description:
+#
+
+package GenXml;
+
+ use strict;
+
+ use FindBin;
+ use lib "$FindBin::Bin/lib";
+ use XML::DOM;
+ use XML::DOM::ValParser;
+
+ # produces the "Use of uninitialized value in concatenation (.) or string" warning
+ use XML::XQL;
+ use XML::XQL::DOM;
+
+ # Variable to indicate the version of xml file used. It will be set by subroutine Parse_xml
+ my $iVer = 1;
+
+ # Used by debug prints
+ #my $count;
+
+my ($gHiResTimer) = 0; #Flag - true (1) if HiRes Timer module available
+my ($gLogFileH); # Log file handle
+my ($gEmbeddedLog) = 0; # Flag false (0) if logging must include scanlog headers etc
+my ($gValidateFailed) = 0; # Flag true (1) if the XML validation has failed
+my ($gValidate) = 0; # Flag true (1) if to do XML validation only
+
+ #assign STDERR to STDOUT so both are printed in the same file, without overwriting lines
+ open (STDERR, ">&STDOUT") or die("ERROR: Unable to redirect STDERR to STDOUT: $!");
+ select((select(STDOUT), $|=1)[0]);
+ select((select(STDERR), $|=1)[0]);
+
+
+# Check if HiRes Timer is available
+if (eval "require Time::HiRes;") {
+ $gHiResTimer = 1;
+} else {
+ print "Cannot load HiResTimer Module, install the Perl module Time-HiRes for more accurate timing data\n";
+}
+
+# Start
+#
+# Inputs
+# $iXMLSource - ref to array of XML filenames, to be merged into one
+# $iLogFile - name of logfile
+# $iSourceDir - root of the current source tree
+# $iEffectiveDir - root of source tree in which output files will be used
+# $iValidate - if true, validate the input and then stop
+#
+# $iFilter - (optional) filter the merged file against this value
+# $iMergedXml - (optional) create file of this name containing the merged XML
+# $iConfName - name of the configuration: needed by subsequent arguments
+# $iDataOutput - (optional) create file of this name containing the XML build commands
+# $iTextOutput - (optional) create file of this name containing the list of components
+# $iCBROutput - (optional) create file of this name containing the list of MRP files
+#
+# Description
+# This function merges multiple XML files into one document, then optionally outputs various
+# files.
+#
+sub Start
+{
+ my ($iXmlSource, $iDataOutput, $iLogFile, $iSourceDir, $iConfName, $iMergedXml, $iValidate, $iTextOutput, $iCBROutput, $iFilter, $iEffectiveDir) = @_;
+
+ # Set global validation Flag
+ $GenXml::gValidate = $iValidate;
+
+ my $doc;
+
+ if ($iLogFile)
+ {
+ # Open Log file
+ $GenXml::gLogFileH = IO::File->new("> $iLogFile")
+ or die "ERROR: RealTimeBuild: Couldn't open $iLogFile for writing: $!\n";
+ $gEmbeddedLog = 0; # Generate scanlog-compatible log format
+ } else {
+ $GenXml::gLogFileH = *STDOUT;
+ $gEmbeddedLog = 1; # Assume that we are embedded in a scanlog-format log file
+ }
+
+ if (!$gEmbeddedLog)
+ {
+ # Logfile headers
+ print $GenXml::gLogFileH "===-------------------------------------------------\n";
+ print $GenXml::gLogFileH "=== Genxml\n";
+ print $GenXml::gLogFileH "===-------------------------------------------------\n";
+ print $GenXml::gLogFileH "=== Genxml started ".localtime()."\n";
+ }
+
+ # $iSourceDir must end in a \
+ # Add a \ if not present
+ # And make sure they are in windows style
+ if ($iSourceDir !~ /\\$/)
+ {
+ $iSourceDir =~ s/\//\\/g;
+ $iSourceDir .= "\\";
+ }
+ if ($iEffectiveDir !~ /\\$/)
+ {
+ $iEffectiveDir =~ s/\//\\/g;
+ $iEffectiveDir .= "\\";
+ }
+
+ # Parse all the files into one DOM doc
+ $doc = &Parse_files($iXmlSource, \$iVer);
+ # ... XML::DOM::Document was created sucessfully ...
+
+ # Exit here if validating only
+ exit if ($GenXml::gValidate);
+
+ # Try normalising it
+ $doc->normalize;
+
+ # filter it, if desired
+ if ($iFilter && $iVer == 1) {
+ &logfileHeader("Filtering model against $iFilter");
+ &Filter_doc($doc, $iFilter);
+ &logfileFooter();
+ } elsif ($iFilter && $iVer == 2) {
+ &logfileHeader("Filtering model against $iFilter");
+ &Filter_doc2($doc, $iFilter);
+ &logfileFooter();
+ }
+
+
+ # Debug dump new doc to file
+ #~ $doc->printToFile("$iMergedXml") if ($iMergedXml);
+
+ #################write only non-empty lines################
+ if ($iMergedXml)
+ {
+ open(HANDLE, "+> $iMergedXml") or die "Error: Can't open $iMergedXml: $!";
+ my $MergedXMLString = $doc->toString;
+ my @lines = split(/\n/,$MergedXMLString);
+ my @tempLines = ();
+ foreach (@lines)
+ {
+ push @tempLines, $_ if $_ !~ /^[\s]*$/;
+ }
+
+ $MergedXMLString = join("\n",@tempLines);
+ seek(HANDLE,0,0);
+ print HANDLE $MergedXMLString;
+ truncate(HANDLE,tell(HANDLE));
+ close HANDLE;
+ }
+ #################################
+ if ($iConfName)
+ {
+ # Process the configuration to get the lists of units, tasks and options
+ &logfileHeader("Processing configuration $iConfName");
+ my ($topunits, $subunits, $options, $tasks) = &process_configuration($doc,$iConfName, $iVer);
+ my @topbldList = &compute_bldList($iSourceDir,$iEffectiveDir,$topunits, $iVer);
+
+ &logfileFooter();
+
+ if ($iTextOutput)
+ {
+ &logfileHeader("Generating text output $iTextOutput");
+
+ # Generate old-style text output
+ &write_component_list($doc, $iTextOutput, $iConfName, \@topbldList, $options, $tasks, $iEffectiveDir, $iVer);
+
+ &logfileFooter();
+ }
+
+ if ($iCBROutput)
+ {
+ &logfileHeader("Generating CBR component list $iCBROutput");
+
+ # Generate list of CBR components for "makecbr"
+ my @allunits;
+ #if ($iVer == 1) {
+ @allunits = (@$topunits, @$subunits);
+ #} else {
+ # @allunits = (@$topunits); # No subunits required for the new version of system_definition.xml
+ #}
+ my @fullbldList = &compute_bldList($iSourceDir,$iEffectiveDir,\@allunits, $iVer);
+
+ &write_CBR_list($iCBROutput, \@fullbldList);
+
+ &logfileFooter();
+ }
+
+ if ($iDataOutput)
+ {
+ &logfileHeader("Generating output XML $iDataOutput");
+
+ # Generate the output document by applying the tasks to the bldList
+
+ my $ID = 1; # Execute Element ID counter
+ my $Stage = 1; # Execute Element Stage counter
+
+ my ($outDoc, $docElem, $commands) = &start_output_doc($iConfName, $iVer);
+
+ process_prebuilt(\$outDoc, \$commands, \$ID, \$Stage, $topunits, 'N', $iVer);
+ foreach my $task (@{$tasks})
+ {
+ &process_task($task, $doc, \$outDoc, \$commands, \$ID, \$Stage, \@topbldList, $options, $iSourceDir, $iEffectiveDir, $iVer);
+ }
+ process_prebuilt(\$outDoc, \$commands, \$ID, \$Stage, $topunits, 'Y', $iVer);
+
+ $docElem->appendChild($commands);
+ $docElem->addText("\n");
+ #print $outDoc->toString;
+ $outDoc->printToFile($iDataOutput);
+ $outDoc->dispose;
+
+ &logfileFooter();
+ }
+ }
+
+ if (!$gEmbeddedLog)
+ {
+ # Print Genxml log footer
+ print $GenXml::gLogFileH "=== Genxml finished ".localtime()."\n";
+ }
+
+ # Close file handles
+ close($GenXml::gLogFileH);
+
+ $doc->dispose;
+
+}
+
+# Error Processing function for the XML Validation
+#
+# Throws an exception (with die) when an error is encountered, this
+# will stop the parsing process.
+# Don't die if a warning or info message is encountered, just print a message.
+sub my_fail
+{
+ my $code = shift;
+
+ if ($code < 200)
+ {
+ print $GenXml::gLogFileH "ERROR: ".XML::Checker::error_string ($code, @_);
+ # Set Flag so all the errors are reported before dieing
+ $GenXml::gValidateFailed = 1;
+ }
+
+ # Useful debug output
+ print $GenXml::gLogFileH XML::Checker::error_string ($code, @_) if ($GenXml::gValidate);
+}
+
+sub my_Unparsed_handler
+{
+ my ($Parser, $Entity, $Base, $Sysid, $Pubid, $Notation) = @_;
+ print $GenXml::gLogFileH "$Entity Unparsed";
+ die "ERROR: RealTimeBuild: Processing error\n";
+}
+
+# Parse_files
+#
+# Inputs
+# $iXMLSource - ref to array of filenames
+# $iVersion - Version of xml file (new or old) ?
+#
+# Outputs
+# $doc - XML DOM doc
+#
+# Description
+# This function merges multiple XML files into one document
+sub Parse_files
+{
+ my ($iXmlSource, $iVersion) = @_; # Version info passed for conditional processing of xml files
+ my (@docs);
+
+ # Load the XML document
+ my %expat_options = (KeepCDATA => 1,
+ Handlers => [ Unparsed => \&my_Unparsed_handler ]);
+
+ for (my $i = 0; $i < scalar(@$iXmlSource); $i++)
+ {
+ # Create header for parsing each file
+ &logfileHeader(@$iXmlSource[$i]);
+
+ my $parser = new XML::DOM::ValParser (%expat_options);
+ XML::DOM::ignoreReadOnly (1);
+ local $XML::Checker::FAIL = \&my_fail;
+
+ # Useful debug output
+ #print "Parsing ".@$iXmlSource[$i]."\n";
+
+ $docs[$i] = $parser->parsefile (@$iXmlSource[$i]);
+
+ # Create footer for parsing each file
+ &logfileFooter();
+ }
+
+ # Check to see if any of the XML files failed validation and die
+ die "ERROR: RealTimeBuild: Validation failed\n" if ($GenXml::gValidateFailed);
+
+# Set the appropriate version number
+ for (my $i = 0; $i < scalar(@docs); $i++)
+ { if((scalar(@docs))>1) {
+ if ($docs[$i]->getDocumentElement->getAttribute('schema') =~ /^2\./ &&
+ $docs[$i]->getDocumentElement->getTagName eq "SystemDefinition" &&
+ $docs[1]->getDocumentElement->getTagName eq "SystemBuild")
+ {
+ $$iVersion = 2;
+ last;
+ }
+ }
+ else
+ {
+ if ($docs[$i]->getDocumentElement->getAttribute('schema') =~ /^2\./ &&
+ $docs[$i]->getDocumentElement->getTagName eq "SystemDefinition")
+ {
+ $$iVersion = 2;
+ last;
+ }
+ }
+ }
+
+ if ($$iVersion == 1) { # Docs load now merge into $docs[0] if $iVersion is 1 (i.e. old version of xml file)
+ for (my $i = 1; $i < scalar(@docs); $i++) {
+ # Create header for merging each file
+ &logfileHeader("Merging in XML file ".@$iXmlSource[$i]);
+ &process_node(\($docs[0]->getElementsByTagName("SystemDefinition")),\($docs[$i]->getElementsByTagName("SystemDefinition")), \($docs[0]));
+
+ # Re-validate merged file
+ local $XML::Checker::FAIL = \&my_fail;
+ $docs[0]->check();
+
+ # Create footer for merging each file
+ &logfileFooter();
+ # Check to see if any of the XML files failed validation and die
+ die "ERROR: RealTimeBuild: Merged Validation failed\n" if ($GenXml::gValidateFailed);
+ }
+ } elsif ($$iVersion == 2) { # Docs load now merge into $docs[$#docs + 1] if $iVersion is 2 (i.e. new version of xml file)
+ for (my $i = 1; $i < scalar(@docs); $i++) {
+ # Create header for merging each file
+ &logfileHeader("Merging in XML file ".@$iXmlSource[$i]);
+ my $mergedDoc = &process_node2(\($docs[0]), \($docs[$i]));
+
+ # Re-validate merged file
+ local $XML::Checker::FAIL = \&my_fail;
+ $mergedDoc->check();
+
+ # Create footer for merging each file
+ &logfileFooter();
+ # Check to see if any of the XML files failed validation and die
+ die "ERROR: RealTimeBuild: Merged Validation failed\n" if ($GenXml::gValidateFailed);
+
+ $docs[0] = $mergedDoc;
+ }
+ }
+ return $docs[0];
+}
+
+# process_node
+#
+# Inputs
+# $node1 - ref to a node from the master
+# $node2 - ref to a node from the slave
+# $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
+#
+# Outputs
+#
+# Description
+# This function processes a node in two DOM documents, if any children match then it calls itself to process
+# the children nodes further
+sub process_node
+{
+ my ($node1, $node2, $doc1) = @_;
+
+ # Some nodes need special processing e.g. SystemDefinition
+ # This is because there can only be a certain number of these nodes
+ # child node / element rules outlined below, this rules are applied to the children of the node in question
+ # Child Node / element tag Rule
+ # ------------------------ ----
+ # SystemDefinition Merge the name and revision/schema CDATA as there can be only one of this element
+ # systemModel Always processed further as there can only be 1 or 0 of these
+ # layer Same name process further otherwise append child
+ # logicalset Same name process further otherwise append child
+ # logicalsubset Same name process further otherwise append child
+ # module Same name process further otherwise append child
+ # component Same name process further otherwise append child
+ # unit Same unitID generate ERROR and not replace child, otherwise append child
+ # sub elements of unit No processing needed as these cannot be merged
+ # package Same name process further otherwise append child
+
+ # build Always processed further as there can only be 1 or 0 of these
+ # unitList Same name process further otherwise append child
+ # unitRef Same unit ignore, different unit append child
+ # targetList Same name generate ERROR and not replace child, otherwise append child
+ # target Same name generate ERROR and not replace child, otherwise append child
+ # option Same name generate ERROR and not replace child, otherwise append child
+ # configuration Same name generate ERROR and not replace child, otherwise append child
+ # sub elements of configuration No processing needed as these cannot be merged
+
+
+ # All other nodes Append child
+
+ # Useful debug stuff
+ #$GenXml::count++;
+ #print "enter $GenXml::count\n";
+
+ # Handle the special case for the first call to this function with the node containing the SystemDefinition
+ if (($$node1->getTagName eq "SystemDefinition") && ($$node2->getTagName eq "SystemDefinition"))
+ {
+ # Get the name attributes
+ my ($name1) = $$node1->getAttribute('name');
+ my ($name2) = $$node2->getAttribute('name');
+ # Combine the two and set the attribute into the merged file
+ $$node1->setAttribute('name',$name1." + ".$name2);
+
+ # Get the revision attributes
+ my ($revision1) = $$node1->getAttribute('revision');
+ my ($revision2) = $$node2->getAttribute('revision');
+ # Get the schema attributes
+ my ($schema1) = $$node1->getAttribute('schema');
+ my ($schema2) = $$node2->getAttribute('schema');
+ # If both schema attributes are defined, combine the two and set the attribute into the merged file
+ # Note that even if an attribute does not exist in the XML file, XML::DOM returns an empty string (not undef)
+ if (($schema1) and ($schema2))
+ { # Both files have "new DTD".
+ if (($revision1) or ($revision2))
+ {
+ print $GenXml::gLogFileH "ERROR: Cannot define both schema and revison attributes in same file. Merged file will probably not be usable.\n";
+ }
+ if ($schema1 eq $schema2)
+ { # Both files have same schema attribute. Assign it to merged file
+ $$node1->setAttribute('schema',$schema1);
+ }
+ else
+ { # Files have different schema attributes. Combine and assign it to merged file. Warn!!
+ print $GenXml::gLogFileH "WARNING: Source file schema attribute values differ ($schema1 vs $schema2). Merged file may not be usable.\n";
+ $$node1->setAttribute('schema',$schema1." + ".$schema2);
+ }
+ }
+ # If both revision attributes are defined, combine the two and set the attribute into the merged file
+ elsif (($revision1) and ($revision2))
+ { # Both files have "old DTD". Retain this code for compatibility
+ print $GenXml::gLogFileH "REMARK: Both source files have \"old style\" DTDs. See SystemDefinition \"revision\" attribute.\n";
+ $$node1->setAttribute('revision',$revision1." + ".$revision2);
+ }
+ else
+ { # Files have different DTDs. Use attribute found in first file. report as ERROR!!
+ print $GenXml::gLogFileH "ERROR: Source file schema/revison attributes conflict. Merged file will probably not be usable.\n";
+ if ($schema1)
+ { # First file had new DTD and had a schema attribute
+ $$node1->setAttribute('schema',$schema1);
+ }
+ elsif ($revision1)
+ { # First file had old DTD and had a revision attribute (not a schema)
+ $$node1->setAttribute('revision',$revision1);
+ }
+ }
+ }
+
+ # Get the children of the parent nodes
+
+ my $nodelist1 = $$node1->getChildNodes;
+ my $nodelist2 = $$node2->getChildNodes;
+
+ # Useful debug stuff
+ #print "has ".$nodelist2->getLength." children\n";
+
+ # Itterate throught the children of node2 check to see if they are present / rule match in node 1
+ my $ni = $nodelist2->getLength;
+ for (my $i = 0; $i < $ni; $i++)
+ {
+ # Useful debug stuff
+ #print "node $i ".$nodelist2->item($i)->getNodeTypeName."\n";
+ if ($nodelist2->item($i)->getNodeTypeName eq "ELEMENT_NODE")
+ {
+ # Handle rule match on ELEMENTS
+ my $tagname2 = $nodelist2->item($i)->getTagName;
+
+ # Useful debug stuff
+ # print "Tagname = $tagname\n";
+ if (($tagname2 eq "systemModel") || ($tagname2 eq "build") )
+ {
+ my $iBuildIndx;
+ # find the $node1 for this elements
+ my $nj = $nodelist1->getLength;
+ my $match = 0;
+ for (my $j = 0; $j < $nj; $j++)
+ {
+ if ($nodelist1->item($j)->getNodeTypeName eq "ELEMENT_NODE")
+ {
+ my $tagname1 = $nodelist1->item($j)->getTagName;
+ if ($tagname1 eq $tagname2)
+ {
+ # process further
+
+ # Useful debug stuff
+ #print "processing $tagname further\n";
+ &process_node(\($nodelist1->item($j)), \($nodelist2->item($i)), $doc1);
+ $match = 1;
+ }
+ else
+ {
+ if ($tagname1 eq 'build')
+ {
+ $iBuildIndx = $j;
+ }
+ if ((($tagname2 eq 'systemModel') and ($tagname1 ne 'systemModel')) or ((($tagname2 eq 'build') and ($tagname1 ne 'build'))))
+ {
+ next;
+ }
+ # no systemModel or build element found so append child
+ &append_child($node1, \($nodelist2->item($i)), $doc1)
+ }
+ }
+ }
+ unless ($match)
+ {
+ # no systemModel or build element found so append child
+ # In the special case of adding an instance of 'systemModel' we must specify that this goes before any instance of 'build'
+ my $iRefChildRef = ($tagname2 eq 'systemModel')? $nodelist1->item($iBuildIndx): undef;
+ &append_child($node1, \($nodelist2->item($i)), $doc1, $iRefChildRef);
+ }
+ } elsif (($tagname2 eq "layer") || ($tagname2 eq "logicalset") || ($tagname2 eq "logicalsubset") || ($tagname2 eq "module") || ($tagname2 eq "component") || ($tagname2 eq "package") || ($tagname2 eq "unitList"))
+ {
+ # Check the $node1 for elements with the same "name"
+ my $match; # Flag for matching element found
+ my $nj = $nodelist1->getLength;
+ for (my $j = 0; $j < $nj; $j++)
+ {
+ # Only look at element nodes in node1
+ if ($nodelist1->item($j)->getNodeTypeName eq "ELEMENT_NODE")
+ {
+ if ($nodelist2->item($i)->getAttribute('name') eq $nodelist1->item($j)->getAttribute('name'))
+ {
+ # Process further match found
+ $match = 1;
+
+ # Useful debug stuff
+ #print "processing j=$j $tagname2 further ".$nodelist2->item($i)->getAttribute('name')."\n";
+
+ &process_node(\($nodelist1->item($j)), \($nodelist2->item($i)), $doc1);
+ }
+ }
+ }
+ # If no match found Append child
+
+ # Useful debug stuff
+ #print "new $tagname2 added\n" if (!$match);
+
+ &append_child($node1, \($nodelist2->item($i)), $doc1) if (!$match);
+
+ } elsif (($tagname2 eq "unit") || ($tagname2 eq "targetList") || ($tagname2 eq "target") || ($tagname2 eq "option") || ($tagname2 eq "configuration")) {
+ # Check the $node1 for elements with the same ID attribute (Global check for ID clashes)
+ my $idAttrib;
+ if ($tagname2 eq "unit")
+ {
+ # Special case of the unit element as this has uses the attribute of unitID instead of name
+ $idAttrib = "unitID";
+ } else {
+ $idAttrib = "name";
+ }
+
+ my $ID = $nodelist2->item($i)->getAttribute($idAttrib);
+ # Search for the XML ID in $doc1
+ if( scalar(XML::XQL::solve ("//*[\@$idAttrib = '$ID']", $$doc1)))
+ {
+ print $GenXml::gLogFileH "REMARK: $ID already exists, not merging this $tagname2 element\n";
+ } else {
+ # unitID not found so append elememnt
+
+ # Useful debug stuff
+ # print "new $tagname2 added\n";
+
+ &append_child($node1, \($nodelist2->item($i)), $doc1);
+ }
+ } elsif ($tagname2 eq "unitRef") {
+ # Check the $node1 for elements with the same "name"
+ my $match; # Flag for matching element found
+ my $nj = $nodelist1->getLength;
+ for (my $j = 0; $j < $nj; $j++)
+ {
+ # Only look at element nodes in node1
+ if ($nodelist1->item($j)->getNodeTypeName eq "ELEMENT_NODE")
+ {
+ if ($nodelist2->item($i)->getAttribute('unit') eq $nodelist1->item($j)->getAttribute('unit'))
+ {
+ # Ignore the unitRef element as it is a duplicate
+ $match = 1;
+ print $GenXml::gLogFileH "WARNING: Duplicate unitRef ".$nodelist2->item($i)->getAttribute('unit')." not merging\n";
+ }
+ }
+ }
+ # No match found Append Child
+
+ # Useful debug stuff
+ # print "New unitRef\n" if (!$match);
+
+ &append_child($node1, \($nodelist2->item($i)), $doc1) if (!$match);
+
+ } else {
+ # Element not recognised so append child
+ &append_child($node1, \($nodelist2->item($i)), $doc1);
+ }
+ } else {
+ # Handle non element nodes (append child of node2 to node 1)
+ # At the moment adding in non element nodes adds a lot of whitespace
+ # TODO: correctly handle non element nodes
+ # This is not important at the moment as there are no important non element nodes for the merge
+ #&append_child($node1, \($nodelist2->item($i)), $doc1);
+ }
+ }
+
+ #print "return $GenXml::count\n";
+ #$GenXml::count--;
+}
+
+# append_child
+#
+# Inputs
+# $node1 - is already a ref of the node to append to
+# $node2 - ref of node from nodelist2 to append to $node1
+# $doc1 - ref to document to merge the node into (need for non DOM operation of changing owner of node)
+# $refnode - ref to node in fromt of which to insert node2 (If undef, append node2)
+#
+# Description
+# ???
+sub append_child
+{
+ my ($node1, $node2, $doc1, $refnode) = @_;
+
+ # Clone the node
+ my $clone = $$node2->cloneNode(1);
+ # Fix the owner of node
+ $clone->setOwnerDocument($$doc1);
+ # Append a line return for more tidy xml
+ $$node1->addText("\n");
+ # Append (or insert) the node
+ # Note: it seems that insertBefore($clone,undef) is identical to appendChild($clone)
+ $$node1->insertBefore($clone,$refnode);
+}
+
+# write_component_list
+#
+# Inputs
+# $doc - Reference to input document
+# $iTextOutput - Name of output file
+# $iConfName - Name of configuration being described
+# $bldList - Reference to the bldList array
+# $options - Reference to the options array
+# $tasks - Reference to the tasks array
+# $iEffectiveDir - Root of source tree in which file will be used
+# $iVersion - Version of xml file (new or old) ?
+#
+# Description:
+# Write out old-style "list of components" build description for the configuration
+#
+sub write_component_list
+ {
+ my ($doc, $iTextOutput, $iConfName, $bldList, $options, $tasks, $iEffectiveDir, $iVersion) = @_;
+
+ # process list of tasks to find build targets and bootstrap info
+ my %targets;
+ my $bootflag = 0;
+
+ foreach my $task (@$tasks)
+ {
+ # Read all the task
+ my @children = $task->getChildNodes;
+ foreach my $child (@children)
+ {
+ next if ($child->getNodeTypeName ne "ELEMENT_NODE");
+ if ($child->getTagName eq "specialInstructions")
+ {
+ # "setupprj" in the command is taken to mean "bootstrap E32ToolP"
+ $bootflag = 1 if ($child->getAttribute("command") =~ /setupprj/i);
+ next;
+ }
+ my $targetlist = $child->getAttributeNode("targetList");
+ if (defined $targetlist)
+ {
+ my @targetnames = &find_targetList_by_ID($doc, $targetlist->getValue);
+ foreach my $target (@targetnames)
+ {
+ $targets{$target}= 1;
+ }
+ }
+ }
+ }
+
+ # create output file
+ open TEXTFILE, "> $iTextOutput" or die "ERROR: RealTimeBuild: Couldn't open $iTextOutput for writing: $!\n";
+
+ print TEXTFILE <<HEADER_TXT;
+#
+# ****************************** IMPORTANT NOTE ************************************
+#
+# The configuration was specified as: $iConfName
+#
+# **********************************************************************************
+#
+
+HEADER_TXT
+
+ print TEXTFILE "# Optional variations in the generated scripts\n\n";
+
+ my $column2pos = 8;
+ foreach my $option (@$options) {
+ my $name = '<option ????>';
+ if ($option =~ /^-(.+)/) {$name = "<option $1>"}
+ my $len = length $name;
+ while ($len > $column2pos) { $column2pos += 8; }
+ printf TEXTFILE "%-*s\t# use abld %s\n", $column2pos, $name, $option;
+ }
+
+ $column2pos = 8;
+ foreach my $target (sort keys %targets) {
+ # abld targets are only one word
+ next if ($target =~ /\w+\s+\w+/);
+ my $name;
+ if ($target =~ /(misa|mint|mcot|mtemplate|meig)/i) {
+ $name = "<option arm_assp $target>";
+ } else {
+ $name = "<option $target>";
+ }
+ my $len = length $name;
+ while ($len > $column2pos) { $column2pos += 8; }
+ printf TEXTFILE "%-*s\t#\n", $column2pos, $name;
+ }
+
+ print TEXTFILE "\n";
+ print TEXTFILE "# List of components required \n";
+ print TEXTFILE "#\n# Name abld_directory\n";
+
+ if($bootflag) {
+ print TEXTFILE "#\n# Bootstrapping....\n\n";
+ print TEXTFILE "<special bldfiles E32Toolp group> # Special installation for E32ToolP\n\n";
+ print TEXTFILE "# Components:\n";
+ }
+ print TEXTFILE "#\n";
+
+
+ my $srcprefix = quotemeta($iEffectiveDir);
+
+ $column2pos = 8;
+ foreach my $component (@$bldList) {
+ my $bldinfdir = $component->[1];
+ next if ($bldinfdir eq ""); # skip MRP-only entries
+
+ $bldinfdir =~ s/^$srcprefix//o;
+ my $len = length $component->[0];
+ while ($len > $column2pos) { $column2pos += 8; }
+ printf TEXTFILE "%-*s\t%s\n", $column2pos, $component->[0], $bldinfdir;
+ }
+ close TEXTFILE
+}
+
+# write_CBR_list
+#
+# Inputs
+# $iCBROutput - Name of output file
+# $bldList - Reference to the bldList array
+#
+# Description:
+# Write out "list of CBR components" for the configuration
+#
+sub write_CBR_list
+ {
+ my ($iCBROutput, $bldList) = @_;
+
+ my @components = ();
+ foreach my $component (@$bldList)
+ {
+ my $mrp = $component->[2];
+ next if ($mrp eq ""); # skip entries without MRP files
+
+ push @components, sprintf("%s\t%s\n", $component->[0], $mrp);
+ }
+
+ # create output file
+ open TEXTFILE, "> $iCBROutput" or die "ERROR: RealTimeBuild: Couldn't open $iCBROutput for writing: $!\n";
+ print TEXTFILE sort @components;
+ close TEXTFILE
+ }
+
+# start_output_doc
+#
+# Inputs
+# $iConfName - Configuration name used
+# $iVersion - Version of xml file (new or old) ?
+#
+# Outputs
+# $outDoc - document
+# $docElem - root element
+# $commands - command node
+#
+# Description
+# This function produces the static parts of the output XML file
+sub start_output_doc
+{
+ my ($iConfName, $iVersion) = @_;
+
+ my ($outParser, $outDoc, $docElem, $commands);
+
+ # set the doctype based on which version of file is passed.
+ my $doctype;
+ if ($iVersion == 1) {
+ $doctype = "Build";
+ } elsif ($iVersion == 2) {
+ $doctype = "SystemBuild" ;
+ }
+
+ $outParser = new XML::DOM::Parser;
+
+ my $str = <<END;
+<?xml version="1.0"?>
+<!DOCTYPE $doctype [
+ <!ELEMENT Product (Commands)>
+ <!ATTLIST Product name CDATA #REQUIRED>
+ <!ELEMENT Commands (Execute+ | SetEnv*)>
+ <!ELEMENT Execute EMPTY>
+ <!ATTLIST Execute
+ ID CDATA #REQUIRED
+ Stage CDATA #REQUIRED
+ Component CDATA #REQUIRED
+ Cwd CDATA #REQUIRED
+ CommandLine CDATA #REQUIRED>
+ <!ELEMENT SetEnv EMPTY>
+ <!ATTLIST SetEnv
+ Order ID #REQUIRED
+ Name CDATA #REQUIRED
+ Value CDATA #REQUIRED>
+]>
+<Product>
+</Product>
+END
+
+ $outDoc = $outParser->parse($str);
+
+ # get the document element
+ $docElem = $outDoc->getDocumentElement;
+ $docElem->setAttribute('name', $iConfName);
+ # Add the Commands Node
+ $commands = $outDoc->createElement('Commands');
+ $commands->addText("\n");
+ # create the default SetEnv elements
+ my $SetEnv1 = $outDoc->createElement('SetEnv');
+ $SetEnv1->setAttribute('Order', '1');
+ $SetEnv1->setAttribute('Name', 'EPOCROOT');
+ $SetEnv1->setAttribute('Value', '\\');
+ $commands->appendChild($SetEnv1);
+ $commands->addText("\n");
+ my $SetEnv2 = $outDoc->createElement('SetEnv');
+ $SetEnv2->setAttribute('Order', '2');
+ $SetEnv2->setAttribute('Name', 'PATH');
+ $SetEnv2->setAttribute('Value', '\\epoc32\\gcc\\bin;\\epoc32\\tools;%PATH%');
+ $commands->appendChild($SetEnv2);
+ $commands->addText("\n");
+
+ return ($outDoc, $docElem, $commands);
+}
+
+# process_prebuilt
+#
+# Inputs
+# $outDoc - Reference to output document
+# $commands - Reference to the command node
+# $ID - Reference to theExecute ID counter
+# $Stage - Reference to the Execute Stage counter
+# $topunits - Reference to the list of unit, package & prebuilt elements
+# $late - Selects on the "late" attribute of prebuilt elements
+# $iVersion - Version of xml file (new or old) ?
+#
+# Outputs
+#
+# Description
+# Generates the "getrel" commands for prebuilt elements
+sub process_prebuilt
+{
+ my ($outDoc, $commands, $ID, $Stage, $topunits, $late, $iVersion) = @_;
+
+ my ($name, $version, $islate);
+ foreach my $unit (@$topunits)
+ {
+ my @prebuilt; # a list of all <prebuilt> or <unit prebuilt="...">
+ if ($iVersion == 1) {
+ if ($unit->getTagName eq "prebuilt")
+ {
+ push(@prebuilt, $unit);
+ }
+ } elsif ($iVersion == 2) {
+ my @subunits = $unit->getElementsByTagName("unit");
+ foreach my $subunit (@subunits)
+ {
+ if ($subunit->getAttribute("prebuilt"))
+ {
+ push(@prebuilt, $subunit);
+ }
+ }
+ }
+ foreach my $unit (@prebuilt)
+ {
+ $version = $unit->getAttribute("version");
+ $islate = $unit->getAttribute("late");
+ $name = $unit->getAttribute(($iVersion == 1) ? "name" : "prebuilt");
+
+ $islate = "N" if (!defined $islate || $islate eq "");
+
+ next if ($late ne $islate);
+ next if (!$late && $islate eq "Y");
+
+ # Create the element
+ my $task_elem = $$outDoc->createElement('Execute');
+ $task_elem->setAttribute('ID', $$ID);
+ $$ID++; # The ID must always be incremented
+ $task_elem->setAttribute('Stage', $$Stage);
+ $$Stage++; # getrel operations are serial
+
+ $task_elem->setAttribute('Component',$name);
+ $task_elem->setAttribute('Cwd','%EPOCROOT%');
+ $task_elem->setAttribute('CommandLine',"getrel $name $version");
+
+ $$commands->appendChild($task_elem);
+ $$commands->addText("\n");
+ }
+ }
+}
+
+# process_task
+#
+# Inputs
+# $task - task node
+# $doc - Reference to input document
+# $outDoc - Reference to output document
+# $commands - Reference to the command node
+# $ID - Reference to theExecute ID counter
+# $Stage - Reference to the Execute Stage counter
+# $bldList - Reference to the bldList array
+# $options - Reference to the options array
+# $iSourceDir - root of the current source tree
+# $iEffectiveDir - root from which the source tree will be used
+# $iVersion - Version of xml file (new or old) ?
+#
+# Outputs
+#
+# Description
+# This function processes the task nodes
+sub process_task
+{
+ my ($task, $doc, $outDoc, $commands, $ID, $Stage, $bldList, $options, $iSourceDir, $iEffectiveDir, $iVersion) = @_;
+
+ my @targets;
+ my @localBldList; # Used for task specific unit list overrides
+
+ # re-process the $iSourceDir & $iSourceDir based on version of xml file along with value for unitListRef and unitList
+ my ($unitListRef, $unitList);
+ if($iVersion == 1) {
+ $unitListRef = "unitListRef";
+ $unitList = "unitList";
+ } elsif ($iVersion == 2) {
+ $unitListRef = "listRef";
+ $unitList = "list";
+ }
+
+ # Read all the task
+ my @children = $task->getChildNodes;
+ foreach my $child (@children)
+ {
+ if ($child->getNodeTypeName eq "ELEMENT_NODE")
+ {
+ # Check for unitListRef for task unit list override
+ if ($child->getTagName eq $unitListRef)
+ {
+ #Processes the unitListRefs to build up a complete list of units which are IDREFs
+ my @localUnits= &find_unitList_by_ID($doc, $child->getAttribute($unitList), $iVersion);
+ push @localBldList, &compute_bldList($iSourceDir,$iEffectiveDir,\@localUnits, $iVersion);
+ # Overwrite Ref $bldList with new Ref to @localBldList
+ $bldList = \@localBldList;
+ }
+
+ if ($child->getTagName eq "specialInstructions")
+ {
+ #Processes the unitListRefs to build up a complete list of units which are IDREFs
+ my $task_elem = $$outDoc->createElement('Execute');
+ $task_elem->setAttribute('ID', $$ID);
+ $$ID++; # The ID must always be incremented
+ $task_elem->setAttribute('Stage', $$Stage);
+ $$Stage++; # All specialInstructions are done sequentially
+ $task_elem->setAttribute('Component', $child->getAttributeNode("name")->getValue);
+ my ($cwd) = $child->getAttributeNode("cwd")->getValue;
+ # Replace any Environment variables
+ my ($cwdtemp) = $cwd;
+ $cwdtemp =~ s/%(\w+)%/$ENV{$1}/g;
+ # If $cwd does not starts with a drive letter or absolute path then add the source Directory on the front
+ if (!(($cwdtemp =~ /^\w:[\\]/) || ($cwdtemp =~ /^\\/)))
+ {
+ $cwd = $iEffectiveDir . $cwd;
+ }
+ $task_elem->setAttribute('Cwd', $cwd);
+ $task_elem->setAttribute('CommandLine', $child->getAttributeNode("command")->getValue);
+ $$commands->appendChild($task_elem);
+ $$commands->addText("\n");
+ } elsif ($child->getTagName eq "buildLayer") {
+ # targetParallel & unitParallel are optional so check that they exist before trying to get the value.
+ my $unitP = $child->getAttribute("unitParallel");
+ my $targetP = $child->getAttribute("targetParallel") if ($child->getAttributeNode("targetParallel"));
+ my $abldCommand = $child->getAttribute("command");
+
+ # Build the list of targets, targets are optional
+ if ($child->getAttributeNode("targetList"))
+ {
+ @targets = &find_targetList_by_ID($doc, $child->getAttributeNode("targetList")->getValue);
+ } else {
+ # There are no targets associated with this buildlayer
+ $targetP = "NA"; # Not applicable
+ }
+
+ # Build the correct option string
+ my $optionStr = "";
+ foreach my $option (@$options)
+ {
+ # only add -savespace if the command abld target or abld build take this option
+ # don't add -keepgoing if -what or -check are part of the command
+ 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)))
+ {
+ $optionStr .= " $option" ;
+ }
+ if (($option =~ /\s*-keepgoing\s*/i) || ($option =~ /\s*-k\s*/i) )
+ {
+ 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)))
+ {
+ $optionStr .= " $option" ;
+ }
+ }
+ # This allows us to either build symbol files or not build symbols to save build time.
+ # only add -no_debug if the command abld makefile
+ if (($option =~ /\s*-no_debug\s*/i) && ($abldCommand =~ /^\s*abld\s+makefile/i))
+ {
+ $optionStr .= " $option" ;
+ }
+ }
+
+ # Remove the mrp-only entries from the bldList
+ my @bldInfList;
+ foreach my $array (@{$bldList})
+ {
+ push @bldInfList, $array if ($$array[1] ne "");
+ }
+
+ # Cover all the combinations of units and targets
+ my ($Ref1, $Ref2, $loop1, $loop2);
+
+ if ($targetP eq "N")
+ {
+ # Got to switch order of looping
+ $Ref2 = \@bldInfList;
+ $Ref1 = \@targets;
+ $loop2 = $unitP;
+ $loop1 = $targetP;
+ } else {
+ $Ref1 = \@bldInfList;
+ $Ref2 = \@targets;
+ $loop1 = $unitP;
+ $loop2 = $targetP;
+ }
+
+ for (my $i = 0; $i < scalar(@$Ref1); $i++)
+ {
+ if ($targetP ne "NA")
+ {
+ for (my $j = 0; $j < scalar(@$Ref2); $j++)
+ {
+ # Create the element
+ my $task_elem = $$outDoc->createElement('Execute');
+ $task_elem->setAttribute('ID', $$ID);
+ $$ID++; # The ID must always be incremented
+ $task_elem->setAttribute('Stage', $$Stage);
+
+ if ($targetP eq "N") {
+ # loops swapped but the order of unitP and targetP need to be swapped back
+ # unit (Component) name is the 0 element of the sub array, source location in element 1
+ $task_elem->setAttribute('Component',$$Ref2[$j][0]);
+ # Find the bldFile directory and set as Cwd
+ $task_elem->setAttribute('Cwd',$$Ref2[$j][1]);
+
+ $task_elem->setAttribute('CommandLine',$abldCommand.$optionStr." ".$$Ref1[$i]);
+ $$commands->appendChild($task_elem);
+ $$commands->addText("\n");
+ } else {
+ # unit (Component) name is the 0 element of the sub array, source location in element 1
+ $task_elem->setAttribute('Component',$$Ref1[$i][0]);
+ # Find the bldFile directory and set as Cwd
+ $task_elem->setAttribute('Cwd',$$Ref1[$i][1]);
+
+ $task_elem->setAttribute('CommandLine',$abldCommand.$optionStr." ".$$Ref2[$j]);
+ $$commands->appendChild($task_elem);
+ $$commands->addText("\n");
+ }
+ $$Stage++ if (($loop1 eq "N") && ($loop2 eq "N"));
+ }
+ $$Stage++ if (($loop1 eq "N") && ($loop2 eq "Y"));
+ } else {
+ # Create the element
+ my $task_elem = $$outDoc->createElement('Execute');
+ $task_elem->setAttribute('ID', $$ID);
+ $$ID++; # The ID must always be incremented
+ $task_elem->setAttribute('Stage', $$Stage);
+
+ # unit (Component) name is the 0 element of the sub array, source location in element 1
+ $task_elem->setAttribute('Component',$$Ref1[$i][0]);
+ # Find the bldFile directory and set as Cwd
+ $task_elem->setAttribute('Cwd',$$Ref1[$i][1]);
+
+ $task_elem->setAttribute('CommandLine',$abldCommand.$optionStr);
+ $$commands->appendChild($task_elem);
+ $$commands->addText("\n");
+
+ $$Stage++ if ($loop1 ne "Y");
+ }
+ }
+ # Add the * (stage++) for the combinations that don't get this done by the loops
+ $$Stage++ if ($loop1 eq "Y");
+ }
+ }
+ }
+}
+
+# delete_unmatched_units
+#
+# Inputs
+# $node - node in the system model
+# $deletedref - reference to hash of deleted unitIDs
+#
+# Outputs
+# Returns 1 if all significant children of the node have been removed
+#
+# Description
+# This function simplifies the XML by removing anything which wasn't marked as MATCHED.
+# It's called recursively so that it can "clean up" the structure if whole subtrees have
+# all of their significant content removed.
+sub delete_unmatched_units
+ {
+ my ($node, $deletedUnitsRef) = @_;
+ my @children = $node->getChildNodes;
+ return 0 if (scalar @children == 0);
+ my $now_empty = 1;
+ my $deleted_something = 0;
+ foreach my $child (@children)
+ {
+ if ($child->getNodeTypeName ne "ELEMENT_NODE")
+ {
+ # text and comments don't count
+ next;
+ }
+ my $tag = $child->getTagName;
+ my $deletedThis = 0;
+ if ((($tag eq "unit" || $tag eq "package" || $tag eq "prebuilt") && $iVer == 1) || (($tag eq "component" || $tag eq "unit") && $iVer == 2))
+ {
+ # only units,prebuilts & packages are tagged
+ if (!$child->getAttribute("MATCHED"))
+ {
+ if ($tag eq "unit")
+ {
+ my $unitID = $child->getAttribute("unitID");
+ $$deletedUnitsRef{$unitID} = 1;
+ }
+ if($tag eq "unit" && $iVer == 2)
+ {
+ my $version = $child->getAttribute("version");
+ printf $GenXml::gLogFileH "Simplification removed $tag %s %s\n", ($version eq '') ? 'from' : "v$version of" ,$node->getAttribute("name");
+ }
+ else
+ {
+ printf $GenXml::gLogFileH "Simplification removed $tag %s\n", $child->getAttribute("name");
+ }
+ $node->removeChild($child);
+ $deletedThis = 1;
+ $deleted_something = 1;
+ }
+ else
+ {
+ $child->removeAttribute("MATCHED");
+ $now_empty = 0; # something left in due to this child
+ }
+ }
+ # keep going to filter child units
+ if (!$deletedThis && $tag ne "unit" && $tag ne "package" && $tag ne "prebuilt")
+ {
+ if (delete_unmatched_units($child,$deletedUnitsRef) == 1)
+ {
+ # Child was empty and can be removed
+ $node->removeChild($child);
+ $deleted_something = 1;
+ }
+ else
+ {
+ $now_empty = 0; # something left in due to this child
+ }
+ }
+ }
+ return 0 unless ($deleted_something);
+ return $now_empty;
+ }
+
+
+# Filter_doc
+#
+# Inputs
+# $doc - Reference to input document
+# $iFilter - filter to apply
+#
+# Outputs
+#
+# Description
+# This function simplifies the XML by removing anything which fails to pass the filter.
+# The resulting doc is then useful for tools which don't understand the filter attributes.
+sub Filter_doc
+ {
+ my ($doc, $iFilter) = @_;
+
+ # the filtering will have to be
+ # - find the configurations which pass the filter (and delete the rest)
+ # - identify items which are kept by some configuration
+ # - remove the ones which aren't kept by any configuration.
+
+ # deal with the <configuration> items, checking their filters
+ my %unitLists;
+ my @nodes = $doc->getElementsByTagName ("configuration");
+ foreach my $node (@nodes)
+ {
+ my $configname = $node->getAttribute("name");
+ my @configspec = split /,/,$node->getAttribute("filter");
+ my $failed = check_filter($iFilter,\@configspec);
+ if ($failed ne "")
+ {
+ print $GenXml::gLogFileH "Simplification removed configuration $configname ($failed)\n";
+ $node->getParentNode->removeChild($node);
+ next;
+ }
+ # find all the units for this configuration and mark them as MATCHED
+ print $GenXml::gLogFileH "Analysing configuration $configname...\n";
+ my $units = get_configuration_units($doc, $node, 0, 0);
+ foreach my $unit (@$units)
+ {
+ $unit->setAttribute("MATCHED", 1);
+ }
+ # note all the unitLists referenced by this configuration
+ foreach my $unitListRef ($node->getElementsByTagName("unitListRef"))
+ {
+ my $unitList = $unitListRef->getAttribute("unitList");
+ $unitLists{$unitList} = 1;
+ }
+ }
+ # walk the model, removing the "MATCHED" attribute and deleting any which weren't marked
+ my %deletedUnits;
+ delete_unmatched_units($doc, \%deletedUnits);
+
+ # clean up the unitlists
+ my @unitLists = $doc->getElementsByTagName("unitList");
+ foreach my $unitList (@unitLists)
+ {
+ my $name = $unitList->getAttribute("name");
+ if (!defined $unitLists{$name})
+ {
+ print $GenXml::gLogFileH "Simplification removed unitList $name\n";
+ $unitList->getParentNode->removeChild($unitList);
+ next;
+ }
+ foreach my $unitRef ($unitList->getElementsByTagName("unitRef"))
+ {
+ my $id = $unitRef->getAttribute("unit");
+ if (defined $deletedUnits{$id})
+ {
+ $unitList->removeChild($unitRef); # reference to deleted unit
+ }
+ }
+ }
+
+ }
+
+# find_configuration
+#
+# Inputs
+# $doc - DOM document model
+# $iConfName - configuration name
+#
+# Outputs
+# $configuration - the node of the named configuration
+#
+# Description
+# This function locates and returns the named configuration node
+sub find_configuration
+{
+ my ($doc, $iConfName) = @_;
+
+ # Find the named configuration
+ my @nodes = $doc->getElementsByTagName ("configuration");
+ foreach my $node (@nodes)
+ {
+ my $name = $node->getAttributeNode ("name");
+ if ($name->getValue eq $iConfName)
+ {
+ return $node;
+ }
+ }
+
+ # If no configuration has been found the produce ERROR message
+ die "ERROR: RealTimeBuild: Named configuration $iConfName not found\n";
+}
+
+# process_configuration
+#
+# Inputs
+# $doc - DOM document model
+# $iConfName - name of the configuration
+# $iVersion - Version of xml file (new or old) ?
+#
+# Outputs
+# $topunits - reference to a list of units in the main configuration
+# $subunits - reference to a list of local units contained within subtasks
+# \@options - reference to a list of options which apply (curently global options)
+# \@tasks - reference to a list of the task nodes for the configuration
+#
+# Description
+# This function locates the named configuration and processes it into
+# a list of units, the build options which apply, and the task elements in
+# the configuration.
+sub process_configuration
+{
+ my ($doc, $iConfName, $iVersion) = @_;
+
+ my @options; # list of global options
+ my @units; # list of individual buildable items
+
+ # NB. getElementsByTagName in list context returns a list, so
+ # the following statement gets only the first element of the list
+ my ($build, @nodes);
+ if ($iVersion == 1) {
+ $build = $doc->getElementsByTagName("build");
+ } else {
+ $build = $doc->getElementsByTagName("SystemBuild");
+ }
+
+ @nodes = $build->[0]->getElementsByTagName("option");
+
+ # Read the global options (savespace and keepgoing)
+ foreach my $node (@nodes)
+ {
+ my $name = $node->getAttributeNode("abldOption");
+ my $enable = $node->getAttributeNode("enable")->getValue;
+ push @options, $name->getValue if ($enable =~ /Y/i);
+ }
+
+ # Find named configuration
+ my $configuration = find_configuration($doc, $iConfName);
+
+ # Get the list of tasks
+ my @tasks = $configuration->getElementsByTagName("task");
+
+ my ($topunits, $subunits);
+ # Get the filtered list of units
+ if ($iVersion == 1) {
+ $topunits = get_configuration_units($doc, $configuration, 1, 1);
+ $subunits = get_configuration_units($doc, $configuration, 1, 2);
+ } elsif ($iVersion == 2) {
+ $topunits = get_configuration_units2($doc, $configuration, 1, 1);
+
+ $subunits = get_configuration_units2($doc, $configuration, 1, 2);
+ }
+
+ return ($topunits, $subunits,\@options,\@tasks);
+ }
+
+# check_filter
+#
+# Inputs
+# $item_filter - filter specification (comma-separated list of words)
+# $configspec - configuration specification (reference to list of words)
+#
+# Outputs
+# $failed - filter item which did not agree with the configuration (if any)
+# An empty string is returned if the configspec passed the filter
+#
+# Description
+# This function checks the configspec list of words against the words in the
+# filter. If a word is present in the filter, then it must also be present in
+# the configspec. If "!word" is present in the filter, then "word" must not
+# be present in the configspec.
+sub check_filter($$) {
+ my ($item_filter, $configspec) = @_;
+ my $failed = "";
+ foreach my $word (split /,/,$item_filter) {
+ if ($word =~ /^!/) {
+ # word must NOT be present in configuration filter list
+ my $notword = substr $word, 1;
+ $failed = $word if grep(/^$notword$/, @$configspec);
+ }
+ else {
+ # word must be present in configuration filter list
+ $failed = $word unless grep(/^$word$/, @$configspec);
+ }
+ }
+ return $failed;
+}
+
+# get_configuration_units
+#
+# Inputs
+# $doc - DOM document model
+# $configuration - configuration node
+# $verbose - enable/disable logging
+# $level - 0 = all units, 1 = top-level units, 2 = local units within tasks
+#
+# Outputs
+# \@units - reference to a list of unit,package & prebuilt nodes which implement this configuration
+#
+# Description
+# This function processes the specified configuration to get the list of unit or package
+# nodes that implement this configuration.
+sub get_configuration_units ($$$$)
+{
+ my ($doc, $configuration, $verbose, $level) = @_;
+ my @units; # list of individual buildable items
+
+ my ($model) = $doc->getElementsByTagName("SystemDefinition");
+
+ # Start with the units specified via unitListRefs, then append the
+ # units specified via layerRefs - they will be sorted afterwards anyway
+
+ my @unitlistrefs = $configuration->getElementsByTagName("unitListRef");
+ foreach my $child (@unitlistrefs) {
+ my $issublevel = $child->getParentNode->getTagName ne "configuration";
+ next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
+ push @units, &find_unitList_by_ID($doc, $child->getAttribute("unitList"), 1);
+ }
+ my @layerrefs = $configuration->getElementsByTagName("layerRef");
+ foreach my $child (@layerrefs) {
+ my $issublevel = $child->getParentNode->getTagName ne "configuration";
+ next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
+ my $layerName = $child->getAttribute("layerName");
+ # Find the named object and enumerate the units it contains
+ my ($layer) = XML::XQL::solve("//*[\@name = '$layerName']", $model);
+ if (!defined($layer)) {
+ print $GenXml::gLogFileH "ERROR: no match for \"$layerName\"\n";
+ next;
+ }
+ my @newunits = $layer->getElementsByTagName("unit",1);
+ my @newpackages = $layer->getElementsByTagName("package",1);
+ my @newprebuilts = $layer->getElementsByTagName("prebuilt",1);
+ if ($verbose) {
+ printf $GenXml::gLogFileH "Layer \"$layerName\" contained %d units, %d packages and %d prebuilt\n",
+ scalar @newunits, scalar @newpackages, scalar @newprebuilts;
+ }
+ push @newunits, @newpackages, @newprebuilts;
+ if (scalar @newunits == 0) {
+ print $GenXml::gLogFileH "WARNING: layerRef $layerName contains no units\n";
+ }
+ push @units, @newunits;
+ }
+
+ my @configspec = split /,/,$configuration->getAttribute("filter");
+ my @filtered_units;
+
+ # Scan the list, eliminating duplicates and elements which fail the filtering
+ my %mrpfiles;
+ foreach my $element (@units) {
+ my $name = $element->getAttribute("name");
+ my $filter = $element->getAttribute("filter");
+
+ if ($filter) {
+ my $failed = &check_filter($filter,\@configspec);
+ if ($failed ne "") {
+ print $GenXml::gLogFileH "Filtered out $name ($failed)\n" if ($verbose);
+ next;
+ }
+ }
+
+ my $mrp = $element->getAttribute("mrp");
+ if ($mrp) {
+ my $unitID = $element->getAttribute("unitID");
+ if (defined($mrpfiles{$mrp})) {
+ # eliminate duplicates
+ next if ($mrpfiles{$mrp} eq $unitID);
+ # report (and eliminate) conflicts
+ printf $GenXml::gLogFileH "WARNING: $mrp exists in %s and %s - skipping $unitID\n", $unitID, $mrpfiles{$mrp};
+ next;
+ }
+ $mrpfiles{$mrp} = $unitID;
+ }
+ push @filtered_units, $element;
+ }
+
+ if ($verbose) {
+ printf $GenXml::gLogFileH "%s contains %d units at level %d\n",
+ $configuration->getAttribute("name"), scalar @filtered_units, $level;
+ }
+ return \@filtered_units;
+}
+
+# compute_bldList
+#
+# Inputs
+# $iSourceDir - root of the current source tree
+# $iEffectiveDir - root of the source tree when used
+# $elements - reference to list of units, packages & prebuilts which can be part of the configuration
+# $iVersion - Version of xml file (new or old) ?
+#
+# Outputs
+# @bldList - a list of [name, bld.inf_dir, mrpfile] arrays, using $iEffectiveDir
+#
+# Description
+# This function processes a list of unit and package elements, extracting from
+# them the location of the associated bld.inf files. If bld.inf_dir is "" then
+# no bld.inf was specified (e.g. a package) or the bld.inf file does not exist.
+# If mrpfile is "" then no mrp file was specified.
+# <prebuilt> elements return "*nosource*" as the mrpfile
+sub compute_bldList
+{
+ my ($iSourceDir, $iEffectiveDir, $elements, $iVersion) = @_;
+ my @bldList;
+ my %priorityLists;
+ my ($name, $bldFile, $mrp, $priority, $unitID, $effmrp, $effbldFile, $packageName);
+ my ($count, $unit, @childNodes, @unitNames);
+ foreach my $element (@$elements)
+ {
+ # Variable holding the previous values and so giving wrong results. Lets undefine them.
+ undef $name; undef $bldFile; undef $mrp; undef $priority; undef $unitID; undef $effmrp; undef $effbldFile;
+ if ($iVersion == 1) {
+ push(@childNodes,$element);
+ } elsif ($iVersion == 2) {
+ my @units = $element->getElementsByTagName("unit");
+ for ( @units )
+ {
+ push(@childNodes, $_);
+ push(@unitNames, $element->getElementsByTagName("name"));
+ }
+ }
+ }
+
+ # should only be one childNodes, but this will make sure we handle all in case there are any
+ for my $index ( 0 .. $#childNodes ) {
+ my $unit = $childNodes[$index];
+ my $unitName = $unitNames[$index];
+ if ($iVersion == 1) {
+ $name = $unit->getAttribute("name");
+ $bldFile = $unit->getAttribute("bldFile");
+ $mrp = $unit->getAttribute("mrp");
+ $priority = $unit->getAttribute("priority");
+ $unitID = $unit->getAttribute("unitID");
+ $effmrp = $mrp;
+ $effbldFile = $bldFile;
+ } elsif ($iVersion == 2) {
+ $name = $unitName;
+ $bldFile = $unit->getAttribute("bldFile");
+ $mrp = $unit->getAttribute("mrp");
+ $priority = $unit->getAttribute("priority");
+ $mrp =~ /.+\\([\w_-]+)\.mrp/;
+ $packageName = $1;
+ $effmrp = $mrp;
+ $effbldFile = $bldFile;
+ $unitID = $name;
+ }
+
+ if ($mrp)
+ {
+ if ($mrp !~ /^\\/)
+ {
+ # watch out for mrp="\product\..."
+ $mrp = $iSourceDir.$mrp;
+ $effmrp = $iEffectiveDir.$effmrp;
+ }
+ if (-f $mrp)
+ {
+ # get the component name
+ open MRPFILE, "<$mrp"
+ or print $GenXml::gLogFileH "ERROR: Cannot read $mrp - skipping \"$unitID\"\n" and next;
+ my $mrpline;
+ while ($mrpline = <MRPFILE>)
+ {
+ if ($mrpline =~ /^\s*component\s+(\S+)/)
+ {
+ $name = $1;
+ last;
+ }
+ }
+ close MRPFILE;
+ } else {
+ # print $GenXml::gLogFileH "ERROR: $mrp does not exist - skipping \"$unitID\"\n";
+ # next;
+ $name = $packageName if defined $packageName;
+ # Unfortunately, we need to cope with the pkgdefs components which are created later
+ print $GenXml::gLogFileH "REMARK: $mrp does not exist - assuming $name is correct...\n";
+ }
+ } else {
+ $mrp = "";
+ $effmrp = "";
+ }
+ if ($bldFile)
+ {
+ if ($bldFile =~ /^\w:\\/)
+ {
+ print "Warning:Bldfile path should not contain drive letters.The build may continue with problems\n";
+ }
+ else
+ {
+ if ($bldFile =~ /^\\/)
+ {
+ # No need to add the source dir path
+ }
+ else
+ {
+ $bldFile = $iSourceDir.$bldFile;
+ $effbldFile = $iEffectiveDir.$effbldFile;
+ }
+ }
+ if (!-f "$bldFile\\BLD.INF")
+ {
+ print $GenXml::gLogFileH "ERROR: $bldFile\\BLD.INF does not exist - skipping \"$unitID\"\n";
+ next;
+ }
+ } else {
+ $bldFile = "";
+ $effbldFile = "";
+ }
+
+ if ($mrp eq "" && $bldFile eq "") {
+ if ($iVersion == 1) {
+ if ($unit->getTagName eq "prebuilt") {
+ $mrp = "*nosource*";
+ $effmrp = $mrp;
+ }
+ } elsif ($iVersion == 2) {
+ if ($unit->getAttribute("prebuilt")) {
+ $mrp = "*nosource*";
+ $effmrp = $mrp;
+ $name = $unit->getAttribute("prebuilt");
+ }
+ }
+ }
+ if($mrp eq "" && $bldFile eq "") {
+ #print $GenXml::gLogFileH "ERROR: no MRP file, no BLD.INF directory - skipping \"$unitID\"\n";
+ next;
+ }
+
+ if (!$priority)
+ {
+ $priority = 1000;
+ }
+
+ if (! defined($priorityLists{$priority}))
+ {
+ $priorityLists{$priority} = ();
+ }
+ push @{$priorityLists{$priority}}, [$name,$effbldFile,$effmrp];
+ }
+
+ # concatenate the lists in (ascending numerical) priority order
+ foreach my $priority (sort {$a <=> $b} keys %priorityLists)
+ {
+ push @bldList, @{$priorityLists{$priority}};
+ }
+
+ return @bldList;
+}
+
+# find_unitList_by_ID
+#
+# Inputs
+# $doc - DOM document model
+# $id - the IDREF of the unitList
+# $iVersion - Version of xml file (new or old) ?
+#
+# Outputs
+# @units - a list of unit elements referenced in the specified unit list
+#
+# Description
+# This function is used to convert a unitListRef into the corresponding
+# list of units.
+sub find_unitList_by_ID()
+{
+ my ($doc, $id, $iVersion) = @_;
+
+ my (@units, @element); # List of units in unitList and elements
+ my ($unitList, $unitRef, $attribute);
+ if ($iVersion == 1) {
+ $unitList = "unitList" ;
+ $unitRef = "unitRef";
+ $attribute = "unit";
+ @element = XML::XQL::solve("//unitList[\@name = '$id']", $doc);
+ } elsif ($iVersion == 2) {
+ $unitList = "list" ;
+ $unitRef = "ref";
+ $attribute = "item";
+ @element = XML::XQL::solve("//list[\@name = '$id']", $doc);
+ }
+
+ # Should only return one element because the Validating Parser will not allow multiple DTD ID's
+ if (!($element[0]))
+ {
+ print $GenXml::gLogFileH "ERROR: Cannot find $unitList $id\n";
+ die "ERROR: RealTimeBuild: Cannot find $unitList $id\n";
+ }
+ my @unitRefs = $element[0]->getElementsByTagName("$unitRef",1);
+ if (scalar @unitRefs == 0)
+ {
+ print $GenXml::gLogFileH "WARNING: $unitList $id contains no units\n";
+ }
+ foreach my $unitRef (@unitRefs)
+ {
+ my $unitID = $unitRef->getAttribute("$attribute");
+ my (@element);
+ if ($iVersion == 1) {
+ (@element) = XML::XQL::solve ("//unit[\@unitID = '$unitID']", $doc);
+ } elsif ($iVersion == 2) {
+ (@element) = XML::XQL::solve ("//component[\@name = '$unitID']", $doc);
+ }
+ if (!($element[0]))
+ {
+ print $GenXml::gLogFileH "ERROR: $unitList $id refers to non-existent $attribute $unitID, not building\n";
+ next;
+ }
+ push @units,$element[0];
+ }
+ return @units;
+}
+
+# find_targetList_by_ID
+#
+# Inputs
+# $doc - reference to DOM document model
+# $id - value of the IDREFS to find (multiple whitespace ID's)
+#
+# Outputs
+# @targets - a list of targets referenced in the specified targetList
+#
+# Description
+# This function finds a list of units and full source location
+sub find_targetList_by_ID
+{
+ my ($doc, $idrefs) = @_;
+
+ my $n; # Number of Nodes
+ my @targets; # List of units in targetList
+
+ # Split on whitespace to get ID's from IDREFS
+ my @ids = split(/\s+/, $idrefs);
+
+ for (my $i = 0; $i < scalar(@ids); $i++)
+ {
+ my ($id) = $ids[$i];
+ my (@element) = XML::XQL::solve("//targetList[\@name = '$id']", $doc);
+ # Should only return one element because the Validating Parser will not allow multiple DTD ID's
+ # target attrib is another IDREFS list of target
+ if (!($element[0]))
+ {
+ print $GenXml::gLogFileH "ERROR: Cannot find targetList $id\n";
+ die "ERROR: RealTimeBuild: Cannot find targetList $id\n";
+ }
+ my $targetIDREFS;
+ if ($element[0])
+ {
+ $targetIDREFS = $element[0]->getAttributeNode("target")->getValue;
+ } else {
+ print $GenXml::gLogFileH "ERROR: Cannot find targetList of $id\n";
+ die "ERROR: RealTimeBuild: Processing error\n";
+ }
+
+ # Split on whitespace to get ID's from IDREFS
+ my @targetsID = split(/\s+/, $targetIDREFS);
+ for (my $j = 0; $j < scalar(@targetsID); $j++)
+ {
+ my ($target) = $targetsID[$j];
+ my (@target_element) = XML::XQL::solve("//target[\@name = '$target']", $doc);
+ # Should only return one element because the Validating Parser will not allow multiple DTD ID's
+ if ($target_element[0])
+ {
+ push @targets, $target_element[0]->getAttributeNode("abldTarget")->getValue;
+ } else {
+ print $GenXml::gLogFileH "ERROR: Cannot find target of $target\n";
+ die "ERROR: RealTimeBuild: Processing error\n";
+ }
+ }
+ }
+
+ return @targets;
+}
+
+# logfileHeader
+#
+# Inputs
+# $comp - string to place in the "component" section of the header
+#
+# Outputs
+#
+# Description
+# This function print the log file header to te global logfile handle
+sub logfileHeader
+{
+ my ($comp) = @_;
+
+ if ($gEmbeddedLog)
+ {
+ print $GenXml::gLogFileH "*** $comp\n";
+ return;
+ }
+
+ # Log file headers for each log file loading
+ print $GenXml::gLogFileH "=== Genxml == $comp\n";
+
+ print $GenXml::gLogFileH "-- Genxml\n";
+ # Add the per command start timestamp
+ print $GenXml::gLogFileH "++ Started at ".localtime()."\n";
+ # Add the per command start HiRes timestamp if available
+ if ($gHiResTimer == 1)
+ {
+ print $GenXml::gLogFileH "+++ HiRes Start ".Time::HiRes::time()."\n";
+ } else {
+ # Add the HiRes timer missing statement
+ print $GenXml::gLogFileH "+++ HiRes Time Unavailable\n";
+ }
+ $GenXml::gLogFileH->flush;
+}
+
+# logfileFooter
+#
+# Inputs
+#
+# Outputs
+#
+# Description
+# This function print the log file footer to the global logfile handle
+sub logfileFooter
+{
+ return if ($gEmbeddedLog);
+
+ # Add the per command end HiRes timestamp if available
+ print $GenXml::gLogFileH "+++ HiRes End ".Time::HiRes::time()."\n" if ($gHiResTimer == 1);
+ # Add the per command end timestamp
+ print $GenXml::gLogFileH "++ Finished at ".localtime()."\n";
+ $GenXml::gLogFileH->flush;
+}
+
+
+#####################################################################################
+#
+# v2 api's for new SystemDefinition
+#
+#####################################################################################
+
+# process_node2
+#
+# Inputs
+# $node1 - ref to the master doc
+# $node2 - ref to the slave doc
+# $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
+#
+# Outputs
+#
+# Description
+# This function processes a node in two DOM documents, if any children match then it calls itself to process
+# the children nodes further
+sub process_node2
+{
+ my ($doc1, $doc2) = @_;
+
+ my $merged = new XML::DOM::Parser;
+
+ # Some nodes need special processing e.g. SystemDefinition
+ # This is because there can only be a certain number of these nodes
+ # child node / element rules outlined below, this rules are applied to the children of the node in question
+
+ my ($node1, $node2);
+
+ # All other nodes Append child
+
+ # Useful debug stuff
+ #$GenXml::count++;
+ #print "enter $GenXml::count\n";
+
+ # Handle the special case for the first call to this function with the node containing the SystemDefinition
+ if (($$doc1->getDocumentElement->getTagName eq "SystemDefinition")
+ && ($$doc2->getDocumentElement->getTagName eq "SystemBuild"))
+ {
+ # Process the DTD and merge
+ my $dtd1 = $$doc1->getDoctype->toString;
+ my $dtd2 = $$doc2->getDoctype->toString;
+ my $mergeddtd = &Merge_dtd($dtd1, $dtd2);
+ $mergeddtd .= $$doc1->getDocumentElement->toString;
+ $merged = $merged->parse($mergeddtd);
+
+ $node1 = \($merged->getElementsByTagName("SystemDefinition"));
+ $node2 = \($$doc2->getElementsByTagName("SystemBuild"));
+
+ my $tagname = $$node2->getTagName;
+ for my $item ($$doc2->getChildNodes) {
+ if ($item->toString =~ /^\s*<$tagname .+>/isg) {
+ &append_child($node1, \($item), \$merged);
+ last;
+ }
+ }
+ }
+
+ return $merged;
+}
+
+# Merge_dtd
+sub Merge_dtd {
+ my ($doctype1, $doctype2) = @_;
+ my $mergeddtd;
+
+ # split them into an array of values
+ my @doctypeValues1 = split '\n', $doctype1;
+ my @doctypeValues2 = split '\n', $doctype2;
+ my $elementNameToAdd;
+
+ my $count = 1;
+ for my $line (@doctypeValues2) {
+ if ( $line =~ /<!ELEMENT (\w+) .+>/ ) {
+ $elementNameToAdd = $1;
+ last;
+ }
+ $count++;
+ }
+ splice @doctypeValues2, 0, $count-1;
+
+ my $i;
+ for ($i=0; $#doctypeValues1; $i++) {
+ last if ( $doctypeValues1[$i] =~ /<!ELEMENT SystemDefinition .+>/);
+ }
+ $doctypeValues1[$i] =~ s/(.+) \)>$/$1?, $elementNameToAdd? )>/;
+
+ $#doctypeValues1 = $#doctypeValues1 -1;
+
+ push @doctypeValues1, @doctypeValues2;
+
+ unshift @doctypeValues1, '<?xml version="1.0" encoding="UTF-8"?>';
+ $mergeddtd = join "\n", @doctypeValues1;
+
+ return $mergeddtd;
+}
+
+
+# Filter_doc2
+#
+# Inputs
+# $doc - Reference to input document
+# $iFilter - filter to apply
+#
+# Outputs
+#
+# Description
+# This function simplifies the XML by removing anything which fails to pass the filter.
+# The resulting doc is then useful for tools which don't understand the filter attributes.
+sub Filter_doc2 {
+ my ($doc, $iFilter) = @_;
+
+ # the filtering will have to be
+ # - find the configurations which pass the filter (and delete the rest)
+ # - identify items which are kept by some configuration
+ # - remove the ones which aren't kept by any configuration.
+
+ # deal with the <configuration> items, checking their filters
+ my %lists;
+ my @nodes = $doc->getElementsByTagName ("configuration");
+ foreach my $node (@nodes) {
+ my $configname = $node->getAttribute("name");
+ my @configspec = split /,/,$node->getAttribute("filter");
+ my $failed = check_filter($iFilter,\@configspec);
+ if ($failed ne "") {
+ print $GenXml::gLogFileH "Simplification removed configuration $configname ($failed)\n";
+ $node->getParentNode->removeChild($node);
+ next;
+ }
+ # find all the units for this configuration and mark them as MATCHED
+ print $GenXml::gLogFileH "Analysing configuration $configname...\n";
+ my $unfiltered_items = get_configuration_units2($doc, $node, 0, 0); # Replace the arg 1 with 0 to put the debug off
+ foreach my $unit (@$unfiltered_items) {
+ $unit->setAttribute("MATCHED", 1);
+ }
+ # note all the lists referenced by this configuration
+ foreach my $listRef ($node->getElementsByTagName("listRef")) {
+ my $list = $listRef->getAttribute("list");
+ $lists{$list} = 1;
+ }
+ }
+
+ # walk the model, removing the "MATCHED" attribute and deleting any which weren't marked
+ my %deletedUnits;
+ delete_unmatched_units($doc, \%deletedUnits);
+
+ # clean up the lists
+ my @lists = $doc->getElementsByTagName("list");
+ foreach my $list (@lists) {
+ my $name = $list->getAttribute("name");
+ if (!defined $lists{$name}) {
+ print $GenXml::gLogFileH "Simplification removed list $name\n";
+ $list->getParentNode->removeChild($list);
+ next;
+ }
+ foreach my $ref ($list->getElementsByTagName("ref")) {
+ my $id = $ref->getAttribute("item");
+ if (defined $deletedUnits{$id}) {
+ $list->removeChild($ref); # reference to deleted unit
+ }
+ }
+ }
+
+}
+
+# get_configuration_units2
+#
+# Inputs
+# $doc - DOM document model
+# $configuration - configuration node
+# $verbose - enable/disable logging
+# $level - 0 = all units, 1 = top-level units, 2 = local units within tasks
+#
+# Outputs
+# \@units - reference to a list of unit,package & prebuilt nodes which implement this configuration
+#
+# Description
+# This function processes the specified configuration to get the list of unit or package
+# nodes that implement this configuration.
+sub get_configuration_units2 ($$$$) {
+ my ($doc, $configuration, $verbose, $level) = @_;
+ my @filterable_items; # list of individual buildable items
+ my ($mrp, $bldFile);
+
+ my ($model) = $doc->getElementsByTagName("systemModel");
+
+ # Start with the units specified via listRefs, then append the
+ # units specified via layerRefs - they will be sorted afterwards anyway
+ my @listrefs = $configuration->getElementsByTagName("listRef");
+ foreach my $child (@listrefs) {
+ my $issublevel = $child->getParentNode->getTagName ne "configuration";
+ next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
+ push @filterable_items, &find_unitList_by_ID($doc, $child->getAttribute("list"), 2);
+ }
+ my @refs = $configuration->getElementsByTagName("ref");
+ foreach my $child (@refs) {
+ my $issublevel = $child->getParentNode->getTagName ne "configuration";
+ next if (($level==1 && $issublevel) || ($level==2 && !$issublevel));
+ my $item = $child->getAttribute("item");
+ # Find the named object and enumerate the items it contains
+ my ($layer) = XML::XQL::solve("//*[\@name = '$item']", $model);
+ if (!defined($layer)) {
+ print $GenXml::gLogFileH "ERROR: no match for \"$item\"\n";
+ next;
+ }
+ my @newunits = $layer->getElementsByTagName("unit",1);
+ my @components = $layer->getElementsByTagName("component",1);
+
+ if ($verbose) {
+ printf $GenXml::gLogFileH "Layer \"$item\" contained %d untis in %d components, \n",
+ scalar @newunits, scalar @components;
+ }
+ if (scalar @newunits == 0) {
+ print $GenXml::gLogFileH "WARNING: ref $item contains no units\n";
+ }
+ if (scalar @components == 0) {
+ print $GenXml::gLogFileH "WARNING: ref $item contains no components\n";
+ }
+ push @filterable_items, @components, @newunits;
+ }
+
+ my @configspec = split /,/,$configuration->getAttribute("filter");
+ my @unfiltered_items;
+
+ # Scan the list, eliminating duplicates and elements which fail the filtering
+ my %mrpfiles;
+ foreach my $element (@filterable_items) {
+ my $name = $element->getAttribute("name");
+ my $filter = $element->getAttribute("filter");
+ my $class = $element->getAttribute("class");
+
+ if ($filter) {
+ my $failed = &check_filter($filter,\@configspec);
+ if ($failed ne "") {
+ print $GenXml::gLogFileH "Filtered out $name ($failed)\n" if ($verbose);
+ next;
+ }
+ }
+ if($element->getTagName eq 'unit')
+ {
+ # if it's not been filtered out, then substitute the unix syle path to windows style.
+ $bldFile = $element->getAttribute("bldFile");
+ if ($bldFile ne "") {
+ $bldFile =~ s/\//\\/g;
+ $element->setAttribute("bldFile", $bldFile) ;
+ }
+ $mrp = $element->getAttribute("mrp");
+ if ($mrp ne "") {
+ $mrp =~ s/\//\\/g;
+ $element->setAttribute("mrp", $mrp) ;
+ }
+
+ if ($mrp) {
+ #my $elementName = $element->getAttribute("name");
+ if (defined($mrpfiles{$mrp})) {
+ # eliminate duplicates
+ next if ($mrpfiles{$mrp} eq $name);
+ # report (and eliminate) conflicts
+ printf $GenXml::gLogFileH "WARNING: $mrp exists in %s and %s - skipping $name\n",
+ $name, $mrpfiles{$mrp};
+ next;
+ }
+ $mrpfiles{$mrp} = $name;
+ }
+ }
+ push @unfiltered_items, $element;
+ }
+
+ if ($verbose) {
+ printf $GenXml::gLogFileH "%s contains %d units and components at level %d\n",
+ $configuration->getAttribute("name"), scalar @unfiltered_items, $level;
+ }
+
+ # Process the tag "<specialInstructions" in the given configuration. Need to convert the attribut "CWD" to windows style
+ foreach my $child ($configuration->getElementsByTagName("specialInstructions")) {
+ my $command = $child->getAttribute("cwd");
+ $command =~ s/\//\\/g;
+ $child->setAttribute("cwd", $command);
+ }
+ return \@unfiltered_items;
+}
+
+
+1;