' ***************************************************************
' WARNING: This script is supplied "as-is" and has not been fully tested.
' This is *NOT* a standard script supplied with Rose and so has not
' been tested as part of any Rose release
'
' This Rosescript lists out the packages every class in the model
' depends on.  This list is placed in the Rosescript "Viewport".
' A progress bar is displayed to indicate the number of classes left
' to check.
'
' A class is considered to depend on the package if the class has
' a relationship with another class in that package.  The relationships
' checked are:
'
' Associations
' Aggregations
' Dependencies
' Inheritance
'
' Restrictions:
' 0) This script was built using Rational Rose/C++ v4.0.5.  It may
'    not work with earlier or later releases
' 1) The script may generate a run-time error if CheckModel fails as
'    it assumes that each class refered to is loaded and exists in
'    the model.
' 2) You must have all the units loaded (if using a model with units)
' 3) The script will not list all the dependent packages if the
'    dependency crosses nested packages
' 4) The lists are not sorted in any way
' 5) We assume the maximum number of packages related to any one class
'    is controlled by the constant MaxNumberOfRelatedPackages
'    If this limit is exceeded, a runtime error will occur
'
' Copyright (c) !997, Anthony Kesterton, Rational Software Corporation
' ajk@rational.com
' 
'
' ***************************************************************
' Crucial constants
Const MaxNumberOfRelatedPackages = 100 
' ***************************************************************

' *************	Function FindStringInList *************************
' Returns the position of a given string "theString" in "theList".
' A length "theLength" - the length of the list - must be supplied
' 0 is returned if no match is found
' *****************************************************************
Function FindStringInList (theString As String, theList() As String, theLength As Integer) As Integer
	For theStringID = 1 to theLength
		if theList(theStringID) = theString then
			FindStringInList = theStringID
			Exit Function
		end if
	Next theStringID

	FindStringInList = 0 ' Not found

End Function

' *************	Function GetNameOfDependencyPackage ***************
' Returns the name of the package of the given dependency 
' relationship. 
' *****************************************************************
Function GetNameOfDependencyPackage (theClass As Class, theDependency As UsesRelation) As String
	if theDependency.SupplierClass.ParentCategory.Name <> theClass.ParentCategory.Name then
		GetNameOfDependencyPackage = theDependency.SupplierClass.ParentCategory.Name
		Exit Function
	end if	
	GetNameOfDependencyPackage = ""
End Function

' *************	Function GetNameOfAssociationPackage **************
' Returns the name of the package of class in the given association 
' relationship
' *****************************************************************
Function GetNameOfAssociationPackage (theClass As Class, theAssociation As Association) As String
	Dim theRole1 As Role
	Dim theRole2 As Role
	Dim theRole1Class As Class
	Dim theRole2Class As Class

	Set theRole1 = theAssociation.Role1
	Set theRole2 = theAssociation.Role2

	Set theRole1Class = theRole1.Class
	Set theRole2Class = theRole2.Class

	If theRole1Class.ParentCategory.Name <> theRole2Class.ParentCategory.Name then
		if theRole1Class.ParentCategory.Name <> theClass.ParentCategory.Name then
			GetNameOfAssociationPackage = theRole1Class.ParentCategory.Name
			Exit Function
		else
			GetNameOfAssociationPackage = theRole2Class.ParentCategory.Name
			Exit Function
		end if 
	end if
	GetNameOfAssociationPackage = ""
End Function

' *************	Function GetNameOfInheritancePackage ***************
' Returns the name of the package of the class in the inheritance 
' relationship
' *****************************************************************
Function GetNameOfInheritancePackage (theClass As Class, theSuperClass As Class) As String
	if theSuperClass.ParentCategory.Name <> theClass.ParentCategory.Name then
		GetNameOfInheritancePackage = theSuperClass.ParentCategory.Name	
		Exit Function
	end if
	' Package is the same as this class
	GetNameOfInheritancePackage = ""			
End Function


' *************	Function GetNameOfAggregationPackage ***************
' Returns the name of the package of the class in the aggregation 
' relationship
' *****************************************************************
Function GetNameOfAggregationPackage (theClass As Class, theHasRelationship As HasRelationship) As String
	Dim theContainedClass As Class

	Set theContainedClass = theHasRelationship.SupplierClass

	if theContainedClass.ParentCategory.Name <> theClass.ParentCategory.Name then
		GetNameOfAggregationPackage = theContainedClass.ParentCategory.Name
		Exit Function	
	end if

	' Package is the same as this class
	GetNameOfAggregationPackage = ""
End Function

' ************ Function FindRelatedPackages *************************
' Given a class - places the names of packages with connections to that
' class in an array called thePackageNames, and returns the number of names
' in the array.  
' Don't repeat package names in the list
' *******************************************************************
Function FindRelatedPackages(theClass As Class, thePackageNames() As String) As Integer
	Dim theName As String

	Dim myCounter As Integer
	myCounter = 1	 ' Initialise counter

	' Check every relationship between the class and return
	' the name of the package of the related package if it 
	' differs from the package that owns this class.
	
	' Check associations
	For myIndex = 1 to theClass.GetAssociations.Count
		Dim myAssociation As Association
		Set myAssociation = theClass.GetAssociations.GetAt(myIndex)
		theName = GetNameOfAssociationPackage (theClass, myAssociation)
		if theName <> "" AND FindStringInList(theName, thePackageNames, myCounter) < 1 then
			thePackageNames(myCounter) = theName
			myCounter = myCounter + 1
		end if
	Next myIndex

	' Check dependencies
	For DependencyID = 1 to theClass.GetUsesRelations.Count
		Dim theDependencyRelation As UsesRelation
		Set theDependencyRelation = theClass.GetUsesRelations.GetAt(DependencyID)

		theName = GetNameOfDependencyPackage (theClass, theDependencyRelation)
		if theName <> "" AND FindStringInList(theName, thePackageNames, myCounter) < 1 then
			thePackageNames(myCounter) = theName
			myCounter = myCounter + 1
		end if
	Next DependencyID

	' Check inheritance
	for myInheritID = 1 to theClass.GetSuperClasses.Count
		Dim mySuperClass As Class
		Set mySuperClass = theClass.GetSuperClasses.GetAt(myInheritID)
		theName = GetNameOfInheritancePackage (theClass, mySuperClass)
		if theName <> "" AND FindStringInList(theName, thePackageNames, myCounter) < 1 then
			thePackageNames(myCounter) = theName
			myCounter = myCounter + 1
		end if
	Next myInheritID

	' Check aggregations
	Dim theHasRelationships As HasRelationshipCollection

	Set theHasRelationships = theClass.GetHasRelations

	for HasID = 1 to theHasRelationships.Count
		Dim myHasRelationship As HasRelationship
		Set myHasRelationship = theHasRelationships.GetAt(HasID)
		theName = GetNameOfAggregationPackage (theClass, myHasRelationship)
		if theName <> "" AND FindStringInList(theName, thePackageNames, myCounter) < 1 then
			thePackageNames(myCounter) = theName
			myCounter = myCounter + 1
		end if
	Next HasID

	'thePackageNames(myCounter) = theClass.ParentCategory.Name
	'myCounter = myCounter+1

	' Finalise counter
	FindRelatedPackages = myCounter - 1
End Function

' ************** Function FindClassInCollectionByName *******************
' For a given class and a ClassCollection - find the first occurance
' of the name of the class - and return the index of the class in the
' Collection
' *******************************************************************
Function FindClassInCollectionByName (theClasses As ClassCollection, theName As String) As Integer
	Dim theClass As Class
	
	For ClassID = 1 to theClasses.Count
		if theClasses.GetAt(ClassID).Name = theName then
			FindClassInCollectionByName = ClassID
			Exit Function
		end if
	Next ClassID
	FindClassInCollectionByName = 0	
End Function

' *****************************************************************
Sub Main
	Dim MyModel As Model
	Dim ClassNames(RoseApp.CurrentModel.GetAllClasses.Count) As String
	Dim AllClasses As ClassCollection
	Dim NameIndex As Integer   ' Index on the list of class names
	Dim CurrentClass As Class  ' Class we are working on
	Dim theIndex As Integer
	Dim thePackageNames(MaxNumberOfRelatedPackages) As String
	Dim theNumberOfPackages As Integer


	Set MyModel = RoseApp.CurrentModel
	Set AllClasses = MyModel.GetAllClasses

	NameIndex = 1 ' Count of number of classes in ClassNames, initialize to 1

	' First - get all the class names in the model, ignoring Actors

	For ClassID = 1 to AllClasses.Count
		If AllClasses.GetAt(ClassID).Stereotype <> "Actor" then
			' Add the name to the array of class names
		 	ClassNames(NameIndex) = AllClasses.GetAt(ClassID).Name
			' Set array of class names pointer to next item
			NameIndex = NameIndex + 1
		end if
	Next ClassID

	' NameIndex is now too big by 1 so reduce it.
	NameIndex = NameIndex - 1

	' Sort the names in alphabetic order
	' NOT IMPLEMENTED

	' Basic algorithm
	' Go through each name in the sorted list of class names.
	' Find the class in the list of all classes
	' Create a list of names of packages that are connected to that
	' class	- adding only packages that are not the same as the
	' current class
	' If the list of packages contains anything,
	'	Sort the list of packages (NOT IMPLEMENTED)
	' 	Print out the class name
	' 	Print out the list of related packages
	' 

	' Initialize the Viewport for printing results.
	Viewport.Open
	Viewport.Clear

	' Create a progress indicator

	'On Error Goto ErrorTrap
	Msg.Open "Checking dependent package for each class",0,True,True

 	theIndex = 0
	theNumberOfPackages = 0

	print "Checking " & NameIndex & " Classes"
	print ""
	For ClassNameID = 1 to NameIndex
		Msg.Thermometer = (ClassNameID/NameIndex)*100
		
		theIndex = FindClassInCollectionByName (AllClasses, ClassNames(ClassNameID))
		if theIndex > 0 then
			theNumberOfPackages = FindRelatedPackages(AllClasses.GetAt(theIndex),thePackageNames)
			if theNumberOfPackages > 0 then
 				' Sort package names
				' Sort NOT implemented

				' Print out the class name
				print AllClasses.GetAt(theIndex).Name & " depends on: "
				' Print the names of all the packages
				For thePackageNameIndex = 1 to theNumberOfPackages
					print thePackageNames(thePackageNameIndex)
				Next thePackageNameIndex
				print ""
			end if			
		end if
	Next ClassNameID

	Msg.Close
'Exit Sub

'ErrorTrap:
'	If Err = 809 Then
'		MsgBox "Checking for dependent packages cancelled by user"
'		Exit Sub				'Reset error handler.
'	End If
'
End Sub