option explicit

!INC Local Scripts.EAConstants-VBScript

'
' Example of how to utilise the search window from scripts
'
' NOTE: Requires an element to be selected in context
' 
' Related APIs
' =================================================================================
' Repository API - http://www.sparxsystems.com/enterprise_architect_user_guide/12.1/automation_and_scripting/repository3.html
' Method API - http://www.sparxsystems.com/enterprise_architect_user_guide/12.1/automation_and_scripting/method.html 
' Element API - http://www.sparxsystems.com.au/enterprise_architect_user_guide/12.1/automation_and_scripting/element2.html
'

' The columns that will appear in the Model Search window
dim SEARCH_SPECIFICATION
SEARCH_SPECIFICATION = "<ReportViewData>" & _
							"<Fields>" & _
							"<Field name='CLASSGUID' />" & _
							"<Field name='CLASSTYPE' />" & _
							"<Field name='Abstract' />" & _
							"<Field name='Name' />" & _
							"<Field name='Parameters' />" & _
							"<Field name='Scope' />" & _
							"<Field name='Stereotype' />" & _
							"<Field name='ReturnType' />" & _
							"<Field name='Note' />" & _
							"<Field name='Element' />" & _
							"</Fields>" & _
							"<Rows/>" & _
							"</ReportViewData>"

Function CreateXMLObject()
	dim xmlDOM
	
	On Error Resume Next
	set xmlDOM = CreateObject( "MSXML2.DOMDocument.4.0" )
	If Err.Number <> 0 Then
		set xmlDOM = CreateObject( "MSXML2.DOMDocument.6.0" )
	End if 
	On Error Goto 0
	
	xmlDOM.validateOnParse = false
	xmlDOM.async = "false"
	
	set CreateXMLObject = xmlDOM
end Function
							
'
' Finds all Methods and inherited Methods of the selected context element.
' The results are added to an XML document and passed back to the Model Search window to display 
' the results.
'
sub RunModelSearchExample()

	' Show the script output window
	Repository.EnsureOutputVisible "Script"

	Session.Output( "VBScript RUN MODEL SEARCH EXAMPLE" )
	Session.Output( "=======================================" )
	
	' Create a DOM object to represent the search tree
	dim xmlDOM
	set xmlDOM = CreateXMLObject()
	
	dim selectedObject as EA.Element
	set selectedObject = Repository.GetContextObject()
	
	if not selectedObject is nothing and selectedObject.ObjectType = otElement then
		
		Session.Output( "Working on element '" & selectedObject.Name & "' (Type=" & _
			selectedObject.Type & ", ID=" & selectedObject.ElementID & ")" )
		
		' Retrieve all methods and inherited methods for this object
		dim methodsCollection as EA.Collection
		set methodsCollection = selectedObject.MethodsEx
		
		' Load the search template
		if xmlDOM.loadXML( SEARCH_SPECIFICATION ) = true then
		
			dim node
			set node = xmlDOM.selectSingleNode( "//ReportViewData//Rows" )
			
			if methodsCollection.Count > 0 then
								
				dim objectIDs		
				objectIDs = ""
				
				' Get the Object IDs for all elements that declare methods in the inheritance
				' hierarchy of the selected object
				objectIDs = GetObjectIDs( methodsCollection )
				
				if objectIDs <> "" then
				
					' Now we have the IDs of all elements in the hierarchy, get the actual elements
					' themselves
					dim elementCollection as EA.Collection
					set elementCollection = GetElementSet( objectIDs, 0 )
															
					' For each Method extract the information to populate our XML document, this
					' will make up the row data in the Model Search window
					dim lastID
					dim elementName
					
					lastID = selectedObject.ElementID
					elementName = selectedObject.Name
					
					dim method as EA.Method
					for each method in methodsCollection
						
						' Get the method's signature
						dim methodSignature
						methodSignature = BuildMethodSignature( method )
						
						' If the method belongs to the current element (lastID) use its name,
						' otherwise get the name of the Element for the inherited method
						if lastID <> method.ParentID then
							
							elementName = GetOwningElementName( elementCollection, method )
							lastID = method.ParentID
							
						end if
						
						' Add this element to the XML tree
						AddRow xmlDOM, node, elementName, method
					next
					
				else
					Session.Output( "Error constructing Object ID list" )
				end if
				
			end if
		
			' Fill the Model Search window with the results
			Repository.RunModelSearch "", "", "", xmlDOM.xml
		
		else
			Session.Prompt "Failed to load search xml", promptOK
		end if
	
		Session.Output( "Done!" )
	
	else
		' No item selected in context, or the item selected was not an element
		Session.Prompt "This script requires the current context item to be an element." & _
			vbCrLf & "Please select an element and try again.", promptOK
	end if

end sub

'
' Adds an entry for the method object 'theMethod' to the xml row node 'rowsNode'
'
sub AddRow( xmlDOM, rowsNode, elementName, theMethod )

	' Cast theMethod for intellisense
	dim method as EA.Method
	set method = theMethod

	' Create a Row node
	dim row
	set row = xmlDOM.createElement( "Row" )

	' Add the Model Search row data to our DOM
	AddField xmlDOM, row, "CLASSGUID", method.MethodGUID
	AddField xmlDOM, row, "CLASSTYPE", "Operation"
	
	if method.Abstract <> 0 then
		AddField xmlDOM, row, "Abstract", "Abstract"
	else
		AddField xmlDOM, row, "Abstract", "Concrete"
	end if
	
	AddField xmlDOM, row, "Name", method.Name
	AddField xmlDOM, row, "Parameters", BuildMethodSignature(method)
	AddField xmlDOM, row, "Scope", method.Visibility
	AddField xmlDOM, row, "Stereotype", method.Stereotype
	AddField xmlDOM, row, "ReturnType", method.ReturnType
	AddField xmlDOM, row, "Note", method.Notes
	AddField xmlDOM, row, "Element", elementName

	' Append the newly created row node to the rows node
	rowsNode.appendChild( row )

end sub

'
' Adds an Element to our DOM called Field which makes up the Row data for the Model Search window.
' <Field name "" value ""/>
'
sub AddField( xmlDOM, row, name, value )

	dim fieldNode
	set fieldNode = xmlDOM.createElement( "Field" )
	
	' Create first attribute for the name
	dim nameAttribute
	set nameAttribute = xmlDOM.createAttribute( "name" )
	nameAttribute.value = name
	fieldNode.attributes.setNamedItem( nameAttribute )
	
	' Create second attribute for the value
	dim valueAttribute 
	set valueAttribute = xmlDOM.createAttribute( "value" )
	valueAttribute.value = value
	fieldNode.attributes.setNamedItem( valueAttribute )
	
	' Append the fieldNode
	row.appendChild( fieldNode )

end sub

'
' Returns the name of the element in 'theElementCollection' that declares the method 'theMethod'
'
function GetOwningElementName( theElementCollection, theMethod )

	dim i

	' Cast theMethod to get intellisense
	dim currentMethod as EA.Method
	set currentMethod = theMethod
	
	' Cast elementCollection to get intellisense
	dim elementCollection as EA.Collection
	set elementCollection = theElementCollection
	
	dim elementName
	elementName = ""
		
	' Iterate through elements in the elementCollection to find the declaring element
	for i = 0 to elementCollection.Count - 1
	
		dim element as EA.Element
		set element = elementCollection.GetAt( i )
	
		' Is this element the declaring element?
		if not element is nothing and element.ElementID = currentMethod.ParentID then
			elementName = element.Name
			exit for
		end if
	
	next

	GetOwningElementName = elementName
	
end function

'
' Returns the signature of the provided method object 'theMethod'. The signature is returned as a
' comma separated list of parameter types
'
function BuildMethodSignature( theMethod )

	' Cast theMethod for intellisense
	dim currentMethod as EA.Method
	set currentMethod = theMethod

	' Get a list of all parameters for the method
	dim parameterCollection as EA.Collection
	set parameterCollection = currentMethod.Parameters
	
	dim methodSignature
	methodSignature = ""
	
	dim currentParameter as EA.Parameter
	for each currentParameter in parameterCollection
		
		' Add the currentParameter's type to the methodSignature string
		methodSignature = methodSignature & currentParameter.Type & ", "
		
	next
	
	' Trim the trailing comma from the signature
	dim signatureLength 
	signatureLength = len( methodSignature )
	
	if signatureLength > 2 then
		methodSignature = left( methodSignature, signatureLength - 2 )
	end if
	
	BuildMethodSignature = methodSignature

end function

'
' Returns a unique comma seperated string of Element IDs for every Method and inherited Method of
' the selected Class in the Project Browser
'
function GetObjectIDs( methodsCollection )

	' Cast methodsCollection for intellisense
	dim theMethodsCollection as EA.Collection
	set theMethodsCollection = methodsCollection
	
	dim objectIDs
	dim lastID
	
	objectIDs = ""
	lastID = 0
	
	' Iterate through all methods and add their parent ID to the object IDs list
	dim method as EA.Method
	for each method in theMethodsCollection
	
		' Only record each objectID once
		if lastID <> method.ParentID then
			objectIDs = objectIDs & method.ParentID & ","
			lastID = method.ParentID
		end if
	
	next
	
	' Trim the trailing comma from the signature
	dim listLength
	listLength = len( objectIDs )
	
	if listLength > 1 then
		objectIDs = left( objectIDs, listLength - 1 )
	end if
	
	GetObjectIDs = objectIDs

end function

RunModelSearchExample()