# Copyright (c) 2010 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:

# Script to validate the unit links in a system definition or package definition XML file

#!/usr/bin/perl

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

my %defines;

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

my $realloc;

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

GetOptions

	(

	'path=s' => $path,

	 'effective-sysdef=s' => \$realloc

	);

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

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

#	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.

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

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

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

($#ARGV == -1 ) && &help();

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

$realloc = $realloc || $sysdef;

my %unitmap;

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

my @p2=reverse(split(/[\\\/]/,$realloc));

shift(@p1);shift(@p2); # don't care abt file name

while(lc($p1[0]) eq lc($p2[0])) {shift(@p1);shift(@p2)}

$unitmap{join('/',reverse(@p1))} = join("/",reverse(@p2));

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

my @p2=reverse(split(/[\\\/]/,$realloc));

shift(@p1);shift(@p2); # don't care abt file name

while(lc($p1[0]) eq lc($p2[0]) && scalar(@p1)) {shift(@p1);shift(@p2)}

$unitmap{join('/',reverse(@p1))} = join("/",reverse(@p2));

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

eval {

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

};

if(!$sysdefdoc) {

	die "ERROR: could not open $sysdef\n";

}

my $maxschema = $sysdefdoc->getDocumentElement()->getAttribute('schema');	# don't check value, just store it.

my $docroot =  $sysdefdoc->getDocumentElement;

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

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

	{

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

	}

$docroot->setAttribute('schema',$maxschema);	# output has the largest syntax version of all includes

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

	{

	$pre ne '' || next ;

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

	}

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

sub abspath

	{ 	# normalize the path into an absolute one

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

	$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 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 rootMapMeta {

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

	my $node = shift;

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

			{

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

				{

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

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

				$rootmap{$from} = $to;

				}

			}

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

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

	}

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)$/ )

		{

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

		if($link)

			{

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

			if(-e $file)

				{

				&combineLink($node,$file);

				}

			else

				{

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

				$node->removeAttribute('href');

				}

			return;

			}

		}

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

		{

		}

	elsif($tag eq 'unit')

		{

		my %at = &atts($node);

		my $pro;

		foreach my $o (keys(%at)) 

			{

			if($o eq 'proFile' || $o=~/:proFile$/)

				{

				$pro = $at{$o};

				last;

				}

			}

		my $filter=$node->getParentNode()->getAttribute('filter');

		if($filter ne '' && $at{'filter'}) {$filter.=','.$at{'filter'}}

		elsif($at{'filter'}) {$filter=$at{'filter'}}

		if($filter ne '') {$filter="\t($filter)"}

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

			{

			my $ext;

			my $link= $at{$atr};

			if($atr eq 'bldFile') {

				$ext = ($pro ne '') ? "/$pro" : '/bld.inf'

			}

			if($link ne '')

				{

				my $ok = 0;

				my $trylink;

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

					{

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

					$ok = (-e "$link$ext");

					if(!$ok)	

						{

						foreach my $a (keys %rootmap)

							{

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

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

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

							}

						}

					}

				if(!$ok)

					{

					foreach my $a (keys %unitmap) {

						if($a eq substr($link,0,length($a))) {

							$trylink = $unitmap{$a}.substr($link,length($a));

							if(-e "$trylink$ext") {

								$ok=1;

								$link = $trylink;

								last;

							}

						}

					}

					}

				if(!$ok)

					{

					print "Error: $atr not found in ",($trylink ne '') ? $trylink : $link,"$filter\n";

					}				

				}

			}

		}

	elsif($tag eq 'meta')

		{

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

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

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

		if ($link ne '' ) 

			{ 

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

				{

				print  "Note: Remote URL $link not validated\n";

				next; # do not alter children

				}

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

				{

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

				}

			if(! -e $link) 

				{

				if(! -e &realPath($link)) {

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

				}

				next; # do not alter children

				}

			}

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

			{# need to process this now

			&rootMapMeta($node);

			}

		return;

		}

	else {return}

	my $checkversion=0;

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

		{

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

		&walk($file,$item);

		}

	}

sub realPath

	{

	my $link = shift;

	foreach my $a (keys %unitmap)

		{

		if($a eq substr($link,0,length($a))) 

			{

			my $trylink = $unitmap{$a}.substr($link,length($a));

			if(-e $trylink) {return $trylink}

			}

		}

	}

sub combineLink

	{

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

	my $node = shift;

	my $file = shift;

	my $getfromfile = &localfile($file);

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

	my $doc;

	eval {

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

	};

	if(!$doc) {

		print "ERROR: could not open $getfromfile\n";

		return;

	}

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

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

	my @upid = &getNamespaceAndValue($node,'id');

	my @downid = &getNamespaceAndValue($item,'id');

	(($upid[0] eq $downid[0]) && ($upid[1] eq $downid[1]))  || die "$upid[1] ($upid[0]) differs from $downid[1] ($downid[0]) ";	# make sure the link is valid

	&walk($getfromfile,$item);

	}

sub copyInto

	{

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

	my $parent=shift;

	my $item = shift;

	my $doc = $parent->getOwnerDocument;

	my $type = $item->getNodeType;

	my $new;

	if($type==1) 

		{

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

		my %down = &atts($item);

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

			{

			if($down{$ordered})

				{

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

				delete $down{$ordered}

				}

			}

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

			{

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

			}

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

			{

			&copyInto($new,$child);

			}

		}

	elsif($type==3) 

		{

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

		}

	elsif($type==8) 

		{

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

		}

	if($new)

		{

		$parent->appendChild($new);

		}

	}

sub getNamespaceAndValue

	{

	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

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

		}

	else

		{

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

			$defaultns;

		}

	return ($ns,$id);;

	}

sub getNs

	{

	# find the namespace 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 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 resolvePath

	{

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

	my $base = shift;

	my $path = shift;

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

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

	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

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

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

	}

sub resolveURI

	{

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

	my $base = shift;

	my $path = shift;

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

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

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

	}

sub localfile

	{

	my $file = shift;

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

	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

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

		{

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

		return;  # return empty string if not supported.

		} 

	return $file

	}