home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
TBTREE16.ZIP
/
LRECLIST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-07-15
|
29KB
|
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 *)