' It iterates over all tables and creates an FK index if one doesnt already exist and if it wouldnt be redundant.
' It also deletes any indexes that are redundant - ie. covered by another index.
' It has a couple variables at the beginning of the Evaluate_OnLoad sub that you can set:
'   DeleteIfPrefixMatches - set to true if you want the index deleted if it matches the prefix of another index.
'    Otherwise, it needs to match the entire index.
'   WarnOnly - dont actually delete or create any indexes, just output what it would do.
'    Of course, even if you do delete indexes, you can always undo the delete.


Function Index1MakesIndex2Redundant(IndexColumns1, NumColumns1, IndexColumns2, NumColumns2, DeleteIfPrefixMatches, Document)
  ' return false if must match on all members and member count doesnt match
  If Not DeleteIfPrefixMatches And NumColumns1 <> NumColumns2 Then
    Index1MakesIndex2Redundant = False
    Exit Function
  End If
  Dim i
  Dim Column1
  Dim Column2
  i = 0
  While i < NumColumns1 And i < NumColumns2
    Set Column1 = IndexColumns1(i)
	If Column1 Is Nothing Then
    	Index1MakesIndex2Redundant = False
    	Exit Function
    End If
    Set Column2 = IndexColumns2(i)
    If Not Column1.Equals(Column2) Then
      Index1MakesIndex2Redundant = False
      Exit Function
    End If    
    i = i + 1
  Wend
  If DeleteIfPrefixMatches Then
    Index1MakesIndex2Redundant = (i = NumColumns2)
  Else
    Index1MakesIndex2Redundant = (i = NumColumns1 And i = NumColumns2)
  End If
  Index1MakesIndex2Redundant = True
End Function

Function IndexIsRedundant(Table, Index2, IndexColumns2, NumColumns2, DeleteIfPrefixMatches, Document)
  Dim Indexes
  Dim Index
  Set Indexes = Table.Children("Index")
  Num = 0
  For Each Index in Indexes
    Dim ProcessIndex
    ProcessIndex = False
    If Index2 Is Nothing Then
      ProcessIndex = True
    ElseIf Not Index.Equals(Index2) Then
      ProcessIndex = True
    End If
    If ProcessIndex Then
      Set IndexMembers1 = Index.Children("Index Member")
      ReDim IndexColumns1(IndexMembers1.Count - 1)
      i = 0
      For Each IndexMember1 In IndexMembers1
        Set IndexColumns1(i) = IndexMember1.Property("Column").AsObject
        i = i + 1
      Next
      If Index1MakesIndex2Redundant(IndexColumns1, IndexMembers1.Count, IndexColumns2, NumColumns2, DeleteIfPrefixMatches, Document) Then
        IndexIsRedundant = True
        Exit Function
      End If
    End If
  Next
  IndexIsRedundant = False
End Function

Sub CreateOrDeleteFKIndexes(Table, Document, Framework, DeleteIfPrefixMatches, WarnOnly)
  Dim Relations
  Dim Relation
  Dim Index
  Set Relations = Table.Children("Relation")
  Num = 0
  For Each Relation in Relations
    Set Index = Relation.Property("Index").AsObject
    If Index Is Nothing Then
      Set FKs = Relation.Children("FK Member")
      NumFKs = FKs.Count
      ReDim RelFKs(NumFKs - 1)
      i = 0
      For Each FK In FKs
        Set RelFKs(i) = FK.Property("Child Column").AsObject
        i = i + 1
      Next
      If Not IndexIsRedundant(Table, Index, RelFKs, NumFKs, DeleteIfPrefixMatches, Document) Then
        Document.Write("Creating FK Index for Relation " & Table.Property("Name").AsString & "." & Relation.Property("Name").AsString & vbLf)
        If Not WarnOnly Then
          Set Index = Framework.CreateObject("Index", Table)
          Dim RefProp
          Set RefProp = Framework.CreatePropertyValue("Relation", "Index")
          RefProp.FromObject(Index)
          Relation.SetProperty "Index", RefProp
          Dim BoolProp
          Set BoolProp = Framework.CreatePropertyValue("Index", "Auto Generated By Key")
          BoolProp.FromBoolean(True)
          Index.SetProperty "Auto Generated By Key", BoolProp
          Index.DeleteProperty("Name")
        End If
      End If
      Else
      Set IndexMembers2 = Index.Children("Index Member")
      ReDim RelFKs(IndexMembers2.Count - 1)
      i = 0
      For Each IndexMember2 In IndexMembers2
        Set RelFKs(i) = IndexMember2.Property("Column").AsObject
        i = i + 1
      Next
      If IndexIsRedundant(Table, Index, RelFKs, IndexMembers2.Count, DeleteIfPrefixMatches, Document) Then
        Document.Write("Deleting FK Index " & Table.Name & "." & Index.Name & vbLf)
        If Not WarnOnly Then
          Framework.DeleteObject(Index)
        End If
      End If
    End If
  Next
End Sub

Sub DeleteRedundantRegularIndexes(Table, Document, Framework, DeleteIfPrefixMatches, WarnOnly)
  Set Indexes = Table.Children("Index")
  Num = 0
  For Each Index in Indexes
    Set Key = Index.Property("Key").AsObject
    If Key Is Nothing Then
      i = 0
      Set IndexMembers = Index.Children("Index Member")
      ReDim IndexColumns(IndexMembers.Count - 1)
      For Each IndexMember In IndexMembers
        Set IndexColumns(i) = IndexMember.Property("Column").AsObject
        i = i + 1
      Next
      If IndexIsRedundant(Table, Index, IndexColumns, IndexMembers.Count, DeleteIfPrefixMatches, Document) Then
        Document.Write("Deleting Redundant Regular Index " & Table.Name & "." & Index.Name & vbLf)
        If Not WarnOnly Then
          Framework.DeleteObject(Index)
        End If
      End If
    End If
  Next
End Sub

Sub Evaluate_OnLoad()
  ' user can set these 2 vars
  DeleteIfPrefixMatches = False
  WarnOnly = False
  Set Context = CreateObject("SCF.ScriptContext")
  Set Document = Context.ScriptDocument
  Set ThisScript = Context.Object
  Set Options = Context.Options
  Set Model = ThisScript.Model
  Set Framework = CreateObject("SCF.ScriptFramework")
  Document.Write("Creating Model " & Model.AsObject.Property("Name").AsString & " FK Indexes..." & vbLf)
  Model.BeginTransaction("Create FK Indexes")
  Set Tables = Model.AsObject.Children("Table")
  For Each Table In Tables
    Call CreateOrDeleteFKIndexes(Table, Document, Framework, DeleteIfPrefixMatches, WarnOnly)
    Call DeleteRedundantRegularIndexes(Table, Document, Framework, DeleteIfPrefixMatches, WarnOnly)
  Next
  Model.EndTransaction()
  Document.Write("Updating Model " & Model.AsObject.Property("Name").AsString & " Done!" & vbLf)
End Sub