dummy_foundation/generate_dummytree.pl
changeset 0 02cd6b52f378
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/dummy_foundation/generate_dummytree.pl	Thu May 28 10:10:03 2009 +0100
@@ -0,0 +1,729 @@
+#! perl
+
+# Read a Foundation system model, mapping file, and System_Definition.xml
+# and generate a Perforce branchspec to reflect the code reorg
+
+use strict;
+
+use FindBin;
+use lib ".";
+use lib "./lib";
+use lib "$FindBin::Bin";
+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;
+
+# Read the command line to get the filenames
+
+sub Usage($)
+	{
+	my ($reason) = @_;
+
+	print "Usage: $reason\n" if ($reason);
+	print <<USAGE_EOF;
+
+Usage: generate_branchspec.pl <params> [options]
+
+params:
+-s <system_definition>  XML version of Symbian System_definition
+-m <foundation_model>   XML version of Foundation System Model
+
+options:
+-o <whats_left>     XML file showing unreferenced
+                       parts of the System Model
+-r                  Remove matched objects from -o output
+-c <cbr_mapping>    Tab separated file showing the Schedule 12
+                       component for each MRP file
+
+USAGE_EOF
+	exit(1);
+	}
+	
+use Getopt::Long;
+
+my $foundationmodel = "output_attr.xml";
+my $foundationdirs = "foundation_dirs.xml";
+my $systemdefinition = "variability/vp_data/templates/System_Definition_template.xml";
+my $rootdir = ".";
+my $remove = 0;
+my $cbrmappingfile = "";
+
+Usage("Bad arguments") unless GetOptions(
+  	'm=s' => \$foundationmodel, 
+  	's=s' => \$systemdefinition,
+  	'o=s' => \$rootdir,
+  	'c=s' => \$cbrmappingfile);
+
+Usage("Too many arguments") if (scalar @ARGV > 0);
+Usage("Cannot find $foundationmodel") if (!-f $foundationmodel);
+
+
+my $xmlParser = new XML::DOM::Parser; 
+XML::DOM::ignoreReadOnly(1);
+
+my $foundationpath = ".";
+my $sysdefpath = ".";
+$foundationpath = $1 if ($foundationmodel  =~ /^(.+)\\[^\\]+$/);
+$sysdefpath = $1 if ($systemdefinition =~ /^(.+)\\[^\\]+$/);
+#$xmlParser->set_sgml_search_path($foundationpath, $sysdefpath);
+
+my $foundationXML = $xmlParser->parsefile ($foundationmodel);
+chdir($rootdir);
+
+# Collect the Schedule12 entries, checking for duplicates
+
+my %sch12refs;
+my %componenttype;
+my ($foundation) = $foundationXML->getElementsByTagName("SystemDefinition");
+Usage("No <SystemDefinition> in $foundationmodel ?") if (!defined $foundation);
+
+# Process the Foundation model to get the directory names
+
+my %unique_names;
+my %partnames;
+my %dirnames;
+my %component_dirs;
+my %old_component_mapping;
+my %component_object;	# reference to XML <component> objects
+my %mrp_mapping;
+
+sub process_foundation($$);		# declare the prototype for recursive call
+sub process_foundation($$)
+	{
+	my ($node,$level) = @_;
+
+	my @children = $node->getChildNodes;
+	foreach my $child (@children)
+		{
+		if ($child->getNodeTypeName ne "ELEMENT_NODE")
+			{
+			# text and comments don't count
+			next;
+			}
+		if ($level == 0)
+			{
+			process_foundation($child,1);
+			next;
+			}
+
+		next if ($child->getAttribute("contribution") eq "excluded");
+
+		my $tagname = $child->getTagName;
+		my $name = $child->getAttribute("name");
+		my $longname = $child->getAttribute("long-name");
+		$longname = $name if ($longname eq "");
+		
+		if ($name ne "")
+			{
+			if (defined $unique_names{$name})
+				{
+				print "** duplicated name $name\n";
+				}
+			$unique_names{$name} = 1;
+			}
+		if ($name eq "")
+			{
+			printf "No name in %s\n", $child->toString();
+			next;
+			}
+		
+		my $dirname = $name;
+		$dirname =~ s/\s+//g;		# remove the spaces
+		$dirname =~ s/[\(\)]/_/g;	# map troublesome characters
+		$dirname =~ s/[ \.]*$//g;	# trailing spaces or dots
+		$partnames{$tagname} = $name;
+		$dirnames{$tagname} = $dirname;
+		
+		print "making directory $dirname\n" if ($level <2);
+		mkdir $dirname;	# create the directory
+		
+		if ($tagname eq "component")
+			{
+			$child->printToFile("$dirname/component.txt");
+			next;
+			}
+
+		chdir $dirname;		
+		if ($tagname eq "block")
+			{
+			# Create a fragment which describes this package
+			open PACKAGE_MODEL, ">package_model.xml";
+			print PACKAGE_MODEL "<!-- use XINCLUDE to put this fragment into a System_Model -->\n";
+			print PACKAGE_MODEL $child->toString();
+			print PACKAGE_MODEL "\n";
+			close PACKAGE_MODEL;
+			}
+
+		process_foundation($child,$level+1);
+		chdir "..";
+		}
+	}
+
+my ($model) = $foundationXML->getElementsByTagName("SystemDefinition");
+process_foundation($model,0);
+
+exit 0;
+
+# Dump the old component -> new component -> directory mapping
+
+foreach my $component (sort keys %old_component_mapping)
+	{
+	my $new_component = $old_component_mapping{$component};
+	printf "%s => %s => %s\n",
+		$component, $new_component, $component_dirs{$new_component};
+	}
+
+# Find the old component entries in the XML file
+
+my %branchspec;
+my %reverse_branchspec;
+my %primary_mrp;
+my %otherroots;
+my %ignoreme;
+
+sub add_to_branchspec($$;$$);
+sub add_to_branchspec($$;$$)
+	{
+	my ($olddir,$newdir,$primary,$noexpansion) = @_;
+	$primary = "generate_branchspec.pl" if (!defined $primary);
+	
+	if (defined $ignoreme{$olddir} && $primary !~ /^extra root/)
+		{
+		print "Ignoring $olddir - $ignoreme{$olddir}\n";
+		next;
+		}
+	if (defined $branchspec{$olddir})
+		{
+		if ($newdir eq $branchspec{$olddir})
+			{
+			# reasserting the previous branchspec - not a problem
+			return;
+			}
+		# trying to change the old mapping
+		print "$primary attempted to redefine $olddir mapping\n";
+		print "Was $branchspec{$olddir} instead of $newdir\n";
+		exit(1);
+		}
+
+	if (defined $reverse_branchspec{$newdir})
+		{
+		print "Branchspec collision from $primary into $newdir\n";
+		print "Can't send $olddir and $reverse_branchspec{$newdir} to same place\n";
+		exit(1);
+		}
+	
+	if (defined $otherroots{$olddir} && !$noexpansion)
+		{
+		print "Adjusting branchspec for $primary to include the other roots\n";
+		my $otherolddir = $olddir;
+		$otherolddir =~ s/([^\/]+)\/$//;
+		my $maindir = $1;
+		add_to_branchspec("$olddir","$newdir$maindir/",$primary,1);	# avoid recursion
+
+		foreach my $otherdir (split /\//, $otherroots{$olddir})
+			{
+			next if (length($otherdir) == 0);
+			add_to_branchspec("$otherolddir$otherdir/","$newdir$otherdir/","extra root of $primary",1);
+			}
+		}
+	else
+		{
+		$branchspec{$olddir} = $newdir;
+		$reverse_branchspec{$newdir} = $olddir;
+		$primary_mrp{$olddir} = $primary;
+		}
+	}
+
+# Workaround for the common/product and cedar/product directories, which don't
+# have associated CBR components
+
+add_to_branchspec("common/product/", "ostools/toolsandutils/ToolsandUtils/product/");
+add_to_branchspec("cedar/product/",  "ostools/toolsandutils/ToolsandUtils/cedarproduct/");
+
+# Add catchall mappings to get all do the other odds and ends
+# LHS must be more specific than a single directory, otherwise apply_branchspec hits too many things
+# RHS must be short, to avoid blowing the Windows path limit when syncing TBAS builds
+add_to_branchspec("common/generic/",   "os/unref/orphan/comgen/", "(Orphans)");
+add_to_branchspec("common/techview/",  "os/unref/orphan/comtv/",  "(Orphans)");
+add_to_branchspec("common/testtools/", "os/unref/orphan/comtt/",  "(Orphans)");
+add_to_branchspec("common/connectqi/", "os/unref/orphan/comqi/",  "(Orphans)");
+add_to_branchspec("cedar/generic/",    "os/unref/orphan/cedgen/", "(Orphans)");
+
+my @clumps = (
+	"cedar/generic/base/e32/",
+	"cedar/generic/base/f32/",
+	"common/generic/comms-infras/esock/",
+	"common/generic/multimedia/ecam/",
+	"common/generic/multimedia/icl/",
+	"common/generic/multimedia/mmf/",
+	"common/generic/j2me/",				# not really a clump, but must be called "j2me"
+	"common/generic/telephony/trp/",
+	"common/generic/security/caf2/test/",
+	"common/generic/networking/dialog/",
+	"common/generic/comms-infras/commsdat/",
+	"common/generic/connectivity/legacy/PLP/",	# plpvariant shares PLPInc main PLP group
+	"common/testtools/ResourceHandler/",	# entangled versions for Techview, UIQ and S60
+);
+
+# Force E32 into a faintly sensible place
+
+add_to_branchspec("cedar/generic/base/e32/", "os/kernelhwsrv/kernel/eka/", "(Hand coded E32 location)");
+
+# Force j2me to be called j2me
+
+add_to_branchspec("common/generic/j2me/", "app/java/midpprofile/midpmidlet/j2me/", "(Hand coded J2ME location)");
+
+# Peer relationships if x uses "..\y", then add this as $peers{"x"} = "y"
+
+my %peers;
+$peers{"cedar/generic/tools/e32toolp/"} = "cedar/generic/tools/buildsystem/";
+
+# multirooted components, which own several trees that have no common root
+# Add these to the branchspec automatically alongside the root containing the MRP file
+
+$otherroots{"common/generic/networking/inhook6/"} = "inhook6example";
+$otherroots{"common/generic/networking/examplecode/"} = "anvltest/cgi/ping/udpecho/udpsend/webserver";
+$otherroots{"common/generic/networking/qos/"} = "qostest/QoSTesting";
+$otherroots{"common/generic/wap-stack/wapstack/"} = "documentation/confidential";
+$otherroots{"common/generic/bluetooth/latest/bluetooth/test/"} = "example/testui";
+
+
+my %hasbldfile;
+
+my %foundationrefs;
+my %foundationbymrp;
+my %modelnames;
+sub match_names($);		# declare the prototype for recursive call
+sub match_names($)
+	{
+	my ($node) = @_;
+
+	my @children = $node->getChildNodes;
+	foreach my $child (@children)
+		{
+		if ($child->getNodeTypeName ne "ELEMENT_NODE")
+			{
+			# text and comments don't count
+			next;
+			}
+		my $tagname = $child->getTagName;
+		if ($tagname eq "layer")
+			{
+			$partnames{"block"} = undef;
+			$partnames{"subblock"} = undef;
+			$partnames{"collection"} = undef;
+			}
+		if ($tagname eq "block")
+			{
+			$partnames{"subblock"} = undef;
+			$partnames{"collection"} = undef;
+			}
+		if ($tagname eq "subblock")
+			{
+			$partnames{"collection"} = undef;
+			}
+		if ($tagname eq "unit")
+			{
+			# units are the payload
+
+			my $mrp = $child->getAttribute("mrp");
+			$mrp =~ s/\\/\//g;	# ensure that / separators are used
+			$child->setAttribute("mrp",$mrp);
+
+			my $blockname = $partnames{"subblock"};
+			$blockname = $partnames{"block"} if (!defined $blockname);	# no subblock
+			$blockname = "Misc" if (!defined $blockname);	# no block either
+			my $old_component = join("::",
+				$partnames{"layer"}, $blockname, 
+				$partnames{"collection"},$partnames{"component"});
+
+			# find corresponding new component
+			
+			my $new_component;
+			
+			if (defined $mrp_mapping{$mrp})
+				{
+				$new_component = $mrp_mapping{$mrp};
+				my $othermapping = $old_component_mapping{$old_component};
+				if (defined $othermapping && $othermapping eq $new_component)
+					{
+					# they agree - lovely.
+					}
+				else
+					{
+					print "MRP mapping $mrp -> $new_component, disagrees with $old_component mapping\n";
+					}
+				delete $component_object{$new_component};
+				}
+			if (!defined $new_component)
+				{
+				$new_component = $old_component_mapping{$old_component};
+				}
+			if (!defined $new_component)
+				{
+				# Some "old_package" information is incorrect - scan for a close match
+				# Strategy 1 - match collection::component
+				my $tail = join ("::", $partnames{"collection"},$partnames{"component"});
+				my $len = 0-length($tail);
+				
+				foreach my $guess (keys %old_component_mapping)
+					{
+					if (substr($guess,$len) eq $tail)
+						{
+						print "Guessed that $old_component should be $guess\n";
+						$new_component = $old_component_mapping{$guess};
+						last;
+						}
+					}
+				}
+			if (!defined $new_component)
+				{
+				# Some "old_package" information is incorrect - scan for a close match
+				# Strategy 2 - just match the component name, 
+				# truncate after last / e.g. GPRS/UMTS QoS Framework => UMTS QoS Framework
+				my $tail = "::".$partnames{"component"};
+				$tail =~ s/^.*\/([^\/]*)$/$1/;
+				my $len = 0-length($tail);
+				
+				foreach my $guess (keys %old_component_mapping)
+					{
+					if (substr($guess,$len) eq $tail)
+						{
+						print "Guessed that $old_component should be $guess\n";
+						$new_component = $old_component_mapping{$guess};
+						last;
+						}
+					}
+				}
+			if (!defined $new_component)
+				{
+				print "Rescuing unreferenced $old_component\n";
+				# later we will infer the new_component directory from the mrp
+				}
+			else
+				{
+				if (!defined $mrp_mapping{$mrp})
+					{
+					# Copy the unit into the Foundation model (we'll fix it later)
+					
+					my $foundation_comp = $component_object{$new_component};
+					$node->removeChild($child);
+					$child->setOwnerDocument($foundation_comp->getOwnerDocument);
+					$foundation_comp->addText("\n      ");
+					$foundation_comp->appendChild($child);
+					$foundation_comp->addText("\n     ");
+					delete $component_object{$new_component};	# remove items after processing
+					}
+				}
+			
+			# determine the root of the component source tree from the mrp attribute
+			
+			if ($mrp =~ /^\//)
+				{
+				print "Skipping absolute MRP $mrp in $old_component\n";
+				next;
+				}
+			
+			my $current_dir = $mrp;
+			$current_dir =~ s-/[^/]+$-/-;		# remove filename;
+
+			# tree structure special cases
+			$current_dir =~ s-/sms/multimode/Group/-/sms/-;
+			$current_dir =~ s-/agendaserver/TestAgendaSrv/-/agendaserver/-;
+			$current_dir =~ s-/alarmserver/TestAlarmSrv/-/alarmserver/-;
+			$current_dir =~ s-/trace/ulogger/group/-/trace/-;
+			$current_dir =~ s-/ucc/BuildScripts/group/-/ucc/-;
+			$current_dir =~ s-/worldserver/TestWorldSrv/-/worldserver/-;
+			$current_dir =~ s-/adapters/devman/Group/-/adapters/-;	# avoid collision with syncml/devman
+			$current_dir =~ s-/mobiletv/hai/dvbh/group/-/mobiletv/-;
+			$current_dir =~ s-/plpgrp/-/-i;		# connectivity/legacy/PLP/plpgrp
+			$current_dir =~ s-/(h2|h4)/.*$-/-i;	# various baseports
+
+			# more generic cases
+			$current_dir =~ s-/group/.*$-/-i;	# group (& subdirs)
+			$current_dir =~ s-/group[^/]+/.*$-/-i;	# groupsql, groupfuture (& subdirs) - cntmodel, s60 header compat
+			$current_dir =~ s-/mmpfiles/-/-i;	# comp/mmpfiles
+			
+			# apply clumping rules
+			
+			foreach my $clump (@clumps)
+				{
+				if (substr($current_dir,0,length($clump)) eq $clump)
+					{
+					print "$mrp is part of the component group rooted at $clump\n";
+					$current_dir = $clump;
+					last;
+					}
+				}
+			
+			# check for inseparable components
+			my $new_dir;
+			my $primary;
+			my $set_peer_directory = 0;
+			
+			if (defined $branchspec{$current_dir})
+				{
+				$primary = $primary_mrp{$current_dir};
+				print "Cannot separate $mrp from $primary\n";
+				$new_dir = $branchspec{$current_dir};	# use the directory for the other component
+				}
+			elsif (defined $peers{$current_dir})
+				{
+				# apply peering rules
+				my $peer = $peers{$current_dir};
+				
+				if (defined $branchspec{$peer})
+					{
+					# peer already defined - adjust our mapping
+					$new_dir = $branchspec{$peer};
+					$new_dir =~ s/[^\/]+\/$//;
+					$current_dir =~ m/([^\/]+\/)$/;
+					$new_dir .= $1;
+					print "Mapping $mrp to $new_dir to be next to peer $peer\n";
+					$primary = $mrp;
+					}
+				else
+					{
+					# we are the first to appear, so we determine the directory
+					$set_peer_directory = 1;
+					}
+				}
+			
+			if (!defined $new_dir)
+				{
+				if (defined $new_component)
+					{
+					$new_dir = $component_dirs{$new_component};
+					}
+				else
+					{
+					$new_dir = "os/unref/$current_dir";
+					$new_dir =~ s/common\/generic/comgen/;
+					$new_dir =~ s/common\/techview/comtv/;
+					$new_dir =~ s/common\/testtools/comtt/;
+					$new_dir =~ s/common\/connectqi/comqi/;
+					$new_dir =~ s/common\/developerlibrary/devlib/;
+					$new_dir =~ s/cedar\/generic/cedgen/;
+					}
+				$primary = $mrp;
+				}
+			
+			# Update the mrp attribute
+			
+			substr($mrp,0,length($current_dir)) = $new_dir;
+			# $child->setAttribute("mrp",$mrp);
+			
+			# update the bldFile attribute, if any
+			my $bldFile = $child->getAttribute("bldFile");
+			if ($bldFile)
+				{
+				$bldFile =~ s/\\/\//g;	# ensure that / separators are used
+				$child->setAttribute("bldFile",$bldFile);
+				$hasbldfile{$current_dir} = 1;
+				my $saved_bldFile = $bldFile;
+				$bldFile .= "/" if ($bldFile !~ /\/$/);	# add trailing /
+				my $previous = substr($bldFile,0,length($current_dir),$new_dir);
+				if ($previous ne $current_dir)
+					{
+					print "*** $old_component bldFile=$saved_bldFile not in $current_dir\n";
+					}
+				else
+					{
+					$bldFile =~ s/\/+$//;	# remove trailing /
+					# $child->setAttribute("bldFile",$bldFile);
+					}
+				} 
+			
+			add_to_branchspec($current_dir, $new_dir, $primary);
+
+			if ($set_peer_directory)
+				{
+				# peer mapping implied by our mapping
+				my $peer = $peers{$current_dir};
+				$new_dir =~ s/[^\/]+\/$//;
+				$peer =~ m/([^\/]+\/)$/;
+				$new_dir .= $1;
+				print "Implied mapping $peer to $new_dir to be next to $mrp\n";
+				add_to_branchspec($peer, $new_dir, "$mrp (peer)");
+				}
+
+			next;
+			}
+		my $name = $child->getAttribute("name");
+		$partnames{$tagname} = $name;
+		match_names($child);
+		}
+	}
+
+foreach my $missing (sort keys %component_object)
+	{
+	print "No mapping found for Symbian-derived component $missing\n";
+	}
+
+# Output Perforce branchspec, taking care to "subtract" the
+# places where a subtree is branched to a different place
+
+my $from = "//epoc/release/9.4";
+my $to = "//epoc/development/personal/williamro/seaside/31";
+my %processed;
+
+printf "\n\n========== branchspec with %d elements\n", scalar keys %branchspec;
+
+foreach my $olddir (sort keys %branchspec)
+	{
+	my $comment = $hasbldfile{$olddir} ? "" : "\t# src";
+	
+	my $subtraction = "";
+	my @parts = split /\//, $olddir;
+	my $root = "";
+	while (@parts)
+		{
+		my $part = shift @parts;
+		$root .= "$part/";
+		if (defined $processed{$root})
+			{
+			# Found a containing tree
+			my $remainder = join("/",@parts);
+			$subtraction = sprintf "\t-$from/%s%s/... $to/%s%s/...\n",
+				$root, $remainder, $branchspec{$root}, $remainder;
+			# continue in case there is a containing sub-subtree.
+			}
+		}
+	print $subtraction;	# usually empty
+	printf "\t$from/%s... $to/%s...%s\n", $olddir, $branchspec{$olddir},$comment;
+	$processed{$olddir} = 1;
+	}
+
+exit(0);
+
+# Report on the accuracy of Schedule 12
+print STDERR "\n";
+my @allnames = ();
+my $unmatched = 0;
+foreach my $name (sort keys %sch12refs)
+	{
+	next if (defined $modelnames{$name});
+	push @allnames, "$name\t(Sch12 $foundationrefs{$name})\n";
+	print STDERR "No match for $name (associated with $foundationrefs{$name})\n";
+	$unmatched += 1;
+	}
+if ($unmatched == 0)
+	{
+	print STDERR "All Schedule 12 entries matched in System Model\n";
+	}
+else
+	{
+	printf STDERR "%d Schedule 12 entry references not matched (from a total of %d)\n", $unmatched, scalar keys %sch12refs; 
+	}
+
+# Remove the matched elements to leave the unmatched parts,
+# and accumulate the MRP files for each Sch12 component
+
+my %sch12bymrp;
+my %locationbymrp;
+
+sub list_mrps($$$);		# declare the prototype for recursive call
+sub list_mrps($$$)
+	{
+	my ($node,$location,$foundationname) = @_;
+	my @children = $node->getChildNodes;
+	my $nodename = $node->getAttribute("name");
+
+	my $sublocation = $nodename;
+	$sublocation = "$location/$nodename" if ($location ne "");
+	
+	foreach my $child (@children)
+		{
+		if ($child->getNodeTypeName ne "ELEMENT_NODE")
+			{
+			# text and comments don't count
+			next;
+			}
+		my $tagname = $child->getTagName;
+		if ($tagname eq "unit" || $tagname eq "package" || $tagname eq "prebuilt")
+			{
+			# these elements have the mrp information, but no substructure
+			my $mrp = $child->getAttribute("mrp");
+			$mrp = $1 if ($mrp =~ /\\([^\\]+)\.mrp$/i);
+			$foundationbymrp{$mrp} = $foundationname;
+			$locationbymrp{$mrp} = "$location\t$nodename";
+			next;
+			}
+		my $submatch = $child->getAttribute("MATCHED");
+		if ($submatch)
+			{
+			list_mrps($child,$sublocation,$submatch);
+			}
+		else
+			{
+			list_mrps($child,$sublocation,$foundationname);
+			}
+		}
+	}
+
+sub delete_matched($$);		# declare the prototype for recursive call
+sub delete_matched($$)
+	{
+	my ($node, $location) = @_;
+	my $nodename = $node->getAttribute("name");
+
+	my $sublocation = $nodename;
+	$sublocation = "$location/$nodename" if ($location ne "");
+
+	my @children = $node->getChildNodes;
+	return 0 if (scalar @children == 0);
+	my $now_empty = 1;
+	foreach my $child (@children)
+		{
+		if ($child->getNodeTypeName ne "ELEMENT_NODE")
+			{
+			# text and comments don't count
+			next;
+			}
+		my $foundationname = $child->getAttribute("MATCHED");
+		if ($foundationname)
+			{
+			list_mrps($child, $sublocation, $foundationname);
+			$node->removeChild($child) if ($remove);
+			}
+		else
+			{
+			if (delete_matched($child,$sublocation) == 1)
+				{
+				# Child was empty and can be removed
+				$node->removeChild($child) if ($remove);
+				}
+			else
+				{
+				list_mrps($child, $sublocation, "*UNREFERENCED*");
+				$now_empty = 0;		# something left in due to this child
+				}
+			}
+		}
+	return $now_empty;
+	}
+
+# scan the tagged model, recording various details as a side-effect
+
+my $allgone = delete_matched($model,"");
+
+if ($cbrmappingfile ne "")
+	{
+	$componenttype{"*UNREFERENCED*"} = "??";
+	open CBRMAP, ">$cbrmappingfile" or die("Unable to write to $cbrmappingfile: $!\n");
+	foreach my $mrp (sort keys %sch12bymrp)
+		{
+		my $component = $foundationbymrp{$mrp};
+		my $comptype = $componenttype{$component};
+		my $location = $locationbymrp{$mrp};
+		print CBRMAP "$mrp\t$location\t$component\t$comptype\n";
+		}
+	close CBRMAP;
+	print STDERR "MRP -> Schedule 12 mapping written to $cbrmappingfile\n";
+	}
+
+exit 0;