deprecated/buildtools/buildsystemtools/validate_sch12_model.pl
author Bob Rosenberg <bob.rosenberg@nokia.com>
Mon, 18 Oct 2010 10:33:54 +0100
changeset 660 66ff3e731c60
parent 655 3f65fd25dfd4
permissions -rw-r--r--
Sysdeftools additional support for merging misordered system definitions. More extensive validation. Minor bug fixes. Bash wrappers for perl scripts for unix installs.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
655
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     1
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     2
# Copyright (c) 2009 Nokia Corporation and/or its subsidiary(-ies).
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     3
# All rights reserved.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     4
# This component and the accompanying materials are made available
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     5
# under the terms of "Eclipse Public License v1.0"
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     6
# which accompanies this distribution, and is available
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     7
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     8
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     9
# Initial Contributors:
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    10
# Nokia Corporation - initial contribution.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    11
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    12
# Contributors:
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    13
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    14
# Description: 
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    15
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    16
#! perl
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    17
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    18
# Read a Schedule12 file and check the system_model items
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    19
# against a supplied System_Definition.xml
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    20
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    21
use strict;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    22
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    23
use FindBin;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    24
use lib ".";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    25
use lib "./lib";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    26
use lib "$FindBin::Bin";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    27
use lib "$FindBin::Bin/lib";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    28
use XML::DOM;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    29
use XML::DOM::ValParser;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    30
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    31
# produces the "Use of uninitialized value in concatenation (.) or string" warning
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    32
use XML::XQL;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    33
use XML::XQL::DOM;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    34
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    35
# Read the command line to get the filenames
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    36
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    37
sub Usage($)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    38
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    39
	my ($reason) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    40
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    41
	print "Usage: $reason\n" if ($reason);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    42
	print <<USAGE_EOF;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    43
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    44
Usage: validate_sch12_model.pl <params> [options]
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    45
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    46
params:
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    47
-s <schedule12>     XML version of Schedule 12
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    48
-m <system_model>   XML version of System Model
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    49
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    50
options:
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    51
-o <whats_left>     XML file showing unreferenced
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    52
                       parts of the System Model
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    53
-r                  Remove matched objects from -o output
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    54
-c <cbr_mapping>    Tab separated file showing the Schedule 12
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    55
                       component for each MRP file
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    56
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    57
USAGE_EOF
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    58
	exit(1);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    59
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    60
	
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    61
use Getopt::Long;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    62
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    63
my $schedule12file = "Symbian_OS_v9.1_Schedule12.xml";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    64
my $systemmodelfile = "System_Definition.xml";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    65
my $whatsleftfile = "";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    66
my $remove = 0;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    67
my $cbrmappingfile = "";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    68
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    69
Usage("Bad arguments") unless GetOptions(
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    70
  	's=s' => \$schedule12file, 
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    71
  	'm=s' => \$systemmodelfile,
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    72
  	'o=s' => \$whatsleftfile,
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    73
  	'r'   => \$remove,
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    74
  	'c=s' => \$cbrmappingfile);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    75
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    76
Usage("Too many arguments") if (scalar @ARGV > 0);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    77
Usage("Cannot find $schedule12file") if (!-f $schedule12file);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    78
Usage("Cannot find $systemmodelfile") if (!-f $systemmodelfile);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    79
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    80
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    81
# Don't print info messages
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    82
sub my_fail
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    83
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    84
	my $code = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    85
	if ($code < 300)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    86
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    87
		XML::Checker::print_error ($code, @_);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    88
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    89
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    90
$XML::Checker::FAIL = \&my_fail;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    91
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    92
# Load the XML documents
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    93
my %expat_options = 
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    94
	(
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    95
	KeepCDATA => 1, 
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    96
    Handlers => [],
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    97
    );
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    98
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    99
my $xmlParser = new XML::DOM::ValParser(%expat_options); 
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   100
XML::DOM::ignoreReadOnly(1);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   101
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   102
my $sch12path = ".";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   103
my $modelpath = ".";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   104
$sch12path = $1 if ($schedule12file  =~ /^(.+)\\[^\\]+$/);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   105
$modelpath = $1 if ($systemmodelfile =~ /^(.+)\\[^\\]+$/);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   106
$xmlParser->set_sgml_search_path($sch12path, $modelpath);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   107
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   108
my $modelXML = $xmlParser->parsefile ($systemmodelfile);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   109
my $sch12XML = $xmlParser->parsefile ($schedule12file);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   110
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   111
# Collect the Schedule12 entries, checking for duplicates
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   112
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   113
my %sch12refs;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   114
my %componenttype;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   115
my ($sch12) = $sch12XML->getElementsByTagName("Schedule12");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   116
Usage("No <Schedule12> in $schedule12file ?") if (!defined $sch12);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   117
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   118
my @children = $sch12->getChildNodes;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   119
foreach my $child (@children)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   120
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   121
	next if ($child->getNodeTypeName ne "ELEMENT_NODE");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   122
	my $tagname = $child->getTagName;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   123
	next if ($tagname eq "footnote");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   124
	my $component = $child->getAttribute("name");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   125
	$componenttype{$component} = $tagname;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   126
	
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   127
	my @entries = $child->getElementsByTagName("system_model");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   128
	if (scalar @entries == 0)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   129
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   130
		print STDERR "No system_model entries in $component\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   131
		next;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   132
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   133
		
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   134
	foreach my $entry (@entries)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   135
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   136
		my $name = $entry->getAttribute("entry");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   137
		if (defined $sch12refs{$name})
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   138
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   139
			print STDERR "$name occurs in $sch12refs{$name} and $component\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   140
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   141
		else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   142
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   143
			$sch12refs{$name} = $component;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   144
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   145
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   146
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   147
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   148
# Find the Schedule12 entries in the XML file
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   149
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   150
my %modelnames;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   151
sub match_names($);		# declare the prototype for recursive call
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   152
sub match_names($)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   153
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   154
	my ($node) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   155
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   156
	my @children = $node->getChildNodes;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   157
	foreach my $child (@children)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   158
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   159
		if ($child->getNodeTypeName ne "ELEMENT_NODE")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   160
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   161
			# text and comments don't count
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   162
			next;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   163
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   164
		my $tagname = $child->getTagName;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   165
		if ($tagname eq "unit")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   166
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   167
			# units are detail inside the model, so they don't count
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   168
			next;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   169
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   170
		my $name = $child->getAttribute("name");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   171
		if ($name)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   172
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   173
			if (defined $modelnames{$name})
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   174
				{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   175
				print STDERR "Name $name occurs more than once in the System Model\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   176
				}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   177
			$modelnames{$name} = $tagname;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   178
			
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   179
			if (defined $sch12refs{$name})
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   180
				{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   181
				$child->setAttribute("MATCHED", $sch12refs{$name});
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   182
				$modelnames{$name} = "1";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   183
				}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   184
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   185
		match_names($child);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   186
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   187
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   188
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   189
my ($model) = $modelXML->getElementsByTagName("systemModel");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   190
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   191
match_names($model);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   192
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   193
# Report on the accuracy of Schedule 12
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   194
print STDERR "\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   195
my @allnames = ();
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   196
my $unmatched = 0;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   197
foreach my $name (sort keys %sch12refs)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   198
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   199
	next if (defined $modelnames{$name});
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   200
	push @allnames, "$name\t(Sch12 $sch12refs{$name})\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   201
	print STDERR "No match for $name (associated with $sch12refs{$name})\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   202
	$unmatched += 1;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   203
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   204
if ($unmatched == 0)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   205
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   206
	print STDERR "All Schedule 12 entries matched in System Model\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   207
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   208
else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   209
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   210
	printf STDERR "%d Schedule 12 entry references not matched (from a total of %d)\n", $unmatched, scalar keys %sch12refs; 
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   211
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   212
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   213
# Remove the matched elements to leave the unmatched parts,
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   214
# and accumulate the MRP files for each Sch12 component
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   215
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   216
my %sch12bymrp;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   217
my %locationbymrp;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   218
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   219
sub list_mrps($$$);		# declare the prototype for recursive call
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   220
sub list_mrps($$$)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   221
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   222
	my ($node,$location,$sch12name) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   223
	my @children = $node->getChildNodes;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   224
	my $nodename = $node->getAttribute("name");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   225
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   226
	my $sublocation = $nodename;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   227
	$sublocation = "$location/$nodename" if ($location ne "");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   228
	
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   229
	foreach my $child (@children)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   230
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   231
		if ($child->getNodeTypeName ne "ELEMENT_NODE")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   232
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   233
			# text and comments don't count
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   234
			next;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   235
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   236
		my $tagname = $child->getTagName;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   237
		if ($tagname eq "unit" || $tagname eq "package" || $tagname eq "prebuilt")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   238
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   239
			# these elements have the mrp information, but no substructure
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   240
			my $mrp = $child->getAttribute("mrp");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   241
			$mrp = $1 if ($mrp =~ /\\([^\\]+)\.mrp$/i);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   242
			$sch12bymrp{$mrp} = $sch12name;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   243
			$locationbymrp{$mrp} = "$location\t$nodename";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   244
			next;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   245
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   246
		my $submatch = $child->getAttribute("MATCHED");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   247
		if ($submatch)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   248
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   249
			list_mrps($child,$sublocation,$submatch);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   250
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   251
		else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   252
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   253
			list_mrps($child,$sublocation,$sch12name);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   254
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   255
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   256
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   257
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   258
sub delete_matched($$);		# declare the prototype for recursive call
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   259
sub delete_matched($$)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   260
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   261
	my ($node, $location) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   262
	my $nodename = $node->getAttribute("name");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   263
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   264
	my $sublocation = $nodename;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   265
	$sublocation = "$location/$nodename" if ($location ne "");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   266
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   267
	my @children = $node->getChildNodes;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   268
	return 0 if (scalar @children == 0);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   269
	my $now_empty = 1;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   270
	foreach my $child (@children)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   271
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   272
		if ($child->getNodeTypeName ne "ELEMENT_NODE")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   273
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   274
			# text and comments don't count
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   275
			next;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   276
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   277
		my $sch12name = $child->getAttribute("MATCHED");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   278
		if ($sch12name)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   279
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   280
			list_mrps($child, $sublocation, $sch12name);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   281
			$node->removeChild($child) if ($remove);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   282
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   283
		else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   284
			{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   285
			if (delete_matched($child,$sublocation) == 1)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   286
				{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   287
				# Child was empty and can be removed
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   288
				$node->removeChild($child) if ($remove);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   289
				}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   290
			else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   291
				{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   292
				list_mrps($child, $sublocation, "*UNREFERENCED*");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   293
				$now_empty = 0;		# something left in due to this child
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   294
				}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   295
			}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   296
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   297
	return $now_empty;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   298
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   299
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   300
# scan the tagged model, recording various details as a side-effect
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   301
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   302
my $allgone = delete_matched($model,"");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   303
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   304
if ($whatsleftfile ne "")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   305
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   306
	if ($allgone)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   307
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   308
		print STDERR "System Model is completely covered by Schedule 12\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   309
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   310
	else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   311
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   312
		$modelXML->normalize;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   313
		$modelXML->printToFile($whatsleftfile);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   314
		print STDERR "Remains of System Model written to $whatsleftfile\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   315
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   316
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   317
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   318
if ($cbrmappingfile ne "")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   319
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   320
	$componenttype{"*UNREFERENCED*"} = "??";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   321
	open CBRMAP, ">$cbrmappingfile" or die("Unable to write to $cbrmappingfile: $!\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   322
	foreach my $mrp (sort keys %sch12bymrp)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   323
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   324
		my $component = $sch12bymrp{$mrp};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   325
		my $comptype = $componenttype{$component};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   326
		my $location = $locationbymrp{$mrp};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   327
		print CBRMAP "$mrp\t$location\t$component\t$comptype\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   328
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   329
	close CBRMAP;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   330
	print STDERR "MRP -> Schedule 12 mapping written to $cbrmappingfile\n";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   331
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   332
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   333
exit 0;