'*************************************************************************
'
'   Name:   Unres2 - Unresolved Reference Zapper v. 2.0 
'	Author: Tony Lew, Rational Technical Support
'   Date:   June 20, 1999
'
'	Purpose:   To delete dangling references
'   Changes from v 1.0
'         - Now handles the Use case view, not only Logical view
'         - Works on doubly dangling associations now
'         - Deletes "one-roled" associations as well
'   Platform:  Rose 98i 
'
'**************************************************************************


Dim thisModel As Model
dim allClassRoles as  Rolecollection
Dim allUCRoles As  Rolecollection 
Dim junque As Category

Sub KillOneLeggedAssociations

	dim cc as classcollection
    set cc = RoseApp.currentmodel.getallclasses

    dim ac as associationCollection
    dim a as association
    dim c as class
   Dim otherrole As role
   Dim count As Integer
   count = 0

    dim rollo as role
    for i% =  1 to cc.count
       Set c = cc.getat(i)
       set ac = c.getAssociations
              for j% = ac.count to 1 step	 -1
           set a = ac.getat(j)
     '      print "association name:",a.name
     '      print "association quid:",a.getUniqueid
          ' set OtherRole = a.getotherRole(c)
   '        if otherRole.class is nothing then
   '          zot = c.deleteAssociation(a)
   '        end if
           set rollo = a.role1
            on error goto booboo
           set rollo = a.role2
           goto nobooboo
booboo:	  
       Print "Deleting Association...", c.name,"::",a.name
       xx = c.deleteassociation(a)
	   count = count + 1
	   resume next
nobooboo:
       Next j
	 Next i
	msgbox "DELETED " & str(count) & " bad associations"


End Sub

sub InitClassRoles
dim allClasses as classcollection
set AllClasses = thisModel.getallClasses
dim classRoles as rolecollection
set allClassRoles = new RoleCollection
  
   for i% = 1 to allClasses.count
      set classRoles = allClasses.getat(i).getRoles
            for j% = 1 to classRoles.count
		  allClassRoles.add classRoles.getat(j)
      next j
   next i

end sub

sub InitUCRoles
dim allUseCases as usecasecollection
set AllUseCases = thisModel.getAllUseCases
dim UCRoles as roleCollection
set AllUcRoles = new RoleCollection

   for i% = 1 to allUseCases.count
	  set UCRoles = allUseCases.getat(i).getRoles
      for j% = 1 to UCRoles.count
		  allUCRoles.add UCRoles.getat(j)
      next j
   next i



End Sub

Function FindClass(r as role) as Boolean

for i% = 1 to allClassRoles.count 
   if r.getUniqueId = allClassRoles.getat(i).getUniqueId then
      FindClass = True
      exit Function
   end if 
next i
	  
  FindClass = False
End Function

Function FindUseCase(r as role) as Boolean
for i% = 1 to allUCRoles.count 
   if r.getUniqueId = allUCRoles.getat(i).getUniqueId then
      FindUseCase = True
      Exit Function
   end if 
next i
	  
  FindUseCase = False

End Function

Function SomethingOnTheEnd(r as Role) as Boolean
if FindClass(r) OR  FindUseCase(r) then
  SomethingOnTheEnd = True
else
  SomethingOnTheEnd = False
End If

End function

Sub DoCategory(cat as category)
dim theMules as AssociationCollection
dim a as association
dim r1 as role
dim r2 as role
dim c as class
dim deleted as boolean

set theMules = cat.associations

For i% = theMules.count To 1 Step -1 
    Print "Association No.", i
  Set a = theMules.getat(i)
'  msgbox a.name
  set r1 = a.role1
  set r2 = a.role2
  print r1.GetClassName
  print r2.getClassName
  if somethingOntheEnd(r1) AND somethingOntheEnd(r2) then
'    Association is OK.  Do nothing.
     print a.name, "Is OK"
  else
     print ">>>>>>>", a.name ,"Is DANGLING"
	 junque.relocateAssociation a
  end if
  Print "**********************"
next i

End Sub

Sub DoViewPort
   viewport.open
   viewport.clear
End Sub

Sub doNonAssociations
   	   Dim cc As classcollection
       set cc = RoseApp.currentmodel.getallclasses

       dim ac as associationCollection
       dim ic as inheritRelationCollection
       dim uc as UsesRelationCollection
       dim hc as hasRelationshipCollection
       dim a as association
       dim ir as inheritrelation
       dim hr as hasRelationship
       dim ur as UsesRelation
       dim c as class
       dim otherrole as role
      	dim zapped as integer

       zapped = 0
       msg.open "Scanning classes...",0,false,true
       dim rollo as role
       for i% =  1 to cc.count
          set c = cc.getat(i)
                

       ' *- Dangling inherits -*

   			set ic = c.getInheritrelations
               for j% = ic.count to 1 step	 -1
                   set ir = ic.getat(j)
                   if ir.supplierClass is nothing then
                     zot = c.deleteinheritrel(ir)
                     zapped = zapped + 1
                   end if
                next j

       ' *- Dangling Uses -*

               set uc = c.GetUsesRelations
               for j% = uc.count to 1 step	 -1
                   set ur = uc.getat(j)
                   if ur.Supplierclass is nothing then
                     zot = c.deleteUses(ur)
                     zapped = zapped + 1
                   end if
                next j

       ' *- Dangling has relations -*

               set hc = c.GethasRelations
               for j% = hc.count to 1 step	 -1
                   set hr = hc.getat(j)
                   if hr.Supplierclass is nothing then
                     zot = c.deletehas(hr)
                     zapped = zapped + 1
                   end if
                next j

           msg.thermometer = 100*(i/cc.count)
       next i
       msg.close
       msgbox str$(zapped) + " Dangling relations deleted",ebOKOnly, "Done"

End Sub


Sub Main
   set thisModel = Roseapp.currentmodel  
  
   dim allCats as categoryCollection
   Set AllCats = thisModel.getallcategories   
   Set junque = roseapp.currentmodel.rootcategory.addcategory("bbaassuurraa")



   doViewPort

   doNonAssociations
   killOneLeggedAssociations

   InitClassRoles
   InitUCRoles

   for i% = 1 to allCats.count
      DoCategory( allCats.getat(i) )
   Next i

   xxx = roseapp.currentmodel.rootcategory.deletecategory(junque)
   	
End Sub