' btx_delete.inc

' These routines are only used for indexes that are standalone. For indexes
' tied to a database, the index/tags keys are only deleted when a Pack or
' Zap is done.

Function ctx_DeleteKey_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pBTX            As BTX_TYPE Ptr
   Local pTagDisk        As INDEX_TAG_TYPE_DISK Ptr
   Local pTAG            As INDEX_TAG_TYPE_MEMORY Ptr
   Local KeyAddress      As Long
   Local KeyLength       As Long
   Local RecNum          As Long 
   Local sTempKey        As String
   
   ' Do some tests to ensure that the parameters were correctly
   ' filled in when the call was made.
   If (@xdb.nData = 0)      Or (@xdb.nLen = 0)     Or _
      (@xdb.nData4byte = 0) Or (@xdb.reserved = 0) Then
      @xdb.errcode = %ERR_DATA: GoTo ExitOut
   End If
   
   KeyAddress = @xdb.nData
   KeyLength  = @xdb.nLen
   RecNum     = @xdb.nData4byte

   ' The Tag disk structure (from the index header) is in the reserved element
   pTAG = @xdb.reserved
   
   ' Get the associated index... 
   pBTX = @pTAG.pBTX

   If KeyLength <> @pTAG.@pTagDisk.KeySize Then
      sTempKey = Space$( @pTAG.@pTagDisk.KeySize )
      LSet sTempKey = Peek$( KeyAddress, KeyLength )
      KeyAddress = StrPtr( sTempKey )
      KeyLength  = @pTAG.@pTagDisk.KeySize
   End If       

   @xdb.errcode = ctx_DeleteTagKey_Internal( xdb, pBTX, pTAG, _
                                             Peek$( KeyAddress, KeyLength ), _
                                             RecNum )

ExitOut:
   Function= @xdb.errcode  

End Function

                                                                     
                                                                     
'//
'//  Function that actually removes the key/recnum from the index TAG. This
'//  routine is called when a database record is updated and from the 
'//  ctx_DeleteKey_Internal function (for standalone indexes).
'//
Function ctx_DeleteTagKey_Internal( ByVal xdb As CHEETAH4_TYPE Ptr, _
                                    ByVal pBTX As BTX_TYPE Ptr, _
                                    ByVal pTAG As INDEX_TAG_TYPE_MEMORY Ptr, _
                                    ByVal sKey As String, _
                                    ByVal nRecNum As Long _
                                    ) As Long

   Local sLookupKey     As String
   Local nLookupNodeNum As Long
   Local nStart         As Long
   Local nCount         As Long
   Local nDeletePos     As Long
   Local x              As Long
   
   ' If the Tag is uppercase then ucase the incoming string because
   ' we need to get an exact match for the delete key.
   If @pTAG.@pTagDisk.UpperCase Then sKey = UCase$(sKey)
   
   ' Seek to the exact Key and RecNum (exit if no exact match found). 
   If ctx_SeekEngine_Internal( xdb, pBTX, pTAG, _
                               StrPtr(sKey), Len(sKey), nRecNum, _
                               %XDB_SEEK_KEY_AND_RECNUM ) = %FALSE Then 
      @xdb.errcode = %ERR_SEEKEXACTMATCH                         
      GoTo ExitOut
   End If
   

   ' Remove the key & recnum from the buffer
   nStart = (@pTAG.RegularNodePos-1) * (@pTAG.@pTagDisk.KeySize+4)
   nCount = @pTAG.@pTagDisk.KeySize + 4 
   
   MemDelete VarPtr(@pTAG.RegularNode.Buffer), _
              SizeOf(@pTAG.RegularNode.Buffer), _
              nStart, nCount
   
   
   ' Update the count of the number of keys on this node
   @pTAG.RegularNode.NumKeys = Max( 0, @pTAG.RegularNode.NumKeys - 1 )

   
   ' If the first key in the node was deleted then we need to update the Lookup node
   ' to reflect the new key value.
   If @pTAG.RegularNodePos = 1 Then
      sLookupKey     = Peek$( VarPtr(@pTAG.RegularNode.Buffer) + nStart, @pTAG.@pTagDisk.KeySize)
      nLookupNodeNum = @pTAG.RegularNodeNum 
      
      If @pTAG.RegularNode.NumKeys = 0 Then 
         ' Delete the key in the LookupNode. If more LookupNodes exist then we
         ' need to attempt to move the first key from them to this node. This ensures
         ' that all of the LookupNodes (except the last) are full.

         Local LookupNode1    As INDEX_LOOKUP_NODE_TYPE
         Local LookupNode2    As INDEX_LOOKUP_NODE_TYPE
         Local LookupNodeNum1 As Long
         Local LookupNodeNum2 As Long

         ' Copy the current LookupNode into a temporary buffer
         LSet LookupNode1 = @pTAG.LookupNode
         LookupNodeNum1   = @pTAG.LookupNodeNum 
         LookupNodeNum2   = 0
         nDeletePos       = @pTAG.LookupNodePos    

         ' Invalidate the LookupNode in the pTAG memory structure so that
         ' it will be reloaded the next time an operation occurs that
         ' needs it.
         @pTAG.LookupNodeNum = 0                 
         @pTAG.LookupNodePos = 0   
         
         
         Do
            ' Delete the key/node 
            For x = nDeletePos To %INDEX_MAX_LOOKUP_KEYS - 1
                LookupNode1.Key(x)  = LookupNode1.Key(x+1)
                LookupNode1.Node(x) = LookupNode1.Node(x+1)
            Next    

            ' Must reset this variable on each loop iteration
            LookupNodeNum2 = 0

            ' If a next node exists then we load it and take the first key/node
            ' values to copy to the last position in the LookupNode1.
            If LookupNode1.NextNode Then
               
               LookupNodeNum2 = LookupNode1.NextNode 
               @xdb.errcode = ctx_GetNode_Internal( pBTX, _
                                                    LookupNodeNum2, _
                                                    VarPtr(LookupNode2) )
               If @xdb.errcode Then GoTo ExitOut
               
               ' Get the first key/node because that is the pair that will be moved
               sLookupKey     = LookupNode2.Key(1)
               nLookupNodeNum = LookupNode2.Node(1)         
               nDeletePos     = 1
               
            Else
               sLookupKey     = Space$(4)
               nLookupNodeNum = 0
            End If   

            LookupNode1.Key(%INDEX_MAX_LOOKUP_KEYS)  = sLookupKey
            LookupNode1.Node(%INDEX_MAX_LOOKUP_KEYS) = nLookupNodeNum
            
            
            ' Save the node back to disk
            @xdb.errcode = ctx_PutNode_Internal( pBTX, _
                                                 LookupNodeNum1, _
                                                 VarPtr(LookupNode1) )
            If @xdb.errcode Then GoTo ExitOut
            
            If LookupNodeNum2 = 0 Then Exit Do  ' no more nodes to process
            
            ' Set the pointers in order to process the next node that was modified. That
            ' is, the temporary LookupNode in LookupNode2 will be moved to LookupNode1
            ' and the process will repeat.
            LSet LookupNode1 = LookupNode2
            LookupNodeNum1 = LookupNodeNum2
            
         Loop  
         
         
      Else
         ' Replace the existing Lookup key with the new one
         @pTAG.LookupNode.Key(@pTAG.LookupNodePos)  = sLookupKey
         ' Save the node back to disk
         @xdb.errcode = ctx_PutNode_Internal( pBTX, _
                                              @pTAG.LookupNodeNum, _
                                              VarPtr( @pTAG.LookupNode ) )
         If @xdb.errcode Then GoTo ExitOut
      End If

      
   End If

   ' If no keys exist then we need to move this Regular node to the free list.
   If @pTAG.RegularNode.NumKeys = 0 Then
      @xdb.errcode = ctx_PutFreeNode_Internal( pBTX, @pTAG.RegularNodeNum )
      @pTAG.RegularNodeNum = 0
      Exit Function
   End If
   
   
   ' Save the node back to disk
   @xdb.errcode = ctx_PutNode_Internal( pBTX, _
                                        @pTAG.RegularNodeNum, _
                                        VarPtr( @pTAG.RegularNode ) )
   If @xdb.errcode Then GoTo ExitOut
   
   
ExitOut:
   Function = @xdb.errcode  

End Function

