
'// DBASE specific memo handling routines                             

'// Normally, dBase memos are pretty inefficent because existing memos are
'// left in the memo file even after they are deleted. Cheetah uses a clever
'// deleted memo garbage chain that tracks these deleted memos in order that
'// the occupied space can be re-used when a new memo is added. The garbage
'// chain is stored in the unused 495 byte portion of the memo header.


'//
'//  Read the memo header from the disk file
'//
Function ctx_ReadMemoHeader_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF As DBF_TYPE Ptr 
   
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut

   pDBF = @xdb.reserved
   
   If @pDBF.hFileMemo = 0 Then GoTo ExitOut
   
   ' Load the Memo header
   If fGetAt(@pDBF.hFileMemo, 1, %MEMO_HEADER_SIZE, VarPtr(@pDBF.DBH_MEMO)) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If
   
   ' Update the stats
   Incr @pDBF.stats.MemoHeaderReads

ExitOut:
   If @xdb.errcode Then 
      Function = -1
   Else
      Function = 0
   End If
End Function



'//
'//  Write the memo header to the disk file
'//
Function ctx_WriteMemoHeader_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF As DBF_TYPE Ptr 
   
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut

   pDBF = @xdb.reserved

   If @pDBF.hFileMemo = 0 Then GoTo ExitOut
   
   ' Write the Memo header
   If fWriteAt(@pDBF.hFileMemo, 1, %MEMO_HEADER_SIZE, VarPtr(@pDBF.DBH_MEMO)) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If
   
   ' Update the stats
   Incr @pDBF.stats.MemoHeaderWrites


ExitOut:
   If @xdb.errcode Then 
      Function = -1
   Else
      Function = 0
   End If
End Function



'//
'//  Generic routine to set the internal memo buffer for a
'//  specified field. The data is set depending on whether
'//  it is supplied by the user (xdbSetField) or from the
'//  memo file itself (xdbGetField)  
'//
Function ctx_SetMemoBuffer_dBase_Internal( ByVal xdb As CHEETAH4_TYPE Ptr, _
                                           ByVal nSetMode As Long _
                                            ) As Long 
                                            
                                            
   Local pDBF        As DBF_TYPE Ptr 
   Local pField      As DBF_FIELD_TYPE Ptr
   Local nFieldNum   As Long                              
   Local sTerminator As String 
   Local sTempBlock  As String * 4096  ' enough for 8, 512 byte blocks
   Local sEntireMemo As String
   Local nRecOffset  As Long
   Local nNumBytes   As Long
   Local nFoundat    As Long
   
   pDBF = @xdb.reserved

   nFieldNum = @xdb.nData4byte - 1  ' b/c pointer array is zero based
   
   sTerminator = String$( 2, &H1A )
         
   pField = @pDBF.pFields

   
   If @pField[nFieldNum].OrigFirstBlock Then
      ' Retrieve all the blocks for this memo.
      nRecOffset = (@pField[nFieldNum].OrigFirstBlock * 512) + 1
      Do
         nNumBytes  = SizeOf(sTempBlock)
         If fGetAt( @pDBF.hFileMemo, nRecOffset, nNumBytes, VarPtr(sTempBlock) ) Then
            @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
         End If 
         nRecOffset = nRecOffset + SizeOf(sTempBlock) + 1
         
         ' Search the block for two terminating &H1A's
         nFoundat = InStr(sTempBlock, sTerminator) 
         
         If nFoundat Then
            @pField[nFieldNum].OrigNumBlocks = Ceil(nFoundat / 512)
            sEntireMemo = sEntireMemo & Left$(sTempBlock, @pField[nFieldNum].OrigNumBlocks * 512)
            Exit Do
         Else   
            sEntireMemo = sEntireMemo & sTempBlock
         End If
         
      Loop
   End If

   
   Select Case As Long nSetMode             
      
      Case %CTX_MEMO_USER
         ' Allocate memory in the Field structure to hold the memo. We
         ' add an additional two &H1A's at the end of the memo.
         @pField[nFieldNum].pMemoText = MemAlloc( @xdb.nLen + 2 )                          
         
         ' Copy the user data into the memo buffer
         MemCopyD @xdb.nData, _
                  @pField[nFieldNum].pMemoText, _
                  @xdb.nLen                         
                  
         MemCopyD StrPtr(sTerminator), _
                  @pField[nFieldNum].pMemoText + @xdb.nLen, _
                  2                         

         ' Set the parameters for this memo. 
         @pField[nFieldNum].MemoTextLength = @xdb.nLen + 2
         @pField[nFieldNum].MemoDirty      = %TRUE
         

      Case %CTX_MEMO_DISK
         @pField[nFieldNum].pMemoText      = MemAlloc( Len(sEntireMemo) )  
         MemCopyD StrPtr(sEntireMemo), _
                  @pField[nFieldNum].pMemoText, _
                  Len(sEntireMemo)
                                 
         @pField[nFieldNum].MemoTextLength = InStr(sEntireMemo, sTerminator)+1
         @pField[nFieldNum].MemoDirty      = %FALSE   ' true only when user changes it

   End Select   
   

ExitOut:
   If @xdb.errcode Then 
      Function = -1
   Else
      Function = 0
   End If

End Function



'//
'//  Generic routine to write the internal memo fields to disk. 
'//
Function ctx_WriteMemoBuffer_dBase_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
                                            
   Local pDBF        As DBF_TYPE Ptr
   Local pField      As DBF_FIELD_TYPE Ptr 
   Local pChain      As DBF_GARBAGEMEMO_TYPE Ptr
   Local x           As Long
   Local y           As Long  
   Local fUsingChain As Long
   Local nFoundat    As Long
   Local nRecOffset  As Long
   Local nNumBytes   As Long
   Local nNumBlocks  As Long                 
   Local nStartBlock As Long
   Local sStartBlock As String * 10   
   Local sTerminator As String
   
   ' Loop through the fields and output the dirty memo buffers to disk. The
   ' RecordBuffer is updated with the correct starting block number after
   ' the write is finished. This is the reason that the memo fields need to
   ' be written prior to the RecordBuffer being saved into the database.

   pDBF   = @xdb.reserved
   pField = @pDBF.pFields
      
   sTerminator = String$( 2, &H1A )

   For x = 1 To @pDBF.NumFields
          
      If @pField.MemoDirty = %TRUE Then 
         GoSub InvalidateBlocks
         GoSub WriteBlocks
      End If
      
      Incr pField
   Next
   
      
ExitOut:
   If @xdb.errcode Then 
      Function = -1
   Else
      Function = 0
   End If

Exit Function
   
   
   
InvalidateBlocks:
   ' Invalidate any existing blocks for this memo. This simply entails
   ' updating the memo garbage chain. The new blocks are written to
   ' the end of the memo file. (The garbage chain is unique to Cheetah
   ' in that it uses wasted space in the dbase memo header for storage)
   
   ' If no original number of blocks existed for this memo then it was
   ' never previously saved to disk (i.e. it is a new record, or an existing
   ' record without any previously saved memo text).
   If @pField.OrigFirstBlock = 0 Then Return  ' nothing to invalidate
   
   If @pField.OrigNumBlocks = 0 Then
      If ctx_SetMemoBuffer_dBase_Internal( xdb, %CTX_MEMO_DISK ) Then GoTo ExitOut
   End If   
   
   ' Determine where to place the deleted blocks. If there is no
   ' more room then do nothing.
   nFoundat = 0
   For y = 1 To %MAX_GARBAGECHAIN
      If @pDBF.DBH_MEMO.GarbageChain(y).BlockNumber = 0 Then
         nFoundat = y: Exit For
      End If   
   Next
   If nFoundat > 0 Then
      @pDBF.DBH_MEMO.GarbageChain(nFoundat).BlockNumber      = @pField.OrigFirstBlock
      @pDBF.DBH_MEMO.GarbageChain(nFoundat).NumGarbageBlocks = @pField.OrigNumBlocks
   End If
   
Return


WriteBlocks:
   ' Write the new data to the memo file. Use any existing deleted blocks
   ' in the garbage chain. Therefore, if the same number of blocks are
   ' needed in the new write that existed in the original data, then we
   ' are simply writing to the same blocks. If the new data is larger then
   ' the memo must be written to the end of the file.
  
   ' Determine if we are deleting an existing memo. In that case, the memo
   ' length will be zero. -2 for the two &H1A's.
   If (@pField.MemoTextLength - 2) = 0 Then
      nStartBlock = 0
      nNumBlocks  = 0
   Else   
   
      ' Get the number of blocks to write. We need to add two &H1A's at
      ' the end of the memo being written.
      nNumBlocks = Ceil( @pField.MemoTextLength / 512 )
      
      nStartBlock = @pDBF.DBH_MEMO.NextFreeBlock  ' default
   
      ' Determine the block to start writing at.
      ' Try to use a deleted chain that has the correct amount of free blocks. If
      ' the exact amount does not exist then use the one that has at least the
      ' same number of blocks as needs to be written.
      fUsingChain = %FALSE
      nFoundat = 0
      pChain   = VarPtr(@pDBF.DBH_MEMO.GarbageChain(1))
      For y = 1 To %MAX_GARBAGECHAIN
         If @pChain.NumGarbageBlocks = nNumBlocks Then
            nFoundat    = 0
            nStartBlock = @pChain.BlockNumber
            fUsingChain = %TRUE
            ' reset this garbage chain entry so that it can be re-used in the future
            @pChain.NumGarbageBlocks = 0
            @pChain.BlockNumber      = 0
            Exit For
         ElseIf @pChain.NumGarbageBlocks >= nNumBlocks Then
            nFoundat = y
         End If   
         Incr pChain
      Next  
      
      ' Adjust a found garbage chain that contains more blocks
      ' then we need to write.
      If nFoundat > 0 Then
         fUsingChain = %TRUE
         nStartBlock = @pDBF.DBH_MEMO.GarbageChain(nFoundat).BlockNumber 
         @pDBF.DBH_MEMO.GarbageChain(nFoundat).BlockNumber = _
               @pDBF.DBH_MEMO.GarbageChain(nFoundat).BlockNumber + nNumBlocks
         @pDBF.DBH_MEMO.GarbageChain(nFoundat).NumGarbageBlocks =  _
               @pDBF.DBH_MEMO.GarbageChain(nFoundat).NumGarbageBlocks - nNumBlocks
      End If
      
      nRecOffset = (nStartBlock * 512) + 1
      nNumBytes  = @pField.MemoTextLength
      If fWriteAt( @pDBF.hFileMemo, nRecOffset, nNumBytes, @pField.pMemoText ) Then
         @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
      End If
   
      If fUsingChain = %FALSE Then
         @pDBF.DBH_MEMO.NextFreeBlock = @pDBF.DBH_MEMO.NextFreeBlock + nNumBlocks                                                               
      End If
   
   End If
   
   ' Write the memo header to disk.
   If ctx_WriteMemoHeader_Internal( xdb ) Then GoTo ExitOut
   
   ' Update the RecordBuffer with the starting block number.
   RSet sStartBlock = Format$(nStartBlock)
   MemCopyD VarPtr(sStartBlock), _
            @pDBF.pRecordBuffer + @pField.FDA, _
            Len(sStartBlock)
   
   ' Update the Field structure with the new saved memo data.
   @pField.OrigFirstBlock = nStartBlock
   @pField.OrigNumBlocks  = nNumBlocks
                                                                  
Return

End Function


