UNIT FlexTdb;

{ This unit uses one binary file to store multiple blocks of information}
{ with none-uniform lengths. Each block is preceded by its length and   }
{ type so it can be skipped over and searched for by type.              }
{                                                                       }
{ It uses one fixed-filename TDB file right now, but can be extended    }
{ look like the TDB unit and allow for multiple files.                  }
{                                                                       }
{ This unit uses the Tdb, Log and Cfg units and expects the             }
{ Config.SystemDir to be available.                                     }

INTERFACE

CONST NILPos : LONGINT = $FFFFFFFF;
      FLEX_NOTUSED     = $0000;      { record type }

FUNCTION  FlexTdb_Open : BOOLEAN;
PROCEDURE FlexTdb_Close;
FUNCTION  FlexTdb_ReadFirst (RecordType : WORD; VAR Buffer; Length : WORD; VAR Pos : LONGINT) : BOOLEAN;
FUNCTION  FlexTdb_ReadNext (VAR Pos : LONGINT; VAR Buffer) : BOOLEAN;
PROCEDURE FlexTdb_Read (Length : WORD; Pos : LONGINT; VAR Buffer);
FUNCTION  FlexTdb_Write (RecordType : WORD; Length : WORD; VAR Pos : LONGINT; VAR Buffer) : BOOLEAN;
PROCEDURE FlexTdb_Erase (Pos : LONGINT);
FUNCTION  FlexTdb_Pack : BOOLEAN;

VAR FlexFilename : STRING[80]; { for IGNORE_SYSTEMDIR warning screen }


IMPLEMENTATION

USES Tdb,
     Logs,
     Cfg,
     Ramon,
     Globals;

CONST FLEX_FILENAME = 'CONFIG.TDB';
      FLEX_HEADER   = 'WaterGate Flex Config v01'#26;

TYPE FlexHeaderRecord = RECORD
                              Length   : WORD;  { including header }
                              FlexType : WORD;  { one of FLEX_* }
                        END;

VAR FlexFile : FILE;

{--------------------------------------------------------------------------}
{ FlexTdb_Open                                                             }
{                                                                          }
{ This routine tries to open the flex database. Returns FALSE on error,    }
{ TRUE on success. Errors are logged. If the flex database does not exist  }
{ and this is WtrConf, then an attempt is made to create it.               }
{                                                                          }
FUNCTION FlexTdb_Open : BOOLEAN;

VAR IORes  : BYTE;
    Header : STRING[30];

BEGIN
     FlexTdb_Open:=FALSE; { assume error }

     FlexFilename:=Config.SystemDir+FLEX_FILENAME;

     Assign (FlexFile,FlexFilename);
     {$I-} Reset (FlexFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          FlexFilename:=FLEX_FILENAME;

          Assign (FlexFile,FlexFilename); { in current directory }
          {$I-} Reset (FlexFile,1); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               FlexFilename:=Config.SystemDir+FLEX_FILENAME;

               Assign (FlexFile,FlexFilename);
               {$I-} ReWrite (FlexFile,1); {$I+} IORes:=IOResult;
               IF (IORes = 0) THEN
               BEGIN
                    Header:=FLEX_HEADER;
                    BlockWrite (FlexFile,Header[1],26);
               END;
          END;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          WriteLn ('þ Cannot open ',Config.SystemDir,FLEX_FILENAME);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (FlexFile);{$ENDIF}

     { read and compare the header }
     Seek (FlexFile,0);
     BlockRead (FlexFile,Header[1],26);
     Header[0]:=#26;

     IF (Header <> FLEX_HEADER) THEN
     BEGIN
          WriteLn ('þ Incompatible database type for '+FLEX_FILENAME);

          {$IFDEF LogFileIO}PreCloseF (Flexfile);{$ENDIF}
          Close (FlexFile);
          Exit;
     END;

     FlexTdb_Open:=TRUE;
END;


{--------------------------------------------------------------------------}
{ FlexTdb_Close                                                            }
{                                                                          }
{ This routine closes the flex database.                                   }
{                                                                          }
PROCEDURE FlexTdb_Close;
BEGIN
     {$IFDEF LogFileIO}PreCloseF (Flexfile);{$ENDIF}
     Close (FlexFile);
END;


{--------------------------------------------------------------------------}
{ FlexTdb_ReadFirst                                                        }
{                                                                          }
{ This routine can be used to find and then read from disk a flex block by }
{ its record type. The file is searched from the start and if found, the   }
{ first block is loaded into the buffer. If the length does not match,     }
{ then it is not loaded, but an error will be logged. The position from    }
{ which the block was loaded is also return, so it can be used to update   }
{ the block via FlexTdb_Write or for searching the next block of the same  }
{ type using FlexTdb_ReadNext.                                             }
{                                                                          }
FUNCTION FlexTdb_ReadFirst (RecordType : WORD; VAR Buffer; Length : WORD; VAR Pos : LONGINT) : BOOLEAN;

VAR EndOfFile : LONGINT;
    FlexHdr   : FlexHeaderRecord;
    IORes     : BYTE;

BEGIN
     FlexTdb_ReadFirst:=FALSE; { assume failure }

     Pos:=26; { just after the header }
     EndOfFile:=FileSize (FlexFile)-SizeOf (FlexHeaderRecord);

     WHILE (Pos < EndOfFile) DO
     BEGIN
          Seek (FlexFile,Pos);
          {$I-} BlockRead (FlexFile,FlexHdr,SizeOf (FlexHeaderRecord)); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             Exit;

          IF (FlexHdr.FlexType = RecordType) THEN
          BEGIN
               { found an entry! }

               IF (Length <> FlexHdr.Length-SizeOf (FlexHeaderRecord)) THEN
               BEGIN
                    LogMessage (liDebug,'[ReadFirst] Wrong flex length at '+Longint2String (Pos)+
                                ', type '+Word2HexString (RecordType)+
                                ', len '+Word2String (Length));
                    Exit; { with FALSE }
               END;

               { read the record itself }
               BlockRead (FlexFile,Buffer,Length);

               FlexTdb_ReadFirst:=TRUE; { succes }
               Exit;
          END;

          { not found, keep on searching }
          Inc (Pos,FlexHdr.Length);
     END; { while }

     { end of file reached, nothing found }
     Pos:=NILPos;

     { return with FALSE }
END;


{--------------------------------------------------------------------------}
{ FlexTdb_ReadNext                                                         }
{                                                                          }
{ This routine can be used after a succesful ReadFirst. The next block of  }
{ the same type and length is searched and loaded from disk. If nothing    }
{ more was found, FALSE is returned and Pos will be set to NILPos.         }
{                                                                          }
FUNCTION FlexTdb_ReadNext (VAR Pos : LONGINT; VAR Buffer) : BOOLEAN;

VAR EndOfFile : LONGINT;
    FirstHdr,
    FlexHdr   : FlexHeaderRecord;
    IORes     : BYTE;

BEGIN
     FlexTdb_ReadNext:=FALSE; { assume error }

     EndOfFile:=FileSize (FlexFile)-SizeOf (FlexHeaderRecord);

     IF (Pos >= EndOfFile) THEN
     BEGIN
          LogMessage (liDebug,'[ReadNext] Invalid flex pos on entry');
          Pos:=NILPos;
     END;

     IF (Pos = NILPos) THEN
        Exit;

     { read this record header and jump to the next block }
     {$I-}
     Seek (FlexFile,Pos);
     BlockRead (FlexFile,FirstHdr,SizeOf (FlexHeaderRecord));
     {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        Exit; { with FALSE }

     Inc (Pos,FirstHdr.Length);

     WHILE (Pos < EndOfFile) DO
     BEGIN
          {$I-}
          Seek (FlexFile,Pos);
          BlockRead (FlexFile,FlexHdr,SizeOf (FlexHeaderRecord));
          {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             Exit; { with FALSE }

          IF (FlexHdr.FlexType = FirstHdr.FlexType) THEN
          BEGIN
               { found an entry! }

               IF (FlexHdr.Length <> FirstHdr.Length) THEN
               BEGIN
                    LogMessage (liDebug,'[ReadNext] Wrong flex length at '+Longint2String (Pos)+
                                ', type '+Word2HexString (FirstHdr.FlexType)+
                                ', 1stlen '+Word2String (FirstHdr.Length));
                    Exit; { with FALSE }
               END;

               { read the record itself }
               {$I-} BlockRead (FlexFile,Buffer,FlexHdr.Length-SizeOf (FlexHeaderRecord)); {$I+} IORes:=IOResult;
               IF (IORes = 0) THEN
                  FlexTdb_ReadNext:=TRUE; { succes }

               Exit;
          END;

          { not found, keep on searching }
          Inc (Pos,FlexHdr.Length);
     END; { while }

     { reached end of file; nothing found }
     Pos:=NILPos;

     { return with FALSE }
END;


{--------------------------------------------------------------------------}
{ FlexTdb_Read                                                             }
{                                                                          }
{ This routine reads a flex record from the given position. This can be    }
{ used when readfirst/next has been used to fill a list and the user has   }
{ selected an item.                                                        }
{                                                                          }
PROCEDURE FlexTdb_Read (Length : WORD; Pos : LONGINT; VAR Buffer);
BEGIN
     Seek (FlexFile,Pos+SizeOf (FlexHeaderRecord));
     BlockRead (FlexFile,Buffer,Length);
END;


{--------------------------------------------------------------------------}
{ FlexTdb_Write                                                            }
{                                                                          }
{ This routine writes a flex block to disk. A pointer to the buffer plus   }
{ the length of the data is given. If the record was previously read from  }
{ disk, then it is straight written back there. It must therefore be of    }
{ the same length. If it was not read from disk before, then NILPos should }
{ be given instead, in which case the actual position is returned in Pos.  }
{                                                                          }
FUNCTION FlexTdb_Write (RecordType : WORD; Length : WORD; VAR Pos : LONGINT; VAR Buffer) : BOOLEAN;

VAR FlexHdr : FlexHeaderRecord;
    IORes   : BYTE;

BEGIN
     IF (Pos < 0) OR (Pos >= FileSize (FlexFile)) THEN
        Pos:=FileSize (FlexFile);

     Seek (FlexFile,Pos);

     { write a header }
     {$I-}
     FlexHdr.FlexType:=RecordType;
     FlexHdr.Length:=Length+SizeOf (FlexHeaderRecord);
     BlockWrite (FlexFile,FlexHdr,SizeOf (FlexHeaderRecord));

     { write the data }
     BlockWrite (FlexFile,Buffer,Length);
     {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error writing to flex file');

     FlexTdb_Write:=(IORes = 0);
END;


{--------------------------------------------------------------------------}
{ FlexTdb_Erase                                                            }
{                                                                          }
{ This routine frees a block in the flex database. It is set to            }
{ FLEX_NOTUSED and will be removed by the Pack Databases process.          }
{                                                                          }
PROCEDURE FlexTdb_Erase (Pos : LONGINT);

VAR FlexHdr : FlexHeaderRecord;

BEGIN
     Seek (FlexFile,Pos);
     BlockRead (FlexFile,FlexHdr,SizeOf (FlexHeaderRecord));

     FlexHdr.FlexType:=FLEX_NOTUSED;

     Seek (FlexFile,Pos);
     BlockWrite(FlexFile,FlexHdr,SizeOf (FlexHeaderRecord));
END;


{--------------------------------------------------------------------------}
{ FlexTdb_Pack                                                             }
{                                                                          }
{ This routine "packs" the flex config database. It creates a backup copy  }
{ as ".OLD" and builds a new one with all the old records, except for      }
{ the ones with FLEX_NOTUSED as type. Returns TRUE on success, otherwise   }
{ FALSE.                                                                   }
{                                                                          }
FUNCTION FlexTdb_Pack : BOOLEAN;

VAR NewFlex : FILE;
    NewName : STRING;
    IORes   : BYTE;
    Header  : STRING[30];
    FlexHdr : FlexHeaderRecord;
    Buffer  : POINTER;
    RecCnt,
    DelCnt  : WORD;
    Improve : BYTE;

BEGIN
     FlexTdb_Pack:=FALSE; { assume error }

     FlexFilename:=Config.SystemDir+FLEX_FILENAME;

     Assign (FlexFile,FlexFilename);
     {$I-} Reset (FlexFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error opening '+FlexFilename);
          Exit;
     END;

     { read and compare the header }
     Seek (FlexFile,0);
     BlockRead (FlexFile,Header[1],26);
     Header[0]:=#26;

     IF (Header <> FLEX_HEADER) THEN
     BEGIN
          LogMessage (liFatal,'Incompatible database type for '+FLEX_FILENAME);
          Close (FlexFile);
          Exit;
     END;

     { make sure there is no .OLD copy hanging around and disturbing }
     { the rename below.                                             }
     NewName:=Copy (FlexFilename,1,Length (FlexFilename)-3)+'OLD';
     Assign (NewFlex,NewName);
     {$I-} Erase (NewFlex); {$I+} IORes:=IOResult;
     IF (IORes <> 0) AND (IORes <> 2) THEN
     BEGIN
          LogDiskIOError (IORes,'Error removing '+NewName);
          Close (FlexFile);
          Exit;
     END;

     NewName:=Copy (FlexFilename,1,Length (FlexFilename)-3)+'$$$';

     Assign (NewFlex,NewName);
     {$I-} ReWrite (NewFlex,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error creating '+NewName);
          Close (FlexFile);
          Exit;
     END;

     GetMem (Buffer,10000);

     Seek (FlexFile,0);
     BlockRead (FlexFile,Header[1],26);

     BlockWrite (NewFlex,Header[1],26);

     RecCnt:=0;
     DelCnt:=0;

     WHILE (FilePos (FlexFile) < FileSize (FlexFile)) DO
     BEGIN
          Inc (RecCnt);
          BlockRead (FlexFile,FlexHdr,SizeOf (FlexHeaderRecord));
          BlockRead (FlexFile,Buffer^,FlexHdr.Length-SizeOf (FlexHeaderRecord));

          IF (FlexHdr.FlexType <> FLEX_NOTUSED) THEN
          BEGIN
               BlockWrite (NewFlex,FlexHdr,SizeOf (FlexHeaderRecord));
               BlockWrite (NewFlex,Buffer^,FlexHdr.Length-SizeOf (FlexHeaderRecord));
          END ELSE
              Inc (DelCnt);
     END;

     FreeMem (Buffer,10000);

     Close (NewFlex);
     Close (FlexFile);

     { rename .TDB to .OLD }
     NewName:=Copy (FlexFilename,1,Length (FlexFilename)-3)+'OLD';

     {$I-} Rename (FlexFile,NewName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to rename '+FlexFilename+' to .OLD');
          Exit;
     END;

     { rename .$$$ to .TDB }
     {$I-} Rename (NewFlex,FlexFilename); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to rename .$$$ to '+FlexFilename);
          Exit;
     END;

     IF (RecCnt = 0) THEN
        Improve:=0
     ELSE
         Improve:=Round (DelCnt/RecCnt*100);

     LogExtraMessage ('          Config: deleted '+AddUpWithSpaces (5,Word2String (DelCnt))+
                      ' out of '+AddUpWithSpaces (5,Word2String (RecCnt))+
                      ' records: '+Byte2String (Improve)+'%');

     FlexTdb_Pack:=TRUE; { no error }
END;


END.
