VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "InfoDatabase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ========== Document database wrapper ===============
Option Explicit

Private index_ As Scripting.Dictionary

Private database_ As Excel.Workbook
Private docs_ As Excel.Worksheet
Private links_ As Excel.Worksheet

Private hash_ As String
Private uiControl_ As API_XLWrapper

Public docsLocation_ As String

Private Sub Class_Terminate()
  Set database_ = Nothing
  Set docs_ = Nothing
  Set links_ = Nothing
  Set uiControl_ = Nothing
End Sub

' Note: Unintialized object behavior is unspecified and most likely will cause system errors!
Public Function Init(dataSource As Excel.Workbook, Optional workDir$ = vbNullString)
  Set database_ = dataSource
  If workDir = vbNullString Then
    docsLocation_ = database_.Path
  Else
    docsLocation_ = workDir
  End If
  
  Set docs_ = database_.Sheets(HT03_SHT_DOCS)
  Set links_ = database_.Sheets(HT03_SHT_LINKS)
  Set uiControl_ = New API_XLWrapper
  Call uiControl_.SetDocument(database_)
  
  Call Recreate
End Function

' ========= Properties =============
Public Property Get Loaded() As Boolean
  Loaded = Not database_ Is Nothing
End Property

Public Property Get NeedUpdate() As Boolean
  Dim hashRng As Excel.Range: Set hashRng = database_.Names(HT03_CELL_HASH).RefersToRange
  Call hashRng.Calculate
  NeedUpdate = hash_ <> GetDatabaseHash(database_)
End Property

Public Property Get Hash() As String
  Hash = hash_
End Property

' Note: Approximate count. May be affected by Filters and Hidden rows
'   Use iterators for precise acccess
Public Property Get Count() As Long
  Count = docs_.Columns(S_D_GARANT_ID).Find(vbNullString, LookAt:=xlWhole).Row() - HT03_DEFAULT_FIRST_LINE
End Property

' Note: Approximate count. May be affected by Filters and Hidden rows
'   Use iterators for precise acccess
Public Property Get CountLinks() As Long
  CountLinks = links_.Columns(S_L_FROM_ID).Find(vbNullString, LookAt:=xlWhole).Row() - HT03_DEFAULT_FIRST_LINE
End Property

' ======== Data access =======
Public Function Contains(gid&) As Boolean
  Contains = index_.Exists(gid)
End Function

Public Function HasLinksFor(gid&) As Boolean
  If Contains(gid) Then
    HasLinksFor = index_(gid).linkBase_ <> HT03_INVALID_ROW
  Else
    HasLinksFor = False
  End If
End Function

Public Function GetLawStatus(gid&) As TLawStatus
  If Contains(gid) Then
    GetLawStatus = Cache(gid).status_
  Else
    GetLawStatus = T_LAWS_NOTDEFINED
  End If
End Function

Public Function GetLawInfo(gid&) As ItemLaw
  If Not Contains(gid) Then _
    Exit Function
  
  Dim it As IteratorLaw: Set it = Data(gid)
  If Not it.IsLoaded Then _
    Exit Function
  
  Dim iCache As ItemCachedLaw: Set iCache = Cache(gid)
  Dim iLaw As New ItemLaw
  With iLaw
    .gid_ = iCache.id_
    .type_ = iCache.type_
    .status_ = iCache.status_
    .typeTxt_ = it.TypeText
    .creator_ = it.Creator
    .date_ = it.CreationDate
    .number_ = it.Number
    .header_ = it.Header
    .attach_ = it.Attachment
    .isScoped_ = it.IsScoped
    .title_ = it.Title
    .fileName_ = it.FileName
  End With
  Set GetLawInfo = iLaw
End Function

Public Function FillLawsStatus(ByRef targetDocs As Scripting.Dictionary)
  Dim aGid As Variant
  For Each aGid In targetDocs
    targetDocs(aGid) = GetLawStatus(CLng(aGid))
  Next aGid
End Function

Public Function Cache(gid&) As ItemCachedLaw
  Debug.Assert Contains(gid)
  Set Cache = index_(gid)
End Function

Public Function Data(gid&) As IteratorLaw
  Debug.Assert Contains(gid)
  
  Set Data = New IteratorLaw
  Call Data.Init(Me, docs_, Cache(gid).row_)
End Function

Public Function FindByFileName(sName$) As IteratorLaw
  If sName = vbNullString Then _
    Exit Function
    
  Dim result As IteratorLaw: Set result = Me.Laws
  If result.Find(sName, S_D_FILENAME) Then
    Set FindByFileName = result
  End If
End Function

Public Function FindUnresolvedLink() As IteratorLinkAll
  Dim iLink As IteratorLinkAll: Set iLink = Links
  Do While Not iLink.IsDone
    If Not iLink.IsProcessed Then
      Set FindUnresolvedLink = iLink
      Exit Function
    End If
    Call iLink.Increment
  Loop
End Function

Public Function LawLinks(gid&) As IteratorLinkLaw
  If Not HasLinksFor(gid) Then _
    Exit Function
  Set LawLinks = New IteratorLinkLaw
  Call LawLinks.Init(Me, links_, gid)
End Function

Public Function LawLinksCached(gid&) As IteratorLinkCached
  If Not HasLinksFor(gid) Then _
    Exit Function
    
  Dim iCache() As Long: iCache = uiControl_.Run("GetLinksDump", gid)
  Set LawLinksCached = New IteratorLinkCached
  Call LawLinksCached.Init(Me, links_, gid, iCache)
End Function

Public Function Links() As IteratorLinkAll
  Set Links = New IteratorLinkAll
  Call Links.Init(Me, links_)
End Function

Public Function Laws() As IteratorLaw
  Set Laws = New IteratorLaw
  Call Laws.Init(Me, docs_)
End Function

Public Property Get DocumentsRelativePath() As String
  Dim dbPath$: dbPath = database_.Path
  Dim nPrefix&: nPrefix = VBA.InStr(docsLocation_, dbPath)
  If dbPath = "" Or nPrefix = 0 Then
    DocumentsRelativePath = docsLocation_ & "\"
  ElseIf docsLocation_ = dbPath Then
    DocumentsRelativePath = ".\"
  Else
    DocumentsRelativePath = ".\" & VBA.Right(docsLocation_, VBA.Len(docsLocation_) - nPrefix - VBA.Len(dbPath)) & "\"
  End If
End Property

Public Function GenerateFileName(sTitle$) As String
  GenerateFileName = VBA.Format(GetNextFileIndex(docsLocation_), "0000") & " " & SafeFileName(VBA.Trim(VBA.Left(sTitle, 80))) & HT03_DOC_EXTENSION
End Function

' ========= Actions =============
Public Function Validate() As InfoDatabase
  Set Validate = Me
  If NeedUpdate Then _
    Call Recreate
End Function

Public Function Recreate(Optional bForceLoadFromServer As Boolean = False)
  Set index_ = New Scripting.Dictionary
  hash_ = GetDatabaseHash(database_)
  
  If TypeOf Application Is Excel.Application And Not bForceLoadFromServer Then
    If ThisWorkbook.Application = database_.Application Then
      Call LoadFromData
      Exit Function
    End If
  End If
  Call LoadFromServer
End Function

Public Function GenerateID(sSeed$) As Long
  Dim gid&: gid = GenerateNewGID(sSeed & VBA.CStr(Rnd()))
  Do While Contains(gid)
    gid = GenerateNewGID(sSeed & VBA.CStr(Rnd()))
  Loop
  GenerateID = gid
End Function

Public Function ShowDB()
  database_.Application.WindowState = xlMaximized
  Call AppActivate(database_.Application.Caption)
End Function

Public Function SetItem(newItem As ItemLaw) As ItemCachedLaw
  Dim iLaw As IteratorLaw: Set iLaw = GetIterFor(newItem.gid_, newItem.status_)
  Call iLaw.SetData(newItem, LinkBaseFor(newItem.gid_))
  
  If index_.Exists(newItem.gid_) Then _
    Call index_.Remove(newItem.gid_)
  
  Dim newCachedItem As ItemCachedLaw: Set newCachedItem = iLaw.CreateIndexItem
  Call index_.Add(newItem.gid_, newCachedItem)
  Set SetItem = newCachedItem
  
  hash_ = GetDatabaseHash(database_)
End Function

Public Function SetLinksFor(target&, linksData() As String) As Boolean
  Debug.Assert Contains(target)
  SetLinksFor = False
  
  If Not ValidateLinksData(linksData) Then _
    Exit Function
    
  Call uiControl_.Run("SetLinksFor", target, linksData)
  
  Cache(target).linkBase_ = Data(target).LinkBase
  hash_ = GetDatabaseHash(database_)
  
  SetLinksFor = True
End Function

Public Function RenameLawFile(target&, newName$) As Boolean
  Debug.Assert Contains(target)
  
  If newName = vbNullString Then _
    Exit Function

  Dim newFullName$: newFullName = docsLocation_ & "\" & newName
  Dim oldFullName$: oldFullName = docsLocation_ & "\" & Data(target).FileName
  
  Dim fso As New Scripting.FileSystemObject
  If Not fso.FileExists(oldFullName) Then _
    Exit Function
    
  RenameLawFile = newFullName <> oldFullName
  If Not RenameLawFile Then _
    Exit Function
  
  On Error GoTo CANNOT_MOVE
  Call fso.MoveFile(oldFullName, newFullName)
  On Error GoTo 0
  
  Data(target).FileName = newName
  hash_ = GetDatabaseHash(database_)
  Exit Function
  
CANNOT_MOVE:
  RenameLawFile = False
End Function

Public Function IgnoreLaw(target&) As Boolean
  IgnoreLaw = True
  If Not Contains(target) Then
    Call AddIgnoredDummy(target)
  ElseIf Cache(target).status_ <> T_LAWS_IGNORE Then
    Data(target).Status = T_LAWS_IGNORE
    Cache(target).status_ = T_LAWS_IGNORE
    hash_ = GetDatabaseHash(database_)
  Else
    IgnoreLaw = False
  End If
End Function

Public Function DeleteLaw(target&) As Boolean
  DeleteLaw = Contains(target)
  If Not DeleteLaw Then _
    Exit Function
  Call uiControl_.Run("DeleteLaw", target)
  Call Recreate
End Function

Public Function DeleteSomeLinksFor(target&, nIndexStart&, nCount&) As Boolean
  DeleteSomeLinksFor = False
  
  If nIndexStart < 1 Or nCount <= 0 Then _
    Exit Function
  Dim itLink As IteratorLinkLaw: Set itLink = LawLinks(target)
  If itLink Is Nothing Then _
    Exit Function
  
  If Not itLink.Increment(nIndexStart - 1) Then _
    Exit Function
  Dim nStart&: nStart = itLink.Row
  
  If Not itLink.Increment(nCount - 1) Then _
    Exit Function
  Dim nEnd&: nEnd = itLink.Row
  
  If Not itLink.Increment Then _
    Call SetLinkBaseInternal(target, HT03_INVALID_ROW)
  
  Call DeleteLinksInternal(nStart, nEnd)
  
  DeleteSomeLinksFor = True
End Function

Public Function DeleteLinksFor(target&) As Boolean
  DeleteLinksFor = False
  
  Dim itLink As IteratorLinkLaw: Set itLink = LawLinks(target)
  If itLink Is Nothing Then _
    Exit Function
  
  Dim nStart&: nStart = itLink.Row
  Do While itLink.Increment()
  Loop
  Dim nEnd&: nEnd = itLink.Row
  
  Call SetLinkBaseInternal(target, HT03_INVALID_ROW)
  Call DeleteLinksInternal(nStart, nEnd)
  
  DeleteLinksFor = True
End Function

Public Function AddLinkAfter(gidFrom&, nWhere&, gidTo&, subTo$, subFrom$, lnkType As TLinkType) As Boolean
  AddLinkAfter = False
  If Not Contains(gidFrom) Or nWhere < 0 Then _
    Exit Function
  
  Dim bHasLink As Boolean: bHasLink = HasLinksFor(gidFrom)
  Dim targetRow&: targetRow = PrepareRowForNewLink(gidFrom, nWhere)
  If targetRow = HT03_INVALID_ROW Then _
    Exit Function

  links_.Cells(targetRow, S_L_FROM_SUB) = subFrom
  links_.Cells(targetRow, S_L_TO_ID) = gidTo
  links_.Cells(targetRow, S_L_TO_SUB) = subTo
  links_.Cells(targetRow, S_L_TYPE) = lnkType
  links_.Cells(targetRow, S_L_STATUS) = T_LINKS_ADD
  
  Call FixLinkBaseAfter(IIf(bHasLink, targetRow, targetRow + 1), 1)
  hash_ = GetDatabaseHash(database_)
  
  AddLinkAfter = True
End Function

' Requires: valid index
Public Function ValidateLinks() As String
  If index_.Count = 0 Then _
    Exit Function

  Dim anItem As ItemCachedLaw
  Dim aKey As Variant
  For Each aKey In index_
    Set anItem = index_(aKey)
    anItem.linkBase_ = HT03_INVALID_ROW
  Next aKey
  
  Dim nLast&: nLast = HT03_INVALID_GID
  Dim sLog$
  Dim iLink As IteratorLinkAll: Set iLink = Links
  Do While Not iLink.IsDone
    Dim nSource&: nSource = iLink.SourceID
    If nLast = nSource Then _
      GoTo NEXT_LINK
    If Not Contains(nSource) Then
       sLog = sLog$ & vbNewLine & Fmt("{1}: Блок ссылок для отсутствующего документа {2}", iLink.Row, nSource)
      links_.Cells(iLink.Row, S_L_FROM_ID).Interior.Color = RGB(0, 0, 255)
    ElseIf Cache(nSource).linkBase_ <> HT03_INVALID_ROW Then
      sLog = sLog$ & vbNewLine & Fmt("{1}: Несколько блоков ссылок для документа {2}", iLink.Row, nSource)
      links_.Cells(iLink.Row, S_L_FROM_ID).Interior.Color = RGB(255, 0, 0)
    Else
      Cache(nSource).linkBase_ = iLink.Row
    End If
    nLast = nSource
    
NEXT_LINK:
    Call iLink.Increment
    Call CSE_ProgressBar.IncrementA
  Loop
  
  For Each aKey In index_
    Data(CLng(aKey)).LinkBase = Cache(CLng(aKey)).linkBase_
  Next aKey
  
  hash_ = GetDatabaseHash(database_)
  
  ValidateLinks = sLog
End Function

' ===== Public Service functions
Public Function IndexDump() As Long()
  If index_.Count = 0 Then _
    Exit Function
  Dim res() As Long
  ReDim res(1 To index_.Count, LawCacheStruct.[_First] To LawCacheStruct.[_Last])
  
  Dim nRow&: nRow = 1
  Dim anItem As ItemCachedLaw
  Dim aKey As Variant
  For Each aKey In index_
    Set anItem = index_(aKey)
    res(nRow, S_CD_ID) = anItem.id_
    res(nRow, S_CD_TYPE) = anItem.type_
    res(nRow, S_CD_STATUS) = anItem.status_
    res(nRow, S_CD_LINKBASE) = anItem.linkBase_
    nRow = nRow + 1
  Next aKey
  
  IndexDump = res
End Function

Public Function LinksDumpFor(gid&) As Long()
  Dim res() As Long
  Dim theIter As IteratorLinkLaw: Set theIter = LawLinks(gid)
  If theIter Is Nothing Then _
    Exit Function
  
  Dim nCount&: nCount = 1
  Do While theIter.Increment
    nCount = nCount + 1
  Loop
  
  ReDim res(1 To nCount, LinkCacheStruct.[_First] To LinkCacheStruct.[_Last])
  Call theIter.GoFirst
  Dim nItem&
  For nItem = 1 To nCount
    res(nItem, S_CL_DESTINATION_ID) = theIter.DestinationID
    res(nItem, S_CL_TYPE) = theIter.LType
    res(nItem, S_CL_STATUS) = theIter.Status
    Call theIter.Increment
  Next nItem
  
  LinksDumpFor = res
End Function

Public Function StartOptimization()
  Call uiControl_.PauseUI
End Function

Public Function EndOptimization()
  Call uiControl_.ResumeUI
End Function

Public Function SetLinksInternal(target&, linksData() As String)
  Dim itLink As IteratorLinkAll: Set itLink = Links
  Call itLink.GotoInsertion
  Dim nStart&: nStart = itLink.Row
  Dim nCount&: nCount = ArraySize(linksData, 1)
  
  Dim nItem&
  For nItem = LBound(linksData, 1) To UBound(linksData, 1) Step 1
    With itLink
      .DestinationID = CLng(linksData(nItem, S_TL_DESTINATION_ID))
      .DestinationSub = linksData(nItem, S_TL_DESTINATION_SUB)
      .SourceID = target
      .SourceSub = linksData(nItem, S_TL_SOURCE_SUB)
      .LType = T_LINK_DEFAULT
      .Status = T_LINKS_ADD
      Call .Increment
    End With
  Next nItem
  
  Call FixLinkBaseAfter(nStart, nCount)
  Call SetLinkBaseInternal(target, nStart)
  hash_ = GetDatabaseHash(database_)
End Function

'====================
Private Function LoadFromData()
  Dim iLaw As IteratorLaw: Set iLaw = Laws
  Dim rowsCount&: rowsCount = docs_.UsedRange.Rows.Count
  Do While iLaw.Row <= rowsCount
    If Not iLaw.IsDone Then _
      If Not index_.Exists(iLaw.ID) Then _
        Call index_.Add(iLaw.ID, iLaw.CreateIndexItem)
    Call iLaw.Increment
  Loop
End Function

Private Function LoadFromServer()
  Dim iDump() As Long
  iDump = uiControl_.Run("GetIndexDump")
  If Not IsArrayAllocated(iDump) Then _
    Exit Function
  Call LoadFromDump(iDump)
End Function

' Requires: iDump is valid allocated array
Private Function LoadFromDump(iDump() As Long)
  Dim iLaw As IteratorLaw: Set iLaw = Laws
  Dim newItem As ItemCachedLaw
  Dim nItem&
  For nItem = 1 To UBound(iDump, 1) Step 1
    Set newItem = New ItemCachedLaw
    newItem.row_ = nItem + HT03_DEFAULT_FIRST_LINE - 1
    newItem.id_ = iDump(nItem, S_CD_ID)
    newItem.type_ = iDump(nItem, S_CD_TYPE)
    newItem.status_ = iDump(nItem, S_CD_STATUS)
    newItem.linkBase_ = iDump(nItem, S_CD_LINKBASE)
    ' TODO: check duplicates!
    Call index_.Add(newItem.id_, newItem)
  Next nItem
End Function

Private Function GetIterFor(gid&, aStatus As TLawStatus) As IteratorLaw
' Find in DB or create new document entry
  If Contains(gid) Then
    Set GetIterFor = Data(gid)
  Else
    Set GetIterFor = CreateRowForNewDoc
  End If
End Function

Private Function LinkBaseFor(gid&) As Long
  Dim linksIter As IteratorLinkAll: Set linksIter = Links()
  If linksIter.Find(CStr(gid), S_L_FROM_ID) Then
    LinkBaseFor = linksIter.Row
  Else
    LinkBaseFor = HT03_INVALID_ROW
  End If
End Function

Private Function SetLinkBaseInternal(gid&, nRow&)
  Data(gid).LinkBase = nRow
  Cache(gid).linkBase_ = nRow
End Function

Private Function CreateRowForNewDoc() As IteratorLaw
  Set CreateRowForNewDoc = Laws()
  If Not CreateRowForNewDoc.Find(vbNullString, S_D_GARANT_ID) Then
    Call Err.Raise(vbObjectError + 513, "InfoDatabase", "Cannot find empty string for insert")
  Else
    Call docs_.Rows(CreateRowForNewDoc.Row).EntireRow.Insert(CopyOrigin:=xlFormatFromRightOrBelow)
  End If
End Function

Private Function PrepareRowForNewLink(gid&, nWhere&) As Long
  PrepareRowForNewLink = HT03_INVALID_ROW
  
  Dim targetRow&: targetRow = Cache(gid).linkBase_
  If targetRow = HT03_INVALID_ROW Then
    If nWhere <> 0 Then _
      Exit Function
    Dim it As IteratorLinkAll: Set it = Links
    Call it.GotoInsertion
    targetRow = it.Row
    links_.Cells(targetRow, S_L_FROM_ID) = gid
    Call SetLinkBaseInternal(gid, targetRow)
  Else
    targetRow = targetRow + nWhere - 1
    If links_.Cells(targetRow, S_L_FROM_ID) <> gid Then _
      Exit Function
    Call links_.Rows(targetRow).EntireRow.Copy
    Call links_.Rows(targetRow).EntireRow.Insert(CopyOrigin:=xlFormatFromRightOrBelow)
    targetRow = targetRow + 1
  End If
  
  PrepareRowForNewLink = targetRow
End Function

Private Function AddIgnoredDummy(gid&)
  Dim iLaw As New ItemLaw
  Call iLaw.InitDummy(gid)
  iLaw.status_ = T_LAWS_IGNORE
  Call SetItem(iLaw)
End Function

Private Function DeleteLinksInternal(rowStart&, rowEnd&)
  Debug.Assert rowStart <= rowEnd
  
  Dim delCount&: delCount = rowEnd - rowStart + 1
  Dim i&
  For i = 1 To delCount Step 1
    Call links_.Rows(rowStart).EntireRow.Delete
  Next i
  Call FixLinkBaseAfter(rowStart, -delCount)
  hash_ = GetDatabaseHash(database_)
End Function

Private Function FixLinkBaseAfter(nThreshhold&, nDiff&)
  Dim dbItem As ItemCachedLaw
  Dim aKey As Variant
  For Each aKey In index_
    Set dbItem = index_(aKey)
    If dbItem.linkBase_ >= nThreshhold Then _
      Call SetLinkBaseInternal(dbItem.id_, dbItem.linkBase_ + nDiff)
  Next aKey
End Function

Private Function ValidateLinksData(linksData() As String) As Boolean
  ValidateLinksData = False
  
  If Not IsArrayAllocated(linksData) Then _
    Exit Function
  If LBound(linksData, 2) <> LinkTransferStruct.[_First] Then _
    Exit Function
  If UBound(linksData, 2) <> LinkTransferStruct.[_Last] Then _
    Exit Function

  ValidateLinksData = True
End Function

Public Function GenerateNewGID(sSeed$) As Long
   GenerateNewGID = VBA.CStr((MD5AsLong(sSeed) Mod 1000000000) + 1000000000)
End Function

Private Function GetNextFileIndex(sFolder$) As Long
  Dim maxIndex&: maxIndex = 0
  Dim nIndex&
  Dim sFileName$: sFileName = Dir(sFolder & "\*" & HT03_DOC_EXTENSION)
  Do While sFileName <> vbNullString
    nIndex = ExtractFileIndex(sFileName)
    maxIndex = IIf(maxIndex < nIndex, nIndex, maxIndex)
    sFileName = Dir
  Loop
  GetNextFileIndex = maxIndex + 1
End Function

Private Function ExtractFileIndex(target$) As Long
  Dim prefix$: prefix = ""
  Dim symb$
  Dim i&
  For i = 1 To Len(target)
    symb = Mid(target, i, 1)
    If Not IsNumeric(symb) Then
      i = i - 1
      Exit For
    End If
  Next i
  If i > 1 Then _
    ExtractFileIndex = CLng(Mid(target, 1, i))
End Function
