Option Explicit

Dim myModel As Model


' This script parses the Logical View for the categories
' and their classes and changes Has Relationships into attributes.
' Written by Zbigniew Babiej, Rational Software.


Sub ProcessTheHasRelation(myHas As HasRelationship, MyClass As Class)

    Dim myContainment   As String
    Dim myExportControl As String
    Dim myStatic        As Boolean
	Dim myName          As String
	Dim myAttrib        As Attribute
	Dim res             As Integer
	Dim mySupplier      As RoseItem
	Dim MySupplierName  As String

	' Get Has Relation attributes
    myContainment      =  myHas.Containment
    myExportControl	   =  myHas.ExportControl
    myStatic           =  myHas.Static
	myName             =  myHas.Name

	' Get Supplier Name
    Set mySupplier     =  MyHas.GetSupplier()
	MySupplierName     =  mySupplier.Name


	' If Has Relation has no name
	If myName = "" Then
	  myName = MySupplierName
	End If

    ' Diplay prompt
	If MsgBox("Do you want change '" + myClass.Name + " " + myName + " " + MySupplierName + "' Has Relationship into attribute ?", ebYesNo, "Has Relatioship to attribute converter") = ebYes Then
	   Set myAttrib = myClass.AddAttribute (myName, MySupplierName, "")
	   If myAttrib Is Not Nothing Then
	     ' Copy Has Relation attributes into Attribute attributes
	     myAttrib.Containment   = myContainment
         myAttrib.ExportControl = myExportControl
		 myAttrib.Static = myStatic
		 ' Delete Has Relation
		 If myClass.DeleteHas(myHas) Then
		   MsgBox  myClass.Name + " " + myName + " " + mySupplierName + " was succesfully converted"
		 End If
	   End If
	End If
	
End Sub


Sub ProcessTheClass(myClass As Class)

	Dim theHasRelations As HasRelationshipCollection
	Dim MyHasRelation   As HasRelationship
    Dim i, imax As Integer

	'Diplay the current class
	Print , "--- " + myClass.Name

 	Set theHasRelations = myClass.GetHasRelations
	imax = theHasRelations.Count


	For i = imax To 1 Step -1
	  	 ProcessTheHasRelation	 theHasRelations.GetAt(i), myClass
	Next

	
End Sub



Sub ProcessTheCategory(myCategory As Category)

    Dim CategoryClasses As ClassCollection
 	Dim ChildCategories As CategoryCollection

	Dim i, imax As Integer

	'Diplay the current category
	Print , myCategory.Name

    ' Get all classes belonging to this package	and process them
	Set CategoryClasses = myCategory.Classes

	' Get the upper bound of the category classes collection
	imax = CategoryClasses.Count

	' Go through all classes
	For i = 1 To imax
	  ProcessTheClass(CategoryClasses.GetAt(i))
 	Next i

	' Get all categories belonging to this package and process them
	Set ChildCategories = MyCategory.Categories

   ' Get the upper bound of the child categories collection
    imax = ChildCategories.Count

	' Go through all child categories
	For i = 1 To imax
	  ProcessTheCategory(ChildCategories.GetAt(i))
 	Next i


 End Sub



' Main routine

Sub Main

    Dim RootPackage As Category

	'Init the output
    Viewport.Open
	ViewPort.Clear

	'Set up the model
	Set myModel = RoseApp.CurrentModel

	'Get Logical View reference
	Set RootPackage  = myModel.RootCategory

	'Process the packages in recursive way
    ProcessTheCategory(RootPackage)

End Sub