use strict;

use FindBin;		# for FindBin::Bin

use lib $FindBin::Bin;

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

use Cwd;

use Cwd 'abs_path';

use Getopt::Long;

use File::Basename;

use File::Spec;

use XML::DOM;

my $output;

my $path;

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

my @searchpaths;

my @searchroots;

my %additional;

my %add;

my %newNs;

my $warning = "Error";

my $placeholders=0;

my @tdOrder =("hb","se", "lo","dc", "vc" , "pr", "dm", "de", "mm", "ma" , "ui",  "rt", "to" );

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

GetOptions

	(

	 'path=s' => \$path,

	'output=s' => \$output,

	'w=s' => \$warning,

	'root=s' => \@searchroots,

	'glob=s' => \@searchpaths,

	'placeholders=s' => \$placeholders

	);

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

if(!($warning =~/^(Note|Warning|Error)$/)) {$warning="Error"}

# path is the system model path of the processed sysdef file. This is only used when creating a stand-alone sysdef as the output

# output specifies the file this is saved in. If specified, all (relative) paths will be modified to be relative to it. If not, all paths will be absolute

# w is the warning level: Note, Warning or Error.

# root = -root g:\sf

# glob = -glob "\*\*\package_definition.xml"

#rootsysdef.pl -root F:\dev\personal\sftest\sf\mcl  -glob "\*\*\package_definition.xml"  -output ..\..\..\deviceplatformrelease\nokia_system\system_definition.sf.xml  ..\..\..\deviceplatformrelease\foundation_system\system_model\system_definition.xml

my %replacefile;

my $dir;

foreach(@searchpaths)

	{

	my $ndir = shift(@searchroots);

	if($ndir ne '') {$dir=$ndir}

	foreach my $file (glob "$dir$_")

		{

		my $map =substr($file,length($dir));

		$map=~tr/\\/\//;

		$additional{$map}=$file;

		$replacefile{&abspath($file)}=$map;

		$add{&abspath($file)}=1;

		}

	}

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

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

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

my %nsmap;

my %urimap;

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

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

my $mapmeta;

my $modpath;

if($output eq '')

	{ #figure out mapping path

	my @fspath = split(/[\\\/]/,$sysdef);

	my @smpath = split(/[\\\/]/,$path);

	while(lc($smpath[$#smpath]) eq lc($fspath[$#fspath] )) {

		pop(@smpath);

		pop(@fspath);

	}

	my $mappath = join('/',@fspath);

	my $topath = join('/',@smpath);

	$mappath=~s,^/?,file:///,;

	$mapmeta = $sysdefdoc->createElement('meta');

	$mapmeta->setAttribute('rel','link-mapping');

	my $node = $sysdefdoc->createElement('map-prefix');

	$node->setAttribute('link',$mappath);

	$topath ne '' && $node->setAttribute('to',$topath);

	$mapmeta->appendChild($node);

	}

else

	{

	$modpath = &relativeTo(&abspath($output), $sysdef);

	}

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

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

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

#	maybe skipping the contends of <meta>

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

my %replacing;

my %newContainer;

my %foundDescendants;

foreach(keys %add)

	{

	my   $fragment = $parser->parsefile ($_);

	my $fdoc = $fragment->getDocumentElement();

	my $topmost =&firstElement($fdoc);

	my $type = $topmost->getTagName;

	my $id = $topmost->getAttribute('id');

	my ($localid,$ns) = &idns($topmost,$id);	

	my @path = &guessIdInPath($localid,$_);

	if($type eq 'layer') {@path=@path[0]}

	elsif($type eq 'package')  {@path=@path[0..1]}

	elsif($type eq 'collection')  {@path=@path[0..2]}

	elsif($type eq 'component')  {@path=@path[0..3]}

	@path = reverse(@path);

	$add{$_}=join('/',@path)." $localid $ns";

	$replacing{$type}->{"$localid $ns"} = $_;

	# keys with a space are namespaced and fully identified, and contain the filename as the content.

	# keys with no space have unknown namespace and contain a hash of the content

	$newContainer{join('/',@path[0..$#path-1])}->{"$localid $ns"} = $_;

	for(my $i=-1;$i<$#path-1;$i++)

		{

		$foundDescendants{$path[$i+1]}=1;

		$newContainer{join('/',@path[0..$i])}->{$path[$i+1]}=1;

		}

	}

while(@nslist)

	{

	my $uri = shift(@nslist);

	my $prefix =shift(@nslist);

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

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

	$urimap{$uri} = $prefix;

	if($nsmap{$prefix})

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

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

		my $i=0;

		while($nsmap{$prefix})

			{ # still no prefix, just make up 

			$prefix="ns$i";

			$i++;

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

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

			}

		}

	$nsmap{$prefix}=$uri;

	}

my $docroot =  $sysdefdoc->getDocumentElement;

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

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

	{

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

	}

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

	{

	$pre ne '' || next ;

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

	}

&walk($sysdef,$docroot);

if($output eq '') 

	{

	print $sysdefdoc->toString;

	}

else

	{

	$sysdefdoc->printToFile($output);

	}

sub abspath

	{

	# normalize the path into an absolute one

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

	if($path eq '' && $name eq '') {return};

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

	if( -e $path)

		{

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

		}

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

	my @new;

	foreach my $d (@dir)

		{

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

		if($d eq '..')

			{

			pop(@new);

			next;

			}

		push(@new,$d)

		}

	return join('/',@new);

	}

sub normpath

	{

	# normalize the path 

	my @norm;

	foreach my $dir(split(/[\\\/]/,shift)) {

		if($dir eq '.') {next}

		if($dir eq '..')

			{

			if($#norm == -1 || $norm[$#norm] eq '..')

				{ # keep  as is

				push(@norm,$dir);

				}

			elsif($#norm == 0 && $norm[0] eq '')

				{  # path begins with /, interpret /.. as just / -- ie toss out

				next

				}

			else

				{

				pop(@norm);

				}

			}

		else

			{

			push(@norm,$dir);

			}

	}

	return join('/',@norm)

	}

sub rootMap {

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

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

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

		{

		pop(@rootdirs);

		pop(@pathdirs);

		}

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

	}

sub replacedBy

	{ # can only check once. Destroys data

	my $node = shift;

	my $fullid= join(' ',&idns($node));

	my $type =  $node->getTagName;

	my $repl = $replacing{$type}->{$fullid};

	delete $replacing{$type}->{$fullid};

	return $repl;

	}

sub walk

	{

	#' walk through the doc, resolving all links

	my $file = shift;

	my $node = shift;

	my $type = $node->getNodeType;

	if($type!=1) {return}

	my $tag = $node->getTagName;

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

		{

		if($file eq $sysdef)

			{

			&fixIDs($node);	# normalise all IDs in the root doc.

			}

		my $override = &replacedBy($node);

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

		if($override eq '' )

			{

			my ($id,$ns)=&idns($node);

			if($foundDescendants{$id})

				{ # keep this node, it'll be populated by what we found

				if($link)

					{

					$node->removeAttribute('href');

					}

				}

			elsif($link || !$placeholders)

				{ # not going to be used, remove

				$node->getParentNode->removeChild($node) ; # not present, remove

				return;

				}

			}

		else

			{	

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

			my $ppath =  join('/',&parentPath($node->getParentNode));

			delete $newContainer{$ppath}->{join(' ',&idns($node))};		# remove this from list of things which need to be added

			if(&resolvePath($file,$href) ne $override)

				{ # file has changed, update

				print STDERR "$warning: Replacing $tag ",$node->getAttribute('id')," with $override\n";

				&setHref($node,$override);

				return;

				}

			}

		my @curpath = &parentPath($node);

		my $curitem = $curpath[$#curpath];

		my $curp = join('/',@curpath[0..$#curpath-1]);

		delete $newContainer{$curp}->{$curitem};

		if($link)

			{

			foreach my $child (@{$node->getChildNodes}) {$node->removeChild($child)} # can't have children

			&fixHref($node,$file);

			return;

			}

		}

	elsif($tag eq 'systemModel' && $mapmeta)

		{ # need absolute paths for all links

		$node->insertBefore ($mapmeta,$node->getFirstChild);

		}

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

		{

		}

	elsif($tag eq 'unit')

		{

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

			{

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

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

				{

				if($mapmeta)

					{ # use absolute paths

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

					foreach my $a (keys %rootmap)

						{

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

						}

					}

				else

					{ # modified relative path 

					$link = &normpath($modpath.$link);

					}

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

				}

			}

		}

	elsif($tag eq 'meta')

		{

		&fixHref($node,$file);

		&processMeta($node);

		next;

		}

	else {return}

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

		{

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

		&walk($file,$item);

		}

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

		{ # check for appending

		my $ppath =  join('/',&parentPath($node));

		if($newContainer{$ppath}) {

			foreach my $item (sort keys %{$newContainer{$ppath}})

				{

				&appendNewItem($node,$item,$newContainer{$ppath}->{$item});

				}

			}

		}

	}

sub getNs

	{

	# find the ns URI that applies to the specified prefix.

	my $node = shift;

	my $pre = shift;

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

	if($uri) {return $uri}

	my $parent = $node->getParentNode;

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

		{

		return getNs($parent,$pre);

		}

	}

sub fixIDs

	{

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

	my $node = shift;

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

		{

		&fixID($node,$id);

		}

}

sub idns

	{ # return the namespace of an ID

	my $node = shift;

	my $id = shift;

	if($id eq '' ) {$id = $node->getAttribute('id'); }

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

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

		my $pre = $1;

		return ($id,&getNs($node,$pre));

		}

		return ($id,$node->getOwnerDocument->getDocumentElement->getAttribute("id-namespace") ||	$defaultns);

	}

sub fixID

	{

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

	my $node = shift;

	my $attr = shift || 'id';

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

	if($id eq '') {return}

	my $ns;

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

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

		my $pre = $1;

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

		}

	else

		{

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

			$defaultns;

		}

	$ns = $urimap{$ns};

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

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

}

sub firstElement {

	# return the first element in this node

	my $node = shift;

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

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

	}

}

sub atts {

	# return a hash of all attribtues defined for this element

	my $node = shift;

	my %at = $node->getAttributes;

	my %list;

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

		{

		if($a ne '')

			{

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

			}

		}

	return %list;

}

sub ns 

	{

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

	my $node = shift;

	my %list;

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

		{

		my $pre = $a;

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

			{

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

			}

		}

	return %list;

	}

sub namespaces

	{

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

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

	my $file = shift;

	my $node = shift;

	my $type = $node->getNodeType;

	if($type!=1) {return}

	my $tag = $node->getTagName;

	my @res;

	my %nslist = &ns($node);

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

		{ # push all namespaces defined here onto the list

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

		}

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

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

		}

	elsif($tag eq 'SystemDefinition' )

		{

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

		if($default)

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

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

			}

		}

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

		{

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

		}

	return @res;

	}

sub  processMeta

	{

	my $metanode = shift;

	# do nothing. Not supported yet

	}

sub guessIdInPath

	{

	my $id = shift;

	my @path = reverse(split(/\//,shift));

	while(@path)