'**Patrick Rutledge, Rational Support 5/98 
'The script cycles through all the module specifications in a module. 
'It tries to find a module body in the same subsytem with the same name 
'and assigns that body to the same class as the module specification. 
'It helps in the conversion from Rose 4.0 to 98. 
Dim bReadOnly As Boolean 'true means read-only units exist 
Dim bUnloaded As Boolean 'true means unloaded units exist 

'Takes a Subsystem and the name of a module specification 
'Looks for a module body named inName in the Subsystem 
'Returns Nothing if no match 
Function FindBodyWithName (inSubsystem As Subsystem, inName As String) As Module 
 Dim theModule As Module 
 Set FindBodyWithName = Nothing 
 For k = 1 To inSubsystem.Modules.Count 
  Set theModule = inSubsystem.Modules.GetAt(k) 
  If theModule.name = inName Then 
   If theModule.Part = "Body" Then 
    Set FindBodyWithName = theModule 
   End If 
  End If 
 Next k 
End Function 

'Assigns inBody to each class that inSpec is assigned to 
'returns a count of how many classes it assigned the body to 
Function AssignBodyToClasses (inBody As Module, inSpec As Module) As Integer 
 Dim assignedClasses As ClassCollection 
 Dim theClass As Class 
 count = 0 
  
 Set assignedClasses = inSpec.GetAssignedClasses() 

 For j = 1 To assignedClasses.Count 
  Set theClass = assignedClasses.GetAt(j) 
  'make sure the class is not already assigned to the module body 
  'it wouldn't matter really except we want an accurate count 
  If inBody.GetAssignedClasses().FindFirst(theClass.name) = 0 Then 
   theClass.AddAssignedModule inBody 
   count = count + 1 
  End If 
 Next j 
 AssignBodyToClasses = count 
End Function 

'Looks for unloaded or unmodifiable units 
'Sets global bReadOnly and bUnlaoded if it finds any 
'Writes names of the units to the log window 
Sub CheckForUnits 
 Dim allCats As CategoryCollection 
 Dim aCat As Category 
 Dim allSubs As SubsystemCollection 
 Dim aSub As Subsystem 

 Set allCats = RoseApp.CurrentModel.GetAllCategories() 
 For i = 1 To allCats.Count 
  If bUnloaded = True And bReadOnly = True Then 
   Exit For 
  End If 
  Set aCat = allCats.GetAt(i) 
  'Logical view always says it's unloaded, ignore 
  'If aCat.TopLevel() Then 
  ' GoTo SkipCategory 
  'End If 
  If (Not aCat.IsLoaded()) Then 
   RoseApp.WriteErrorLog "Unloaded category: " & aCat.name 
   bUnloaded = True 
  ElseIf (Not aCat.IsModifiable()) Then 
   RoseApp.WriteErrorLog "Read-only category: " & aCat.name 
   bReadOnly = True 
  End If 
  SkipCategory: 
 Next i 

 Set allSubs = RoseApp.CurrentModel.GetAllSubsystems() 
 For j = 1 To allSubs.Count 
  If bUnloaded = False And bReadOnly = False  Then 
   Exit For 
  End If 
  Set aSub = allSubs.GetAt(j) 
  'Component View always says it's unloaded, ignore 
  If aSub.TopLevel() Then 
   GoTo SkipSubsystem 
  End If 
  If (Not aSub.IsLoaded()) Then 
   RoseApp.WriteErrorLog "Unloaded subsystem: " & aSub.name 
   bUnloaded = True 
  ElseIf (Not aSub.IsModifiable()) Then 
   RoseApp.WriteErrorLog "Read-only subsystem: " & aSub.name 
   bReadOnly = True 
  End If 
  SkipSubsystem: 
 Next j 
End Sub 

Sub Main 
 Dim allModules As ModuleCollection 
 Dim aModule As Module 
 Dim theBody As Module 
 Dim assignedClasses As ClassCollection 
 Dim theClass As Class 
 Dim changedCount As Integer 

 changedCount = 0 
 RoseApp.WriteErrorLog "" 
 RoseApp.WriteErrorLog "[Assign module bodies to classes]" 
 Set allModules = RoseApp.CurrentModel.GetAllModules() 

 CheckForUnits 
 'iterate through all modules 
 For i = 1 To allModules.Count 
  Set aModule = allModules.GetAt(i) 

  'with each module specification 
  If aModule.Part = "Specification" Then 
   'look for a module body with the same name in this subsystem 
   Set theParent = aModule.ParentSubsystem 
   Set theBody = FindBodyWithName(aModule.ParentSubsystem, aModule.name) 

   If theBody Is Nothing Then 
    'no matching body, nothing to do 
    RoseApp.WriteErrorLog "No module body found for header " & aModule.name 
   Else 
    changedCount = changedCount + AssignBodyToClasses(theBody, aModule) 
   End If 
  End If 
 Next i 

 RoseApp.WriteErrorLog "Assigned " & Str(changedCount) & " classes to module bodies." 
 RoseApp.WriteErrorLog "Done" 
    If bReadOnly = True Or bUnloaded = True Then 
  MsgBox "Some units were inaccessible: see log for details" 
 Else 
  MsgBox "Done: see log for details" 
  
 End If 
End Sub