Power-Programmierung/CD1.mdf/pascal/library/dos/btree/tree/lreclist.pas

Pascal/Delphi Source File | 1989-07-15 | 28.6 KB | 740 lines

(* TBTree16            Copyright (c)  1988,1989       Dean H. Farwell II    *)

unit LRecList;

(****************************************************************************)
(*                                                                          *)
(*                 L O G I C A L   L I S T   R O U T I N E S                *)
(*                                                                          *)
(****************************************************************************)

(* These routines handle logical record lists.  These lists are used to hold
   a list of logical record numbers.  Once a list is created logical records
   can be added to the list, the list can be traversed beginning to end or
   back to front and the list can be destroyed.  Additionally, entries can be
   deleted from the list. This list, in conjunction with retrieval routines in
   the BTREE unit allows a list to be built that fulfills some user specified
   criteria.  The list will exist until the user destroys it.  A routine is
   provided for destroying a list and this should be done explicitly for
   reasons which will become clear later.  A user can have many lists in
   existence at once.  You can make a copy of a list.  Two list could be
   combined (intersection or union) to create a third list if the user
   desires.  Routines to combine lists in this way are provided in another
   unit.  These lists give power that simply traversing the BTree does not.

   The implementation of these lists is not very straightforward.  I
   first developed this unit by creating a giant linked list of
   record numbers which would be kept on the heap.  It was extremely
   straightforward but had the problem of being at the mercy of heap size.
   In a large database these lists could easily overflow the heap.  I reworked
   the problem and came up with this solution.  It stores the logical record
   numbers in an array the size of a page in the page buffer.  If all the
   record numbers will fit in one page then the list is kept in memory.  If
   not then a temporary file is created and all but the current page is kept
   in the page buffer (or out on disk if a page gets swapped out).  This is
   all transparent to the user except that large lists will experience some
   performance degredation.  The good news is that the logical record lists
   can hold MAXLONGINT (over 2 billion) entries, one for every possible
   logical record number.  (You would really run out of disk space sooner than
   ever coming close to that limit).

   Since a temporary file may be created it is important that the user call
   DestroyLrList when completed with the list.  Any file created will be
   deleted.  Otherwise some strange files might show up on the disk.  All
   files created will have an extension of 'LRF'.  You should avoid using LRF
   as an extension in your applications, although everything will still work
   properly if you do.

   note - Hopefully, I have given the user a rich set of routines which can
   be used with the lists.  It is not in the user's best interest to access
   fields in the lists directly.  Use the routines provided.  This will guard
   against problems if the implementation section is ever changed.           *)

(*\*)
(* Version Information

   Version 1.1 - Added DeleteFromLrList routine to delete entries from
                 logical records list

               - Changed the routines so that if a cursor is invalid (does
                 not point to a valid entry, a 0 is returned when a
                 record number is requested.  This is true for the GetNextLr,
                 GetPrevLr and GetCurrLr routines.  This shouldn't affect
                 anything that you were previously doing.

   Version 1.2 - Added LRArraySize type

               - Added FindLargestLr routine

               - Added DesiredPosition routine

               - Added DesiredPage routine

               - Made a couple of minor changes internally (simplified code
                 using DesiredPosition and DesiredPage)

   Version 1.3 - Added FindLrInList routine

   Version 1.4 - Changed way of assigning file names to a logical record list
                 file.  This change removes any restrictions on the number of
                 logical record lists that can be created.  For details on how
                 this is handled, see the code within the implementation
                 section.  However, you probably don't need to explore the
                 details unless you are curious.

               - Made internal changes due to changes in the FILES unit.

               - Functionally, all routines provided still work the same

   Version 1.5 - Changed code internally to use Inc and Dec where practical

               - Added CopyLrList routine

   Version 1.6 - No Changes                                                  *)

(*\*)
(*////////////////////////// I N T E R F A C E //////////////////////////////*)

interface

uses
    FileDecs,
    Files,
    Numbers,
    Page;

const
    LRARRAYSIZE = 128;                (* This needs to be PAGESIZE / RNSIZE *)
                                           (* it is presently 512 / 4 = 128 *)

type
    LRArrayRange = 1 .. LRARRAYSIZE;

    LogicalRecordsArray = Array [LRArrayRange] of LrNumber;
                                          (* this array must be same size (same
                                             number of bytes) as a page in
                                             the page buffer                 *)

    LrList = record            (* type which is used to hold a list of logical
                                                              record numbers *)
             fName    : FnString;            (* holds name of file if needed *)
             currPage : PrNumber;                 (* current page in lrArray *)
                                              (* first page used is always 1 *)
             current  : LrNumber;                   (* current place in list *)
             count    : LrNumber;       (* number of logical records in list *)
             case Boolean of
             TRUE  : (lrArray  : LogicalRecordsArray);
             FALSE : (page : SinglePage);
             end;


(* This routine will create a logical record list.  It will accomplish this by
   initializing the logical record page to all zeros and will set the count to
   zero, the current (cursor) to zero and the current page to one.  To create
   an empty list simply call this with a variable declared as type LrList.   *)

procedure CreateLrList(var lrLst : LrList);


(* This routine will create a new logical record list (destLrLst) which is an
   exact duplicate of the sourceLrLst.  You must use this routine to copy a
   list.  Do not simply use a statement such as destLrLst := soureLrLst since
   this will not work properly since part of a list may reside in a disk file
   and not entirely in an lrLst variable.                                    *)

procedure CopyLrList(sourceLrLst : lrList;
                     var destLrLst : LrList);

(*\*)
(* This routine will add a logical record number to the end of a logical record
   list.  It will update the cursor position to the newly added record.
   It will increment the count by one.                                       *)

procedure AddToLrList(lrNum : LrNumber;
                      var lrLst : LrList);


(* This routine will delete an entry from a logical record list.  It is useful
   when deleting records in the case where you do not want to have to recreate
   a list after doing the delete.  It is important to realize two things when
   using this routine.  The first is that it does nothing whatsoever to data
   or index files.  It only affects the logical records list.  Secondly, it
   is faster than recreating a list each time a delete is done, but for
   large lists, it still takes time to perform the delete from the list.
   If a large number of deletes are anticipated, it might be faster to do the
   deletes on the data and index files and then do another retrieval thus
   creating the new list only once.  This routine deletes the current entry
   only ie entry at the cursor.

   One note before using this routine - You must be aware of what is
   happening to the cursor.  When this routine deletes the current logical
   record the cursor must be positioned somewhere.  The routine put the
   cursor at the first entry past the deleted entry.  This is now the new
   current entry.  To retrieve it use GetCurrLr not GetNextLr.  In other
   words, when traversing a list from start to finish and deleting the
   entries as you go, to get to the next entry use GetCurrLr.  Use GetPrevLr
   if you are going from the end of the list to the front.                   *)

procedure DeleteFromLrList(var lrLst : LrList);


(* This routine will destroy a logical record list.  It will delete the file
   holding the logical record list if the file was ever created              *)

procedure DestroyLrList(var lrLst : LrList);


(* This routine will return the first logical record in a logical record list
   and set the cursor to the front of the list.  If the list is empty 0 will
   be returned instead.                                                      *)

function GetFirstLr(var lrLst : LrList) : LrNumber;


(* This routine will get the last logical record number in a logical record list
   and set the cursor to the back of the list.  If the list is empty then
   0 will be returned instead.  This routine should be used for traversing
   the list in reverse order.                                                *)

function GetLastLr(var lrLst : LrList) : LrNumber;

(*\*)
(* This routine is used to get the next logical record number in a logical list.
   The cursor will be set to this record list cell as well.  This is used to
   traverse the list in a forward manner.  The routine will return the logical
   record number or 0 if the list is exhausted or the cursor position is
   invalid.                                                                  *)

function GetNextLr(var lrLst : LrList) : LrNumber;


(* This routine is used to get the previous logical record number in a logical
   list.  The cursor will be updated to point to this entry.  This is used
   to traverse the list in a backward manner.  The routine will return the
   logical record number or 0 if the list is exhausted or the cursor position
   is invalid.                                                               *)

function GetPrevLr(var lrLst : LrList) : LrNumber;


(* This routine is used to get the current logical record in a logical list.
   It will not update the cursor position.  It will return 0 if the cursor
   position is not valid                                                     *)

function GetCurrLr(lrLst : LrList) : LrNumber;


(* This routine returns the number of logical records currently in the logical
   record list                                                               *)

function GetCountLr(lrLst : LrList) : LrNumber;

(*\*)
(* This routine will return the correct physical record number (for the logical
   record list) where the entry lrPos is found                               *)

function DesiredPage(lrPos : LrNumber) : PrNumber;


(* This routine will return the position within a logical records array for
   given lrPos                                                               *)

function DesiredPosition(lrPos : LrNumber) : LRArrayRange;


(* This routine will return the largest logical record number within a logical
   record list.                                                              *)

function FindLargestLr(lrLst : LrList) : LrNumber;


(* This routine will look for a logical record number in a logical record list.
   It will return TRUE if the record number is in the list and FALSE
   otherwise.                                                                *)

function FindLrInList(lr : LrNumber;
                      lrLst : LrList) : Boolean;

(*!*)
(*\*)
(*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)

implementation

(* This routine will return a file name which is not being used.  It
   accomplishes this by assigning a random file name ending with an extension
   of LRF.  Then, a check is performed to see if that particular file exists.
   If it does not exist, the file is available for use and the file name is
   returned for use as the file name for a newly created logical record list
   file.  If a file by that name exists, a new random file name is produced.
   This process continues until an available file name is found.             *)

function GetUnusedFileName : FnString;

var
    tempRandomFName : FnString;
    tempString : String[5];
    RandomPart : Word;
    done : Boolean;

    begin
    done := FALSE;
    while not done do
        begin
        randomPart := Random(MAXWORD - 1) + 1;
        Str(randomPart:5,tempString);
        tempRandomFName := 'xxx' + tempString + '.LRF';
        done := not FileExists(tempRandomFName);
        end;
    GetUnusedFileName := tempRandomFName;
    end;                                 (* end of GetUnusedFileName routine *)

(*\*)
(* This routine will create a logical record list.  It will accomplish this by
   initializing the logical record page to all zeros and will set the count to
   zero, the current (cursor) to zero and the current page to one.  To create
   an empty list simply call this with a variable declared as type LrList.   *)

procedure CreateLrList(var lrLst : LrList);

    begin
    lrLst.fName := '';        (* null file name since one does not yet exist *)
    lrLst.currPage := 1;
    lrLst.current := 0;
    lrLst.count := 0;
    FillChar(lrLst.page,PAGESIZE,0);
    end;                                      (* end of CreateLrList routine *)

(* This routine will create a new logical record list (destLrLst) which is an
   exact duplicate of the sourceLrLst.  You must use this routine to copy a
   list.  Do not simply use a statement such as destLrLst := soureLrLst since
   this will not work properly since part of a list may reside in a disk file
   and not entirely in an lrLst variable.                                    *)

procedure CopyLrList(sourceLrLst : lrList;
                     var destLrLst : LrList);

var
    cnt : PrNumber;

    begin
    destLrLst := sourceLrLst;
    if destLrLst.count > LRARRAYSIZE then
        begin
        destLrLst.fName := GetUnusedFileName;
        CreateGenericFile(destLrLst.fName);
        for cnt := 1 to DesiredPage(sourceLrLst.count) do
            begin
            FetchPage(sourceLrLst.fName,cnt,destLrLst.page);
            StorePage(destLrLst.fName,cnt,destLrLst.page);
            end;
        FetchPage(destLrLst.fName,destLrLst.currPage,destLrLst.page);
        end;
    end;                                        (* end of CopyLrList routine *)

(*\*)
(* This routine will add a logical record number to the end of a logical record
   list.  It will update the cursor position to the newly added record.
   It will increment the count by one.                                       *)

procedure AddToLrList(lrNum : LrNumber;
                      var lrLst : LrList);

var
    tempPage : PrNumber;

    begin
    if lrLst.count = 0 then
        begin                                           (* list is now empty *)
        lrLst.count := 1;
        lrLst.lrArray[1] := lrNum;
        lrLst.current := 1;
        end
    else
        begin
        lrLst.current := lrLst.count;                   (* put cursor at end *)
        tempPage := DesiredPage(lrLst.current);
        if lrLst.currPage <> tempPage then    (* make sure last page current *)
            begin
            lrLst.currPage := tempPage;
            FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        if lrLst.current Mod LRARRAYSIZE = 0 then           (* check if full *)
            begin
            if lrLst.currPage = 1 then
                begin        (* create the file for the logical records list *)
                lrLst.fName := GetUnusedFileName;
                CreateGenericFile(lrLst.fName);
                StorePage(lrLst.fName,1,lrLst.page);
                end;
            Inc(lrLst.currPage);
            FillChar(lrLst.page,PAGESIZE,0);
            end;
        Inc(lrLst.current);
        Inc(lrLst.count);
        lrLst.lrArray[DesiredPosition(lrLst.current)] := lrNum;
        if lrLst.currPage > 1 then
            begin
            StorePage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        end;
    end;                                       (* end of AddToLrList routine *)

(*\*)
(* This routine will delete an entry from a logical record list.  It is useful
   when deleting records in the case where you do not want to have to recreate
   a list after doing the delete.  It is important to realize two things when
   using this routine.  The first is that it does nothing whatsoever to data
   or index files.  It only affects the logical records list.  Secondly, it
   is faster than recreating a list each time a delete is done, but for
   large lists, it still takes time to perform the delete from the list.
   If a large number of deletes are anticipated, it might be faster to do the
   deletes on the data and index files and then do another retrieval thus
   creating the new list only once.  This deletes the current entry only ie
   entry at the cursor.                                                      *)

procedure DeleteFromLrList(var lrLst : LrList);

var
    tempLrNum : LrNumber;
    newLst,
    tempLst : LrList;

    begin
    CreateLrList(newLst);
    tempLst := lrLst;
    tempLrNum := GetFirstLr(tempLst);
    while tempLrNum <> 0 do                                (* build new list *)
        begin
        if tempLst.current <> lrLst.current then
            begin
            AddToLrList(tempLrNum,newLst);
            end;
        tempLrNum := GetNextLr(tempLst);
        end;
    if lrLst.current = lrLst.count then     (* check to see if deleted entry
                                               is at the end of the list     *)
        begin                                   (* if so make cursor invalid *)
        newLst.currPage := 1;
        newLst.current := 0;
        end
    else
        begin
        newLst.currPage := lrLst.currPage;        (* get new cursor position *)
        newLst.current := lrLst.current;
        end;
    DestroyLrList(lrLst);                             (* get rid of old list *)
    lrLst := newLst;                                      (* return new list *)
    end;                                  (* end of DeleteFromLrList routine *)

(*\*)
(* This routine will destroy a logical record list.  It will delete the file
   holding the logical record list if the file was ever created              *)

procedure DestroyLrList(var lrLst : LrList);

    begin
    lrLst.currPage := 1;
    lrLst.current := 0;
    lrLst.count := 0;
    FillChar(lrLst.page,PAGESIZE,0);
    if lrLst.fName <> '' then
        begin
        DeleteGenericFile(lrLst.fName);
        lrLst.fName := '';
        end;
    end;                                     (* end of DestroyLrList routine *)


(* This routine will return the first logical record in a logical record list
   and set the cursor to the front of the list.  If the list is empty 0 will
   be returned instead.                                                      *)

function GetFirstLr(var lrLst : LrList) : LrNumber;

    begin
    if lrLst.count = 0 then
        begin
        GetFirstLr := 0;
        end
    else
        begin
        lrLst.current := 1;
        if lrLst.currPage <> 1 then
            begin
            FetchPage(lrLst.fName,1,lrLst.page);
            lrLst.currPage := 1;
            end;
        GetFirstLr := lrLst.lrArray[1];
        end;
    end;                                        (* end of GetFirstLr routine *)

(*\*)
(* This routine will get the last logical record number in a logical record list
   and set the cursor to the back of the list.  If the list is empty then
   0 will be returned instead.  This routine should be used for traversing
   the list in reverse order.                                                *)

function GetLastLr(var lrLst : LrList) : LrNumber;

var
    temp : PrNumber;

    begin
    if lrLst.count = 0 then
        begin
        GetLastLr := 0;
        end
    else
        begin
        lrLst.current := lrLst.count;
        temp := DesiredPage(lrLst.current);
        if lrLst.currPage <> temp then
            begin
            lrLst.currPage := temp;
            FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        GetLastLr := lrLst.lrArray[DesiredPosition(lrLst.current)];
        end;
    end;                                         (* end of GetLastLr routine *)


(* This routine is used to get the next logical record number in a logical list.
   The cursor will be set to this record list cell as well.  This is used to
   traverse the list in a forward manner.  The routine will return the logical
   record number or 0 if the list is exhausted.                              *)

function GetNextLr(var lrLst : LrList) : LrNumber;

    begin
    if (lrLst.current = lrLst.count) or
       (lrLst.current = 0) then
        begin
        GetNextLr := 0;
        end
    else
        begin
        if lrLst.current Mod LRARRAYSIZE  = 0 then
            begin
            Inc(lrLst.currPage);
            FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        Inc(lrLst.current);
        GetNextLr := lrLst.lrArray[DesiredPosition(lrLst.current)];
        end;
    end;                                         (* end of GetNextLr routine *)

(*\*)
(* This routine is used to get the previous logical record number in a logical
   list.  The cursor will be updated to point to this entry.  This is used
   to traverse the list in a backward manner.  The routine will return the
   logical record number or 0 if the list is exhausted or the cursor position
   is invalid.                                                               *)

function GetPrevLr(var lrLst : LrList) : LrNumber;

    begin
{    if lrLst.current in [0,1] then}
     if (lrLst.current = 0) or (lrLst.current = 1) then
        begin
        GetPrevLr := 0;
        end
    else
        begin
        if (lrLst.current - 1) Mod LRARRAYSIZE  = 0 then
            begin
            Dec(lrLst.currPage);
            FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        Dec(lrLst.current);
        GetPrevLr := lrLst.lrArray[DesiredPosition(lrLst.current)];
        end;
    end;                                         (* end of GetPrevLr routine *)


(* This routine is used to get the current logical record in a logical list.
   It will not update the cursor position.  It will return 0 if the cursor
   position is not valid                                                     *)

function GetCurrLr(lrLst : LrList) : LrNumber;

    begin
    if lrLst.current = 0 then
        begin
        GetCurrLr := 0;
        end
    else
        begin
        GetCurrLr := lrLst.lrArray[DesiredPosition(lrLst.current)];
        end;
    end;                                         (* end of GetCurrLr routine *)

(*\*)
(* This routine returns the number of logical records currently in the logical
   record list                                                               *)

function GetCountLr(lrLst : LrList) : LrNumber;

    begin
    GetCountLr := lrLst.count;
    end;                                        (* end of GetCountLr routine *)


(* This routine will return the correct physical record number (for the logical
   record list) where the entry lrPos is found                               *)

function DesiredPage(lrPos : LrNumber) : PrNumber;

    begin
    DesiredPage := ((lrPos - 1) DIV LRARRAYSIZE) + 1;
    end;                                       (* end of DesiredPage routine *)


(* This routine will return the position within a logical records array for
   given lrPos                                                               *)

function DesiredPosition(lrPos : LrNumber) : LRArrayRange;

    begin
    DesiredPosition := ((lrPos - 1) MOD LRARRAYSIZE) + 1;
    end;                                   (* end of DesiredPosition routine *)

(*\*)
(* This routine will return the largest logical record number within a logical
   record list.                                                              *)

function FindLargestLr(lrLst : LrList) : LrNumber;

var
    tempMax,
    max : LrNumber;
    pageCnt,
    lastPage : PrNumber;

    function FindMaxLrInPage(cnt : LRArrayRange) : LrNumber;

    var
        max : LrNumber;
        tempCnt : LRArrayRange;

    begin
    max := 0;
    for tempCnt := 1 to cnt do
        begin
        if lrLst.lrArray[tempCnt] > max then
            begin
            max := lrLst.lrArray[tempCnt];
            end;
        end;
    FindMaxLrInPage := max;
    end;                                   (* end of FindMaxLrInPage routine *)

    begin
    max := 0;
    if lrLst.count <> 0 then
        begin
        if lrLst.fName = '' then
            begin
            max := FindMaxLrInPage(lrLst.count);
            end
        else
            begin
            lastPage := DesiredPage(lrLst.count);
            for pageCnt := 1 to lastPage do
                begin
                FetchPage(lrLst.fName,pageCnt,lrLst.page);
                if pageCnt < lastPage then
                    begin
                    tempMax := FindMaxLrInPage(LRARRAYSIZE);
                    end
                else
                    begin
                    tempMax := FindMaxLrInPage(lrLst.count -
                                               ((pageCnt - 1) * LRARRAYSIZE));
                    end;
                if tempMax > max then
                    begin
                    max := tempMax;
                    end;
                end;
            if LrLst.currPage <> lastPage then
                begin
                FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
                end;
            end;
        end;
    FindLargestLr := max;
    end;                                             (* end of FindLargestLr *)

(*\*)
(* This routine will look for a logical record number in a logical record list.
   It will return TRUE if the record number is in the list and FALSE
   otherwise.                                                                *)

function FindLrInList(lr : LrNumber;
                      lrLst : LrList) : Boolean;

var
    pageEntries : LRArrayRange;
    pageCnt,
    lastPage : PrNumber;

    function FindLrInPage(pageEntries : LRArrayRange) : Boolean;

    var
        tempCnt : LRArrayRange;

    begin
    for tempCnt := 1 to pageEntries do
        begin
        if lrLst.lrArray[tempCnt] = lr then
            begin
            FindLrInPage := TRUE;
            Exit;
            end;
        end;
    FindLrInPage := FALSE;
    end;                                   (* end of FindMaxLrInPage routine *)

    begin
    if lrLst.count <> 0 then
        begin
        if lrLst.fName = '' then
            begin
            if FindLrInPage(lrLst.count) then
                begin
                FindLrInList := TRUE;
                Exit;
                end;
            end
        else
            begin
            lastPage := DesiredPage(lrLst.count);
            for pageCnt := 1 to lastPage do
                begin
                FetchPage(lrLst.fName,pageCnt,lrLst.page);
                if pageCnt < lastPage then
                    begin
                    pageEntries := LRARRAYSIZE;
                    end
                else
                    begin
                    pageEntries := lrLst.count - ((pageCnt - 1) * LRARRAYSIZE);
                    end;
                if FindLrInPage(pageEntries) then
                    begin
                    FindLrinList := TRUE;
                    Exit;
                    end;
                end;
            FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        end;
    FindLrInList := FALSE;
    end;                                              (* end of FindLrInList *)


begin                                                 (* initialization code *)
Randomize;
end.                                                 (* end or LRecList unit *)