'**********************************************************'

'

'ConvertAssociationsToAttributes.ebs

'

'This script creates attributes for navigable roles

'and removes the corresponding associations.

'It assumes that the language is ANSI C++.

'In particular the syntax used by the ANSI C++ addin

'for Complex Roles.

'

'Select on a diagram the classes for which you want 

'to create the attributes and choose

'Apply To... Selected Classes

'Otherwise choose:

'Apply to...  All classes.

'Select among the following types of Roles to transform:

'1. Roles that refer to a <<typedef>>

'2. Roles that refer to an <<anonymous_type>>

'3. Roles that refer to a class with any other stereotype

'For each of them you must  specify if you want to apply 

'the conversion to Static/Non Static attributes

'and with public/protected/private export control.

'

'Inspect the Log for the list of transformed associations

'

'The script does not convert navigable but unnamed roles

'

'When you choose to delete the <<anonymous_types>>, they're 

'deleted only if they took part in one of the deleted

'associations and if they do not have any clients

'after the association has been removed

'

'You cannot first transform the <<anonymous_type>>

'and then delete them. These two actions must be done

'in the same exacution of the script, if you want to be 

'able to delete them

'

'

'**********************************************************'



Option Explicit





Function ConvertDlgProc(ControlName$, Action As Integer, SuppValue As Integer)_

 As Integer

	If Action = 2 Then

		Select Case ControlName$

			Case  "Typedef0"

				DlgValue "Typedef1",SuppValue

				DlgValue "Typedef2", SuppValue

				DlgValue "Typedef3",SuppValue

				DlgValue "StaticTypedef", SuppValue

				DlgValue "NonStaticTypedef", SuppValue

				ConvertDlgProc = 1	'Don't close the dialog box.

			Case  "Anonymous0"

				DlgValue "Anonymous1",SuppValue

				DlgValue "Anonymous2", SuppValue

				DlgValue "Anonymous3",SuppValue

				DlgValue "StaticAnonymous", SuppValue

				DlgValue "NonStaticAnonymous", SuppValue

   				ConvertDlgProc = 1	'Don't close the dialog box.

			Case  "Class0" 

			

				DlgValue "Class1",SuppValue

				DlgValue "Class2", SuppValue

				DlgValue "Class3",SuppValue

				DlgValue "StaticClass", SuppValue

				DlgValue "NonStaticClass", SuppValue

				ConvertDlgProc = 1	'Don't close the dialog box.



			Case "OK"

				'Check input consistency

				Dim TypedefOK ,AnonymousOK, _

                                ClassOK ,DialogCanClose	As Boolean

				Dim TypedefEmpty,AnonymousEmpty, _

                                ClassEmpty As Boolean



				DialogCanClose = True



				TypedefEmpty =DlgValue("Typedef1")=0_

                                And DlgValue("Typedef2")=0_

                                And DlgValue("Typedef3")=0 _

				And DlgValue("StaticTypedef")=0_

                                And DlgValue("NonStaticTypedef")=0

				

			AnonymousEmpty = DlgValue("Anonymous1") =0_

                                And DlgValue("Anonymous2")=0_

                                And DlgValue("Anonymous3")=0 _

                                And DlgValue("StaticAnonymous")=0_

                                And DlgValue("NonStaticAnonymous")=0



				ClassEmpty = DlgValue("Class1") =0_

                                And DlgValue("Class2")=0_

                                And DlgValue("Class3")=0 _

				And DlgValue("StaticClass")=0_

                                And DlgValue("NonStaticClass")=0

				                



				TypedefOK = (DlgValue("Typedef1") =1_

                                Or DlgValue("Typedef2")=1_

                                Or DlgValue("Typedef3")=1)_

				And (DlgValue("StaticTypedef")=1_

                                Or DlgValue("NonStaticTypedef")=1)

				

				AnonymousOK = (DlgValue("Anonymous1") =1_

                                Or DlgValue("Anonymous2")=1 _

                                Or DlgValue("Anonymous3")=1)_

				And(DlgValue("StaticAnonymous")=1 _

                                Or DlgValue("NonStaticAnonymous")=1)

				

				ClassOK = (DlgValue("Class1") =1 _

                                Or DlgValue("Class2")=1 _

                                Or DlgValue("Class3")=1) _

				And(DlgValue("StaticClass")=1_

                                Or DlgValue("NonStaticClass")=1)

	

				If(DlgValue("DeleteAnonymousTypes")=1 ) Then



			If ( AnonymousEmpty Or  Not AnonymousOK)  Then

msgbox "To delete <<anonymous_type>> classes"+ Chr$(13)+Chr$(10)+_

"choose AT LEAST one among: "+Chr$(13)+Chr$(10)+_

"    Public, Private, Protected "+Chr$(13)+Chr$(10)+_

"AND AT LEAST one between: "+Chr$(13)+Chr$(10)+_

"    Static , Non Static "+Chr$(13)+Chr$(10)+_

"for the stereotype <<anonymous_type>>"

					DialogCanClose = False

				End If

				

				Else

			If(Not AnonymousOK And Not AnonymousEmpty) Then

msgbox "Choose AT LEAST one among: "+Chr$(13)+Chr$(10)+_

"    Public, Private, Protected "+Chr$(13)+Chr$(10)+_

"AND AT LEAST one between: "+Chr$(13)+Chr$(10)+_

"    Static , Non Static "+Chr$(13)+Chr$(10)+_

"for the stereotype <<anonymous_type>>"

					DialogCanClose = False

				End If



				End If





			If (Not TypedefOK And Not TypedefEmpty) Then

msgbox "Choose AT LEAST one among: "+Chr$(13)+Chr$(10)+_

"    Public, Private, Protected "+Chr$(13)+Chr$(10)+_

"AND AT LEAST one between: "+Chr$(13)+Chr$(10)+_

"    Static , Non Static "+Chr$(13)+Chr$(10)+_

"for the stereotype <<typedef>> "

					DialogCanClose = False

				End If



			If (Not ClassOK And Not ClassEmpty) Then

msgbox "Choose AT LEAST one among: "+Chr$(13)+Chr$(10)+_

"    Public, Private, Protected "+Chr$(13)+Chr$(10)+_

"AND AT LEAST one between: "+Chr$(13)+Chr$(10)+_

"    Static , Non Static "+Chr$(13)+Chr$(10)+_

"for generic classes "

					DialogCanClose = False

				End If



			If Not (AnonymousOK Or typedefOK Or classok)  Then

msgbox "Choose AT LEAST one among: "+Chr$(13)+Chr$(10)+_

"    Public, Private, Protected "+Chr$(13)+Chr$(10)+_

"AND AT LEAST one between: "+Chr$(13)+Chr$(10)+_

"    Static , Non Static "+Chr$(13)+Chr$(10)+_

"for at least one category (<<typdef>>, <<anonymous_type>>, Class)"



					DialogCanClose = False

				End If

			    If DialogCanClose Then

					ConvertDlgProc = 0

					'Close the	 dialog box.

				Else

					ConvertDlgProc = 1 

					'Keep dialog open

			    End If

			

			Case "Cancel"

				ConvertDlgProc = 0	

				'Close the dialog box.

			Case Else

 				ConvertDlgProc = 1	

				'Don't close the dialog box.

			 			

   		End Select



	End If

End Function



Begin Dialog ConvertDialog ,,380,208, _	 

"Convert Association Roles to Attributes", .ConvertDlgProc

	OKButton 128,160,40,14 ,.OK

	CancelButton 184,160,40,14,.Cancel

	GroupBox 8,4,68,120,"",.GroupBox1

	GroupBox 84,4,156,120,"",.GroupBox2

	GroupBox 248,4,126,120,"",.GroupBox3



	CheckBox 16,14,56,8,"<<typedef>>",.Typedef0

	CheckBox 24,30,47,8,"Public",.Typedef1

	CheckBox 24,46,47,8,"Protected",.Typedef2

	CheckBox 24,62,47,8,"Private",.Typedef3



	CheckBox 92,14,90,8,"<<anonymous_type>>",.Anonymous0

	CheckBox 100,30,47,8,"Public",.Anonymous1

	CheckBox 100,46,47,8,"Protected",.Anonymous2

	CheckBox 100,62,47,8,"Private",.Anonymous3

	

	

	CheckBox 256,14,116,8,"Class with any other stereotype",.Class0

	CheckBox 264,30,47,8,"Public",.Class1

	CheckBox 264,46,47,8,"Protected",.Class2

	CheckBox 264,62,47,8,"Private",.Class3

	

	GroupBox 12,148,92,36,"Apply to ...",.GroupBox4

	OptionGroup .OptionGroup1

		OptionButton 20,160,56,8,"All Classes",.OptionButton1

		OptionButton 20,172,68,8,"Selected Classes",_

		.OptionButton2

	CheckBox 24,76,47,8,"Static",.StaticTypedef

	CheckBox 24,92,47,8,"Non Static",.NonStaticTypedef

	

   	CheckBox 100,76,47,8,"Static",.StaticAnonymous

	CheckBox 100,92,47,8,"Non Static",.NonStaticAnonymous



    	CheckBox 100,108,136,8,_

        "Delete <<anonymous_type>> classes?",.DeleteAnonymousTypes



	

	CheckBox 264,76,47,8,"Static",.StaticClass

	CheckBox 264,92,47,8,"Non Static",.NonStaticClass



End Dialog





Sub ConvertAssociation (theclass As class, _

	theAss As association, theotherrole As role)

	Dim k,i As Integer

	Dim theAtt As attribute



	Dim theother As class

	Set theother = theotherrole.class



	Dim theName As String

	thename = theotherrole.name



	'Take care of complex roles	(role:impl) 

	'to set name and type

	

	Dim therealname As String

	Dim theimplementation As String



	Dim thecolumnpos As Integer



	thecolumnpos = InStr(thename,":")

	If thecolumnpos <> 0 Then

		therealname = Mid(thename,1,thecolumnpos-1)

		theimplementation = Mid(thename,thecolumnpos+1)

	Else

		therealname = thename

		theimplementation = ""

	End If



	Dim Isaggregate As Boolean

	isaggregate = theAss.GetCorrespondingRole _

				  (theClass).aggregate



	Dim theVisibility As String

	theVisibility = theotherrole.ExportControl.Name





	Dim thetype As String

	'If I have an implementation I use it as attribute type

	If theimplementation <> "" Then

		thetype = theimplementation

	'If it is an <<anonymous_type>> I do not have its name

	ElseIf theother.stereotype = "anonymous_type" Then

		

		Dim theIRelColl As InstantiateRelationCollection

		Dim theIRel As InstantiateRelation

		Dim theParametrized As Class



		Set theIRelColl = theOther.GetInstantiateRelations ( )

		Set theIRel =  theIRelColl.getat(1)

		

		Set theParametrized = theIRel.getSupplierClass()



		theType = theParametrized.Name+"<"



		For k = 1 To theOther.Parameters.Count

			theType = theType + _

			theOther.Parameters.getat(k).name

			If theother.Parameters.Count > 1 And _

			k < theOther.Parameters.Count Then

				theType = theType +","

			End If

		Next k



		theType = theType + ">"

		If Not isaggregate Then

		   theType = theType+ " * "

		End If	

	'If it is an aggregation, the type is just the class name

	ElseIf isaggregate Then

		thetype = theother.name

	'Otherwise, I use the standard pointer implementation

	Else

		thetype = theother.name+" * "

	End If







	'Finally, add the attribute	if it does not exist

	Dim AttributeNotFound As Boolean

	AttributeNotfound = True



	For i = 1 To theclass.attributes.count

		If theclass.attributes.getat(i).name _

		= therealname Then 

		attributeNotFound = False

		End If

	Next i

	

	Dim theInitialValue As String

	Dim IsOverridden As Boolean

	If attributeNotFound Then



		'If it is const, I have to add it to the Type

		'The const property belongs to the ANSI C++ tab

		If(theotherrole.getpropertyvalue _

		("Cplusplus","Const")="True") Then

			theType = "const "+theType

		End If



		'initial value -- ANSI C++ property for Role

		theInitialValue = theotherrole.getpropertyvalue	_

		("Cplusplus","InitialValue")



		Set theatt = theclass.addattribute _

		(therealname,thetype,theInitialValue)

		'export control

		Set theatt.ExportControl.Name = theVisibility

		'static

		Set theatt.Static = theotherrole.static

		'stereotype

		Set theatt.Stereotype = theotherrole.Stereotype

		'documentation 

		Set theatt.documentation = _

		theotherrole.documentation

		'Containment

		theAtt.Containment.Name = _

		theotherrole.Containment.Name

		theAtt.Containment.Value = _

		theotherrole.Containment.Value

		'Synchronize

		If theotherrole.IsOverriddenproperty _

		("Cplusplus","Synchronize") Then

			IsOverridden = _

			theatt.overrideProperty _

			("Cplusplus","Synchronize", _

			theotherrole.getpropertyValue _

			("Cplusplus","Synchronize"))

		End If



		'Code Name

		If theotherrole.IsOverriddenproperty _

		("Cplusplus","CodeName") Then

			IsOverridden = _

			theatt.overrideProperty _

			("Cplusplus","CodeName", _

			theotherrole.getpropertyValue _

			("Cplusplus","CodeName"))

		End If





	End If



End Sub



Sub RetrieveAssociations(theclass As class, _

	ByRef Dlg As ConvertDialog, _

	theAssColl As AssociationCollection, _

        AnonymousToDel As ClassCollection)



	Dim theass As association

	Dim theotherRoles As Rolecollection

	Dim theotherRole As Role

	Dim theother As class

	Dim thisRole As Role

	Dim j As Integer

	

	Set theOtherRoles = theclass.getassociateroles()

	

	For j = 1 To theOtherRoles.count



		Set theotherRole = theOtherRoles.getat(j)





		'I can have a role name but if it is not navigable

		'I do not create an attribute for it

 		If theOtherRole.Navigable = "False" Then 

			GoTo Skipping

 		End If

		'If the role is navigable but has no name 

		'then I do not convert it

		If theOtherRole.Name = "" Then

RoseApp.WriteErrorLog "+++ Not converting unnamed Role from class "+_

theclass.getqualifiedname()+" to class "+theotherrole.class.getqualifiedname

			GoTo Skipping

		End If







   		Set theother = theOtherRole.class



		

		Select Case theother.stereotype

			Case "typedef"

				 Select Case theotherrole.ExportControl.Name 

				 	Case "PublicAccess"

					If Dlg.Typedef1 = 0 Then _

                      GoTo Skipping       

					Case "ProtectedAccess"

  					If Dlg.Typedef2 = 0 Then _

                      GoTo Skipping 

					Case "PrivateAccess"

					If Dlg.Typedef3 = 0 Then _

                        GoTo Skipping 

					Case "ImplementationAccess"

					If Dlg.Typedef3 = 0 Then _

                             GoTo Skipping 

					Case Else

					GoTo Skipping

				  End Select

				  If theotherrole.static Then

				  	If Dlg.StaticTypedef = 0 Then _

                                GoTo skipping

				  Else

					If Dlg.NonStaticTypedef =0 _

                            Then GoTo skipping

				  End If			

			Case "anonymous_type"

				 Select Case theotherrole.ExportControl.Name 

				 	Case "PublicAccess"

					If Dlg.Anonymous1 = 0 Then 

							GoTo skipping

						Else

						    'This is only a candidate

	If Not AnonymousToDel.exists(theother) Then AnonymousToDel.add theOther 

						End If

					Case "ProtectedAccess"

  					If Dlg.Anonymous2 = 0 Then 

						GoTo Skipping

						Else

						    'This is only a candidate

	If Not AnonymousToDel.exists(theother) Then AnonymousToDel.add theOther 

						End If

						 

					Case "PrivateAccess"

					If Dlg.Anonymous3 = 0 Then

                          GoTo Skipping 

						Else

						    'This is only a candidate

	If Not AnonymousToDel.exists(theother) Then AnonymousToDel.add theOther

						End If



					Case "ImplementationAccess"

					If Dlg.Anonymous3 = 0 Then

                            GoTo Skipping 

						Else

						    'This is only a candidate

	If Not AnonymousToDel.exists(theother) Then AnonymousToDel.add theOther

						End If



					Case Else

					GoTo Skipping

				  End Select

				  If theotherrole.static Then

				  If Dlg.StaticAnonymous=0 Then GoTo skipping

				  Else

					If Dlg.NonStaticAnonymous =0 _

					Then GoTo skipping

				  End If			

			Case Else

				 Select Case theotherrole.ExportControl.Name 

				 	Case "PublicAccess"

					If Dlg.Class1 = 0 Then GoTo Skipping       

					Case "ProtectedAccess"

  					If Dlg.Class2 = 0 Then GoTo Skipping 

					Case "PrivateAccess"

					If Dlg.Class3 = 0 Then GoTo Skipping 

					Case "ImplementationAccess"

					If Dlg.Class3 = 0 Then GoTo Skipping 

					Case Else

					GoTo Skipping

				  End Select

				  If theotherrole.static Then

				  	If Dlg.StaticClass = 0 Then _

                        GoTo skipping

				  Else

					If Dlg.NonStaticClass = 0  Then _

                       GoTo skipping

				  End If			



		End Select

	

		RoseApp.WriteErrorLog  _

		"+++ Converted association to the Class and Role:"

		RoseApp.WriteErrorLog "       " _

	    +theotherrole.Class.getqualifiedname+" - " _

		+theotherrole.name



		Set theAss = theOtherRole.Association



   		Call ConvertAssociation(theclass,theAss,theotherrole)



		'Delete the assciation only if this is the only 

		'navigable role

		Set thisrole = theass.getcorrespondingrole(theclass)

 		

		If thisrole.navigable = False Then

			theAssColl.add theAss

		Else

		'the association will be deleted next time

			theOtherRole.navigable = False 

		End If



	Skipping:

	Next j



End Sub



Sub DeleteAssociations(theclass As class, _

theAssColl As AssociationCollection)

	Dim i As Integer

	Dim limit As Integer

	Dim deleted As Boolean

	Dim theass As association

	limit = theasscoll.count



	For i = 1 To limit

		Set theass = theasscoll.getat(1)

		theasscoll.remove theass

		deleted = theclass.deleteassociation(theass)

	Next i



End Sub



Sub PrintCollection(prefix As String, cls As classcollection)

	Dim i As Integer

	For i =1 To cls.count

		 RoseApp.writeerrorlog prefix +_

                 " "+cls.getat(i).getqualifiedname

	Next i

	

End Sub



Sub DeleteAnonymousTypes(cls As ClassCollection)

    'The collection contains only candidates to be deleted

	'They should not be repeated

	'They are deleted only if they have no clients of any kind

	'after removal of the associations

	Dim i,total As Integer

	Dim theClass As Class

	Dim theCat As Category

	Dim theothers As classcollection

	Dim toDelete As New classcollection

	Dim isdeleted As Boolean



	For	i =1 To cls.count

		Set theClass = cls.getat(i)

			'This looks for clients of any kind

			Set theothers  = theclass.getclients(0,0) 

			If theothers.count = 0 Then

			   toDelete.add theclass

			Else

RoseApp.WriteErrorLog "+++ Not deleting <<anonymous_type>> "+_

"with UID: "+theclass.getuniqueID+ _

" in package: "+theclass.parentcategory.getqualifiedname + _

" because it has "+ Str$(theothers.count)+" clients:"

				Call PrintCollection ("client:",theothers)

			End If

	Next i



	total =toDelete.count

	

	For i = 1 To total

		Set theClass = toDelete.getat(1)

		Set thecat = theclass.parentcategory

		toDelete.remove theClass 

		isDeleted = thecat.deleteclass(theClass)

	Next i 





		

End Sub



Sub RetrieveClasses	(ByRef Dlg As ConvertDialog)

	Dim i As Integer

	Dim themodel As model

	Set themodel = roseapp.currentmodel

	

	Dim theclass As class



	Dim theClasses As ClassCollection

	'This collections containes <<anonymous_type>> classes

	'candidate to be deleted because they took part

	'in one deleted association

	Dim anonymousToDel As New ClassCollection

	Dim theAssColl As New AssociationCollection



	If Dlg.OptionGroup1 = 0 Then

		Set theClasses = themodel.rootcategory.getallclasses()

	Else

		Set theClasses = themodel.getselectedclasses()

	End If



	For i = 1 To theClasses.count

		Set theclass = theclasses.getat(i)

		



	    RoseApp.WriteErrorLog "------ Examined Class: " _

		+theclass.getqualifiedname() 



		If theclass.getAssignedLanguage() <> "ANSI C++" Then

		RoseApp.WriteErrorLog _

		"------ This class is not assigned to ANSI C++:"+ _

		" no conversions For this class!!"



		Else

			Call RetrieveAssociations(theclass,Dlg,theAssColl,_

                        anonymousToDel)

	   		Call DeleteAssociations(theclass,theAssColl)

		End If

	Next i



	If Dlg.DeleteAnonymousTypes	=1 Then

			Call DeleteAnonymousTypes(anonymousToDel)

	End If





End Sub



Sub Main

	Dim r As Integer

	Dim MyConvertDialog As ConvertDialog

	RoseApp.WriteErrorLog ""  	

	RoseApp.WriteErrorLog "       " _

	+"[Convert Associations to Attributes]"

	RoseApp.WriteErrorLog ""



	R = Dialog(MyConvertDialog)

	If R = -1 Then 'OK was clicked

	   Call Retrieveclasses(MyConvertDialog)

	End If

	RoseApp.WriteErrorLog ""

	RoseApp.WriteErrorLog "       " _

	+"[End of Convert Associations to Attributes]"

	RoseApp.WriteErrorLog ""



End Sub