1 # Copyright (c) 2010 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 #!/usr/bin/perl

    16 

    17 use strict;

    18 

    19 

    20 use FindBin;		# for FindBin::Bin

    21 use lib $FindBin::Bin;

    22 use lib "$FindBin::Bin/lib";

    23 

    24 use Cwd;

    25 use Cwd 'abs_path';

    26 use Getopt::Long;

    27 use File::Basename;

    28 use File::Spec;

    29 use XML::DOM;

    30 

    31 my $output;

    32 my $path;

    33 my $config;

    34 my @includes;

    35 my %defineParams;

    36 my %defines;

    37 my $defaultns = 'http://www.symbian.org/system-definition';	# needed if no DTD

    38 

    39 my @newarg;

    40 foreach my $a (@ARGV)

    41 	{ #extract all -I parameters from the parameter list 

    42 	if($a=~s/^-I//)

    43 		{

    44 		push(@includes,$a);

    45 		}

    46 	else

    47 		{

    48 		push(@newarg,$a);

    49 		}

    50 	}

    51 @ARGV=@newarg;

    52 

    53 # need to add options for controlling which metas are filtered out and which are included inline

    54 GetOptions

    55 	(

    56 	 'path=s' => \$path,

    57 	'output=s' => \$output,

    58 	'config=s' => \$config

    59 	);

    60 

    61 # -path specifies the full system-model path to the file which is being processed. 

    62 #	This must be an absolute path if you're processing a root sysdef.

    63 #	If processing a pkgdef file, you can use "./package_definition.xml" to leave all links relative. Though I can't really see the use case for this.

    64 

    65 # -output specifies the file to save the output to. If not specified this will write to stdout

    66 

    67 # -config specifies the name of an .hrh file in which the configuration data is acquired from. If not set, no confguration will be done.

    68 

    69 # -I[path] specifies the include paths to use when resolving #includes in the .hrh file. Same syntax as cpp command uses. Any number of these can be provided.

    70 

    71 

    72 # if config is not set, no confguration will be done.

    73 # If it is set, all configuration metadata will be processed and stripped from the output, even if the confguration data is empty

    74 

    75  if($path eq '') {$path = '/os/deviceplatformrelease/foundation_system/system_model/system_definition.xml'}

    76 

    77 

    78 my $sysdef = &abspath(shift);	# resolve the location of the root sysdef

    79 

    80 

    81 

    82 # rootmap is a mapping from the filesystem to the paths in the doc

    83 my %rootmap = &rootMap($path,$sysdef);	

    84 my %nsmap;

    85 my %urimap;

    86 

    87 if($config ne '') 

    88 	{ # run cpp to get all #defines

    89 	&getDefines($config);

    90 	}

    91 

    92 my $parser = new XML::DOM::Parser;

    93 my   $sysdefdoc = $parser->parsefile ($sysdef);

    94 

    95 

    96 # find all the namespaces used in all trhe fragments and use that 

    97 # to set the namespaces ni the root element of the created doc

    98 #   should be able to optimise by only parsing each doc once and 

    99 #	maybe skipping the contends of <meta>

   100 my @nslist = &namespaces($sysdef,$sysdefdoc->getDocumentElement());

   101 

   102 

   103 while(@nslist)

   104 	{

   105 	my $uri = shift(@nslist);

   106 	my $prefix =shift(@nslist);

   107 	if($prefix eq 'id namespace'){$prefix=''}

   108 	if(defined $urimap{$uri}) {next} # already done this uri

   109 	$urimap{$uri} = $prefix;

   110 	if($nsmap{$prefix})

   111 		{ # need a new prefix for this, guess from the URI (for readability)

   112 		if($uri=~/http:\/\/(www\.)?([^.\/]+)\./) {$prefix = $2}

   113 		my $i=0;

   114 		while($nsmap{$prefix})

   115 			{ # still no prefix, just make up 

   116 			$prefix="ns$i";

   117 			$i++;

   118 			# next line not really necessary, but it's a good safety to stop infinite loops

   119 			$i eq 1000 && die "cannot create namespace prefix for $uri";

   120 			}

   121 		}

   122 	$nsmap{$prefix}=$uri;

   123 	}

   124 

   125 my $docroot =  $sysdefdoc->getDocumentElement;

   126 

   127 my $ns = $docroot->getAttribute('id-namespace');

   128 if(!$ns && $nsmap{''})

   129 	{

   130 	$docroot->setAttribute('id-namespace',$nsmap{''});

   131 	}

   132 while(my($pre,$uri) = each(%nsmap))

   133 	{

   134 	$pre ne '' || next ;

   135 	$docroot->setAttribute("xmlns:$pre",$uri);

   136 	}

   137 

   138 &walk($sysdef,$docroot);	# process the XML

   139 

   140 

   141 # print to file or stdout

   142 if($output eq '') 

   143 	{

   144 	print $sysdefdoc->toString;

   145 	}

   146 else

   147 	{

   148 	$sysdefdoc->printToFile($output);

   149 	}

   150 

   151  

   152 sub abspath

   153 	{ 	# normalize the path into an absolute one

   154 	my  ($name,$path) = fileparse($_[0]);

   155 	$path=~tr,\\,/,;

   156 	if( -e $path)

   157 		{

   158 		return abs_path($path)."/$name";

   159 		}

   160 	my @dir = split('/',$_[0]);

   161 	my @new;

   162 	foreach my $d (@dir)

   163 		{

   164 		if($d eq '.') {next}

   165 		if($d eq '..')

   166 			{

   167 			pop(@new);

   168 			next;

   169 			}

   170 		push(@new,$d)

   171 		}

   172 	return join('/',@new);

   173 	}

   174 

   175 sub rootMap {

   176 	my @pathdirs = split(/\//,$_[0]);

   177 	my @rootdirs = split(/\//,$_[1]);

   178 

   179 	while(lc($rootdirs[$#rootdirs])  eq lc($pathdirs[$#pathdirs])  )

   180 		{

   181 		pop(@rootdirs);

   182 		pop(@pathdirs);

   183 		}

   184 	return (join('/',@rootdirs)  => join('/',@pathdirs) );

   185 	}

   186 

   187 sub rootMapMeta {

   188 	# find all the explict path mapping from the link-mapping metadata

   189 	my $node = shift;

   190 	foreach my $child (@{$node->getChildNodes})

   191 			{

   192 			if ($child->getNodeType==1 && $child->getTagName eq 'map-prefix')

   193 				{

   194 				my $from = $child->getAttribute('link');

   195 				my $to = $child->getAttribute('to');		# optional, but blank if not set

   196 				$rootmap{$from} = $to;

   197 				}

   198 			}

   199 	# once this is processed we have no more need for it. Remove from output

   200 	$node->getParentNode->removeChild($node);

   201 	}

   202 

   203 

   204 sub walk

   205 	{ 	# walk through the doc, resolving all links

   206 	my $file = shift;

   207 	my $node = shift;

   208 	my $type = $node->getNodeType;

   209 	if($type!=1) {return}

   210 	my $tag = $node->getTagName;

   211 	if($tag=~/^(layer|package|collection|component)$/ )

   212 		{

   213 		if($file eq $sysdef)

   214 			{

   215 			&fixIDs($node);	# normalise all IDs in the root doc. Child docs are handled elsewhere.

   216 			}

   217 		my $link= $node->getAttribute('href');

   218 		if($link)

   219 			{

   220 			my $file = &resolvePath($file,$link); 

   221 			if(-e $file)

   222 				{

   223 				&combineLink($node,&resolveURI($file,$link));

   224 				}

   225 			else

   226 				{

   227 				print STDERR "Note: $file not found\n";

   228 				}

   229 			return;

   230 			}

   231 		}

   232 	elsif($tag=~/^(SystemDefinition|systemModel)$/ )

   233 		{

   234 		}

   235 	elsif($tag eq 'unit')

   236 		{

   237 		foreach my $atr ('bldFile','mrp','base','proFile')

   238 			{

   239 			my $link= $node->getAttribute($atr);

   240 			if($link && !($link=~/^\//))

   241 				{

   242 				$link= &abspath(File::Basename::dirname($file)."/$link");

   243 				foreach my $a (keys %rootmap) {

   244 					$link=~s,^$a,$rootmap{$a},ie;

   245 				}

   246 				# remove leading ./  which is used to indicate that paths should remain relative

   247 				$link=~s,^\./([^/]),$1,; 

   248 				$node->setAttribute($atr,$link);

   249 				}

   250 			}

   251 		}

   252 	elsif($tag eq 'meta')

   253 		{

   254 		my $link= $node->getAttribute('href');

   255 		$link=~s,^file://(/([a-z]:/))?,$2,; # convert file URI to absolute path

   256 		if ($link ne '' ) 

   257 			{ 

   258 			if($link=~/^[\/]+:/)

   259 				{

   260 				print STDERR "Note: Remote URL $link not embedded\n";

   261 				next; # do not alter children

   262 				}

   263 			if(! ($link=~/^\//))

   264 				{

   265 				$link= &abspath(File::Basename::dirname($file)."/$link");

   266 				}

   267 			if(! -e $link) 

   268 				{

   269 				print STDERR "Warning: Local metadata file not found: $link\n";

   270 				next; # do not alter children

   271 				}

   272 			# if we're here we can just embed the file

   273 			# no processing logic is done! It's just embedded blindly

   274 			my  $metadoc = $parser->parsefile ($file);

   275 			my $item =&firstElement($metadoc->getDocumentElement);

   276 			if(!$item)

   277 				{

   278 				print STDERR "Warning: Could not process metadata file: $link\n";

   279 				next; # do not alter children

   280 				}

   281 			$node->removeAttribute('href');

   282 			foreach my $child (@{$item->getChildNodes})

   283 				{

   284 				&blindCopyInto($node,$child);

   285 				next;

   286 				}

   287 			}

   288 		if($node->getAttribute('rel') eq 'link-mapping')

   289 			{# need to process this now

   290 			&rootMapMeta($node);

   291 			}

   292 		return;

   293 		}

   294 	else {return}

   295 	my $checkversion=0;

   296 	foreach my $item (@{$node->getChildNodes})

   297 		{

   298 		#print $item->getNodeType,"\n";

   299 		&walk($file,$item);

   300 		$checkversion = $checkversion  || ($tag eq 'component' &&  $item->getNodeType==1 && $item->getAttribute('version') ne '');

   301 		}

   302 

   303 	if($checkversion && $config ne '')

   304 		{ # need to check the conf metadata on the units in this component

   305 		&doCmpConfig($node);

   306 		}

   307 	foreach my $item (@{$node->getChildNodes})

   308 		{

   309 		if ($item->getNodeType==1 && $item->getTagName eq 'meta')

   310 			{

   311 			&processMeta($item);

   312 			}

   313 		}

   314 	}

   315 

   316 

   317 sub combineLink

   318 	{

   319 	# combine data from linked sysdef fragment w/ equivalent element in parent document

   320 	my $node = shift;

   321 	my $file = shift;

   322 	my $getfromfile = &localfile($file);

   323 	$getfromfile eq '' && return;  # already raised warning, no need to repeat

   324 	my  $doc = $parser->parsefile ($getfromfile);

   325 	my $item =&firstElement($doc->getDocumentElement);

   326 	$item || die "badly formatted $file";

   327 	&fixIDs($item);

   328 	my %up = &atts($node);

   329 	my %down = &atts($item);

   330 	$up{'id'} eq $down{'id'}  || die "$up{id} differs from $down{id}";

   331 	$node->removeAttribute('href');

   332 	foreach my $v (keys %up) {delete $down{$v}}

   333 	foreach my $v (keys %down)

   334 		{

   335 		$node->setAttribute($v,$down{$v})

   336 		}

   337 	foreach my $child (@{$item->getChildNodes})

   338 		{

   339 		&copyInto($node,$child);

   340 		}

   341 	&walk($file,$node);

   342 	}

   343 

   344 

   345 sub blindCopyInto

   346 	{

   347 	# make a deep copy the node (2nd arg) into the element (1st arg)

   348 	my $parent=shift;

   349 	my $item = shift;

   350 	my $doc = $parent->getOwnerDocument;

   351 	my $type = $item->getNodeType;

   352 	my $new;

   353 	if($type==1) 

   354 		{

   355 		$new = $doc->createElement($item->getTagName);

   356 		my %down = &atts($item);

   357 		while(my($a,$b) = each(%down))

   358 			{

   359 			$new->setAttribute($a,$b);

   360 			}

   361 		foreach my $child (@{$item->getChildNodes})

   362 			{

   363 			&blindCopyInto($new,$child);

   364 			}

   365 		}

   366 	elsif($type==3) 

   367 		{

   368 		$new = $doc->createTextNode ($item->getData);

   369 		}

   370 	elsif($type==8) 

   371 		{

   372 		$new = $doc->createComment  ($item->getData);

   373 		}

   374 	if($new)

   375 		{

   376 		$parent->appendChild($new);

   377 		}

   378 	}

   379 

   380 sub copyInto

   381 	{

   382 	# make a deep copy the node (2nd arg) into the element (1st arg)

   383 	my $parent=shift;

   384 	my $item = shift;

   385 	my $doc = $parent->getOwnerDocument;

   386 	my $type = $item->getNodeType;

   387 	my $new;

   388 	if($type==1) 

   389 		{

   390 		&fixIDs($item);

   391 		$new = $doc->createElement($item->getTagName);

   392 		my %down = &atts($item);

   393 		foreach my $ordered ('id','name','bldFile','mrp','level','levels','introduced','deprecated','filter')

   394 			{

   395 			if($down{$ordered})

   396 				{

   397 				$new->setAttribute($ordered,$down{$ordered});

   398 				delete $down{$ordered}

   399 				}

   400 			}

   401 		while(my($a,$b) = each(%down))

   402 			{

   403 			$new->setAttribute($a,$b);

   404 			}

   405 		foreach my $child (@{$item->getChildNodes})

   406 			{

   407 			&copyInto($new,$child);

   408 			}

   409 		}

   410 	elsif($type==3) 

   411 		{

   412 		$new = $doc->createTextNode ($item->getData);

   413 		}

   414 	elsif($type==8) 

   415 		{

   416 		$new = $doc->createComment  ($item->getData);

   417 		}

   418 	if($new)

   419 		{

   420 		$parent->appendChild($new);

   421 		}

   422 	}

   423 

   424 sub getNs

   425 	{

   426 	# find the namespace URI that applies to the specified prefix.

   427 	my $node = shift;

   428 	my $pre = shift;

   429 	my $uri = $node->getAttribute("xmlns:$pre");

   430 	if($uri) {return $uri}

   431 	my $parent = $node->getParentNode;

   432 	if($parent && $parent->getNodeType==1)

   433 		{

   434 		return getNs($parent,$pre);

   435 		}

   436 	}

   437 

   438 

   439 sub fixIDs

   440 	{

   441 	# translate the ID to use the root doc's namespaces 

   442 	my $node = shift;

   443 	foreach my $id ('id','before')

   444 		{

   445 		&fixID($node,$id);

   446 		}

   447 }

   448 

   449 sub fixID

   450 	{

   451 	# translate the ID to use the root doc's namespaces 

   452 	my $node = shift;

   453 	my $attr = shift || 'id';

   454 	my $id = $node->getAttribute($attr);

   455 	if($id eq '') {return}

   456 	my $ns;

   457 	if($id=~s/^(.*)://)

   458 		{ # it's got a ns, find out what it is

   459 		my $pre = $1;

   460 		$ns=&getNs($node,$pre);

   461 		}

   462 	else

   463 		{

   464 		$ns = $node->getOwnerDocument->getDocumentElement->getAttribute("id-namespace") ||

   465 			$defaultns;

   466 		}

   467 	$ns = $urimap{$ns};

   468 	$id = ($ns eq '') ? $id : "$ns:$id";

   469 	return $node->setAttribute($attr,$id);

   470 }

   471 

   472 sub firstElement {

   473 	# return the first element in this node

   474 	my $node = shift;

   475 	foreach my $item (@{$node->getChildNodes}) {

   476 		if($item->getNodeType==1) {return $item}

   477 	}

   478 }

   479 

   480 

   481 sub atts {

   482 	# return a hash of all attribtues defined for this element

   483 	my $node = shift;

   484 	my %at = $node->getAttributes;

   485 	my %list;

   486 	foreach my $a (keys %{$node->getAttributes}) 

   487 		{

   488 		if($a ne '')

   489 			{

   490 			$list{$a} = $node->getAttribute ($a);

   491 			}

   492 		}

   493 	return %list;

   494 }

   495 

   496 

   497 sub ns 

   498 	{

   499 	# return a hash of ns prefix and uri -- the xmlns: part is stripped off

   500 	my $node = shift;

   501 	my %list;

   502 	foreach my $a (keys %{$node->getAttributes}) 

   503 		{

   504 		my $pre = $a;

   505 		if($pre=~s/^xmlns://)

   506 			{

   507 			$list{$pre} = $node->getAttribute ($a);

   508 			}

   509 		}

   510 	return %list;

   511 	}

   512 

   513 

   514 sub resolvePath

   515 	{

   516 	# return full path to 2nd arg relative to first (path or absolute URI)

   517 	my $base = shift;

   518 	my $path = shift;

   519 	if($path=~m,^/,) {return $path } # path is absolute, but has no drive. Let OS deal with it.

   520 	if($path=~s,^file:///([a-zA-Z]:/),$1,) {return $path } # file URI with drive letter

   521 	if($path=~m,^file://,) {return $path } # file URI with no drive letter (unit-style). Just pass on as is with leading / and let OS deal with it

   522 	if($path=~m,^[a-z0-9][a-z0-9]+:,i) {return $path } # absolute URI -- no idea how to handle, so just return

   523 	return &abspath(File::Basename::dirname($base)."/$path");

   524 	}

   525 

   526 

   527 sub resolveURI

   528 	{

   529 	# return full path to 2nd arg relative to first (path or absolute URI)

   530 	my $base = shift;

   531 	my $path = shift;

   532 	if($path=~m,[a-z0-9][a-z0-9]+:,i) {return $path } # absolute URI -- just return

   533 	if($path=~m,^/,) {return $path } # path is absolute, but has no drive. Let OS deal with it.

   534 	return &abspath(File::Basename::dirname($base)."/$path");

   535 	}

   536 

   537 sub localfile

   538 	{

   539 	my $file = shift;

   540 	if($file=~s,file:///([a-zA-Z]:/),$1,) {return $file } # file URI with drive letter

   541 	if($file=~m,file://,) {return $file } # file URI with no drive letter (unit-style). Just pass on as is with leading / and let OS deal with it

   542 	if($file=~m,^([a-z0-9][a-z0-9]+):,i)

   543 		{

   544 		print STDERR "ERROR: $1 scheme not supported\n";

   545 		return;  # return empty string if not supported.

   546 		} 

   547 	return $file

   548 	}

   549 

   550 sub namespaces

   551 	{

   552 	# return a list of namespace URI / prefix pairs, in the order they're defined

   553 	# these need to be used to define namespaces in the root element

   554 	my $file = shift;

   555 	my $node = shift;

   556 	my $type = $node->getNodeType;

   557 	if($type!=1) {return}

   558 	my $tag = $node->getTagName;

   559 	my @res;

   560 	my %nslist = &ns($node);

   561 	while(my($pre,$uri)=each(%nslist))

   562 		{ # push all namespaces defined here onto the list

   563 		push(@res,$uri,$pre);

   564 		}

   565 	if($tag=~/^(layer|package|collection|component)$/ )

   566 		{ # these have the potential of linking, so check for that

   567 		my $link= $node->getAttribute('href');

   568 		if($link)

   569 			{

   570 			$link=&resolvePath($file,$link);

   571 			if(-e $link)

   572 				{

   573 				my  $doc = $parser->parsefile ($link);

   574 				my @docns = &namespaces($link,$doc->getDocumentElement);

   575 				undef $doc;

   576 				return (@res,@docns);

   577 				#ignore any children nodes if this is a link

   578 				}

   579 			print STDERR "Note: $link not found\n";

   580 			}

   581 		}

   582 	elsif($tag eq 'SystemDefinition' )

   583 		{

   584 		my $default = $node->getAttribute('id-namespace');

   585 		if($default)

   586 			{# mangle with a space so it's clear it's not a qname

   587 			push(@res,$default,'id namespace');

   588 			}

   589 		}

   590 	foreach my $item (@{$node->getChildNodes})

   591 		{

   592 		push(@res,&namespaces($file,$item));

   593 		}

   594 	return @res;

   595 	}

   596 

   597 sub processMeta

   598 	{ # acts upon any known <meta> and strips it from the output if it's used

   599 	my $metanode = shift;

   600 

   601 	my $rel = $metanode->getAttribute('rel') || 'Generic';

   602 	if($rel eq 'config' && $config ne '')

   603 		{ # only process if there is something to configure

   604 		&doconfig($metanode);

   605 		}

   606 	else 

   607 		{

   608 		# do nothing. Not supported yet

   609 		}

   610 	}

   611 

   612 sub doCmpConfig

   613 	{ # configure in or out the units in a component

   614 	my $cmp = shift;	# the component node

   615 	my @unversioned;	# list of all units with no version attribute (if more than one, they should all have filters defined)

   616 	my %versioned;		# hash table of all units with a specified version, it's a fatal error to hav the same verison twice in one component

   617 	foreach my $item (@{$cmp->getChildNodes})

   618 		{ # populate %versioned and @unversioned to save processsing later

   619 		if($item->getNodeType==1 && $item->getTagName eq 'unit')

   620 			{

   621 			my $ver = $item->getAttribute('version');

   622 			if($ver eq '') {push(@unversioned,$item)}

   623 			else

   624 				{

   625 				defined $versioned{$ver}  && die "Cannot have more than one unit with version $ver in the same component ".$cmp->getAttribute('id');

   626 				$versioned{$ver}=$item;

   627 				}

   628 			}

   629 		}

   630 	my @picks = &getMetaConfigPick($cmp); # the list, in order, of all <pick> elements that affect this component

   631 	foreach my $pick (@picks)

   632 		{

   633 		my $ver = $pick->getAttribute('version');

   634 		if(!$versioned{$ver})

   635 			{

   636 			print STDERR "ERROR: Reference to invalid unit version $ver in component ",$cmp->getAttribute('id'),". Ignoring.\n";

   637 			return;

   638 			}

   639 		if(&definedMatches($pick))

   640 			{ # remove all other units;

   641 			delete $versioned{$ver}; # to avoid removing in loop

   642 			foreach my $unit (@unversioned, values(%versioned))

   643 				{

   644 				$cmp->removeChild($unit);

   645 				print STDERR "Note: unit ",$unit->getAttribute('version')," in component " ,$cmp->getAttribute('id')," configured out\n";

   646 				}

   647 			last; # done. No more processing after first match

   648 			}

   649 		else

   650 			{ # remove this unit and continue

   651 			$cmp->removeChild($versioned{$ver});

   652 			print STDERR "Note: unit $ver in component " ,$cmp->getAttribute('id')," configured out\n";

   653 			delete $versioned{$ver}; # gone, don't process anymore;

   654 			}

   655 		}

   656 	if (scalar(@unversioned, values(%versioned)) > 1)

   657 		{

   658 		print STDERR "Warning: component ",$cmp->getAttribute('id')," has more than one unit after configuration\n";

   659 		}

   660 	}

   661 

   662 	

   663 sub getMetaConfigPick

   664 	{	# return an array of all <pick> elements that affect the specified element

   665 	my $node = shift;

   666 	my @pick;

   667 	while($node->getParentNode->getNodeType==1)

   668 		{

   669 		foreach my $item (@{$node->getChildNodes})

   670 			{

   671 			my @picks;

   672 			if($item->getNodeType==1 &&  $item->getAttribute('rel') eq 'config') 

   673 				{ # it's conf metadata

   674 				foreach my $p (@{$item->getChildNodes})

   675 					{

   676 					if($p->getNodeType==1 &&  $p->getTagName eq 'pick') {push(@picks,$p)}

   677 					}

   678 				}

   679 			@pick=(@picks,@pick); # prepend this to the start;

   680 			}

   681 		$node=$node->getParentNode;

   682 		}

   683 	return @pick;

   684 	}

   685 

   686 sub definedMatches

   687 	{ # process all <defined> and <not-defined> the specified element and return true or false if the combination matches

   688 	my $node  = shift;

   689 	my $match = 1;

   690 	foreach my $def (@{$node->getChildNodes})

   691 		{

   692 		if($def->getNodeType == 1) 

   693 			{

   694 			my $tag = $def->getTagName;

   695 			if($tag eq 'defined' or $tag eq 'not-defined')

   696 				{

   697 				my $var = $def->getAttribute('condition') || die "Must have condition set on all $tag elements";

   698 				$defineParams{$var} && die "Cannot use a macro with parameters as a feature flag: $var(".$defineParams{$var}->[0].")"; 

   699 				$match = $match &&  (($tag eq 'defined') ? defined($defines{$var}) : ! defined($defines{$var}));

   700 				}

   701 			}

   702 		}

   703 		return $match;

   704 	}

   705 

   706 sub doconfig

   707 	{ # confgure in or out a system model item that owns the specified <meta>, remove the <meta> when done.

   708 	my $meta  = shift;

   709 	my $keep = definedMatches($meta);

   710 	my $parent = $meta->getParentNode;

   711 	if(!$keep)

   712 		{

   713 		print STDERR "Note: ",$parent->getTagName," " ,$parent->getAttribute('id')," configured out\n";

   714 		$parent->getParentNode->removeChild($parent);

   715 		return; # it's removed, so there's nothing else we can possibly do

   716 		}

   717 

   718 	$parent->removeChild($meta);

   719 	}

   720 

   721 sub getDefines

   722 	{ # populate the list of #defines from a specified .hrh file.

   723 	my $file = shift;

   724 	my $inc;

   725 	foreach my $i (@includes)

   726 		{

   727 		$inc.=" -I$i";

   728 		}

   729 	open(CPP,"cpp -dD$inc \"$file\"|");

   730 	while(<CPP>)

   731 		{

   732 		if(!/\S/){next} # skip blank lines

   733 		if(/^# [0-9]+ /) {next} # don't care about these

   734 		s/\s+$//;

   735 		if(s/^#define\s+(\S+)\((.*?)\)\s+//)

   736 			{ #parametered define

   737 			push(@{$defineParams{$1}},@2,$_);

   738 			}

   739 		elsif(s/^#define\s+(\S+)//)

   740 			{ # normal define

   741 			my $def = $1;

   742 			s/^\s+//;

   743 			$defines{$1}=$_;

   744 			}

   745 		else {die "cannot process $_";}

   746 		}

   747 	close CPP;

   748 	}