Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TBTREE.ZIP/LRECLIST.PAS

Pascal/Delphi Source File | 1988-07-25 | 26.8 KB | 713 lines

(* TBTree13             Copyright (c)  1988            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. Two list could be combined (intersection
   or union) to create a third list if the user desires.  Presently, the user
   would have to do things like combining lists explicitly (user's own
   routines). I plan to add these capabilities in the next release.  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 current 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 ever possible logical
   record number.  (You would really run out of disk space sooner than
   ever coming close to that limit).

   Since a file may be created it is important that the user call DestroyLrList
   when completed with the list.  Any files created will be deleted.  Otherwise
   some strange files might show up on the disk.

   note - Hopefully, I have given the user a rich set of routines which can
   be used to use 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                                  *)

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

interface

uses
    FileDecs,
    Files,
    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 *)
             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 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

const
    MINFILENAME = 100;
    MAXFILENAME = 199;
type
    FileNameCountRange = MINFILENAME .. MAXFILENAME;

var
    fileNameArray : Array [FileNameCountRange] of Boolean;
    cnt : FileNameCountRange;

(* This routine will return a file name which is not being used.  This routine
   will fail (runtime error) if no file name are available.  It is unlikely
   that all 100 are in use since this would mean that there are 100 lists
   floating around someplace which is should nver reasonable happen.

   note - The routine only checks an array which keeps track of these file
   names.  If there is a file on the disk with the name xxx???.lrf where ???
   represents a three digit number then that file could get wiped out.
   This seems like an extremely remote occurence which is not worth checking
   for.

   note - the extension is not added here as that will be handle when the
   file is created                                                           *)

function GetUnusedFileName : FnString;

var
    cnt : FileNameCountRange;
    temp : String[3];

    begin
    cnt := MINFILENAME;
    while fileNameArray[cnt] do
        begin
        cnt := cnt + 1;
        end;
    fileNameArray[cnt] := TRUE;
    Str(cnt:3,temp);                                    (* convert to string *)
    GetUnusedFileName := 'XXX' + temp;
    end;

(*\*)
procedure RecoverFileName(fName : FnString);

var
    temp : FileNameCountRange;
    dummy : Integer;

    begin
    Val(Copy(fName,4,3),temp,dummy);
    fileNameArray[temp] := FALSE;
    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);

    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 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;
                CreateFile(lrLst.fName,LLIST);
                StorePage(lrLst.fName,1,lrLst.page);
                end;
            lrLst.currPage := lrLst.currPage + 1;
            FillChar(lrLst.page,PAGESIZE,0);
            end;
        lrLst.current := lrLst.current + 1;
        lrLst.count := lrLst.count + 1;
        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
        DeleteFile(lrLst.fName);
        RecoverFileName(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
            lrLst.currPage := lrLst.currPage + 1;
            FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        lrLst.current := lrLst.current + 1;
        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 = 1) or
       (lrLst.current = 0) then
        begin
        GetPrevLr := 0;
        end
    else
        begin
        if (lrLst.current - 1) Mod LRARRAYSIZE  = 0 then
            begin
            lrLst.currPage := lrLst.currPage - 1;
            FetchPage(lrLst.fName,lrLst.currPage,lrLst.page);
            end;
        lrLst.current := lrLst.current - 1;
        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 FindLargestLr *)




begin                                                (* initialization code *)
for cnt := MINFILENAME to MAXFILENAME do
    begin
    fileNameArray[cnt] := FALSE;
    end;

end.                                                 (* end or LRecList unit *)