buildconstructor.ebs

信息管理软件,描述信息的采集,分析等,信息管理软件,描述信息的采集,分析等

'==============================================================================
' Build constructor for class by selected features (attributes or roles)
' (Note: roles are selected via "Select Association Role")
' ToDo
' 1. Add support for attributes without wrappers.
'==============================================================================
' History
' 2001/07/02 | Vladislav Dutov | created 
'==============================================================================

Declare Function attrSetter(at As Attribute) As String
Declare Function roleSetter(at As Role) As String
Declare Function method(prefix As String, atName As String) As String
Declare Function getRoleOwner(role As Role) As Class
Const CRLF = Chr$(13) + Chr$(10)

Sub Main
	Dim selected As ItemCollection
	Dim ri As RoseItem
	Dim attributes As New AttributeCollection
	Dim at As Attribute
	Dim roles As New RoleCollection
	Dim r As Role
	Dim cls As Class
	Dim constr As Operation
	Dim sm As String
	Dim param As Parameter

	Viewport.Open "Build constructor"
	Viewport.Clear
	Set selected = RoseApp.CurrentModel.GetSelectedItems()
	For i%=1 To selected.Count 
		Set ri = selected.GetAt(i%)
		If ri.CanTypeCast(at) Then
			Set at = ri.TypeCast(at)
			attributes.Add at
			Set cls = at.ParentClass
			Print "Attribute: """ + at.Name + """"
		ElseIf ri.CanTypeCast(r) Then
			Set r = ri.TypeCast(r)
			roles.Add r
			Set cls = getRoleOwner(r)
			Print "Role     : """ + r.Name + """"
		Else
			Print "Error: """ + ri.Name + """ is not attribute or role"
			Exit Sub
		End If
	Next i%
	' constructor
	sm = ""
	'attributes
	For j% = 1 To attributes.Count
		Set at = attributes.GetAt(j%)
		sm = sm + "// attribute: " + at.Name + CRLF
		sm = sm + attrSetter(at) + "(" + at.Name + ");" + CRLF
	Next j%

	'roles
	For j% = 1 To roles.Count
		Set r = roles.GetAt(j%)
		sm = sm + "// role: " + r.Name + CRLF
		sm = sm + roleSetter(r) + "(" + r.Name + ");" + CRLF
	Next j%

	If attributes.Count + roles.Count = 0 Then
		Print "no selected features"
		Exit Sub
	End If

	Set constr = cls.addOperation(cls.Name, "")
	' return
	constr.Semantics = sm
	'attributes
	For j% = 1 To attributes.Count
		Set at = attributes.GetAt(j%)
		Set param = constr.AddParameter(at.Name, at.Type, "", constr.Parameters.Count + 1)
	Next j%

	'roles
	For j% = 1 To roles.Count
		Set r = roles.GetAt(j%)
		Set param = constr.AddParameter(r.Name, r.Class.Name, "", constr.Parameters.Count + 1)
	Next j%
End Sub

'setter for attribute
Function attrSetter(at As Attribute) As String
	attrSetter = method("set", at.Name)
End Function

'setter for role
Function roleSetter(at As Role) As String
	Dim card As String

	card = at.Cardinality
	If card = "1" Or card = "0..1" Then
		roleSetter = method("set", at.Name)
	Else
		roleSetter = method("add", at.Name)
	End If
End Function

Function method(prefix As String, atName As String) As String
	method = prefix + UCase$(Mid$(atName, 1, 1)) + Mid$(atName, 2)
End Function

' returns role owner
Function getRoleOwner(r As Role) As Class
	Dim assoc As Association
	Dim r1 As Role
	Dim r2 As Role

	Set assoc = r.Association
	Set r1 = assoc.Role1
	Set r2 = assoc.Role2

	If r Is r1 Then
		Set getRoleOwner = r2.Class
	Else
		Set getRoleOwner = r1.Class
	End If
End Function