Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPTREE16.ZIP/BTREE2.INC

Text File | 1989-04-01 | 20.0 KB | 494 lines

(******************************************************************************)
(*                                                                           *)
(*             B T R E E   R E T R I E V A L   R O U T I N E S               *)
(*                                                                           *)
(*****************************************************************************)

(* This routine locates all values within the index which meet a condition
   (cond) and returns a list of logical record numbers corresponding to these
   values.

   note - In the case of  cond = EX (exists) all entries in the index will be
   returned.  paramValue is not really used in this case so anything (a dummy)
   can be passed in as the parameter corresponding to paramValue.            *)

procedure GetValuesFromBTree(iFName : FnString;
                             var paramValue;
                             cond : Condition;
                             var lrLst : LrList);

var
    pRec : ParameterRecord;                    (* holds the index parameters *)
    sNode : NodePtrType;         (* used as pointer to current sequence node *)
    vCnt : Byte;                                (* count of values in a node *)
    result : Comparison;
    page : SinglePage;
    finished,
    done : Boolean;
    cnt : Byte;               (* used to count number of values *)
    lrNum : LrNumber;
    bytePtr : PageRange;      (* used to keep track of current byte *)

    (* used to simplify the body of GetValuesFromBTree *)

    function Completed : Boolean;

    begin
    if cnt > vCnt then
        begin
        Completed := TRUE;
        end
    else
        begin
        case cond of
            GE : Completed := (CompareValues(page[bytePtr + RNSIZE],
                                             paramValue,
                                             pRec.vType) <> LESSTHAN);

            GT : Completed := (CompareValues(page[bytePtr + RNSIZE],
                                             paramValue,
                                             pRec.vType) = GREATERTHAN);
            end;                                    (* end of case statement *)
        end;
    end;                                         (* end of Completed routine *)

    begin
    CreateLrList(lrLst);
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    case cond of
        EX,
        NE,
        LT,
        LE,
        GE,
        GT : begin
             bytePtr := 1;
             cnt := 1;
             case cond of
                  EX,LT,LE,NE :
                                begin
                                sNode := pRec.fSNode;
                                FetchPage(iFName,sNode,page);
                                vCnt := page[VCNTLOC];
                                end;
                  GE,GT :
                                begin
                                sNode := FindSNode(iFName,pRec.rNode,
                                                   paramValue,pRec);
                                FetchPage(iFName,sNode,page);
                                vCnt := page[VCNTLOC];
                                while not Completed do
                                    begin
                                    bytePtr := bytePtr + pRec.vSize + RNSIZE;
                                    Inc(cnt);
                                    end;
                                end;
                  end;                        (* end of inner case statement *)
             done := FALSE;
             while not done do
                 begin
                 if cnt <= vCnt then
                     begin
                     finished := FALSE;
                     end
                 else
                     begin
                     done := TRUE;
                     finished := TRUE;
                     end;
                 while not finished do
                     begin
                     if cond <> EX then
                         begin
                         result := CompareValues(page[bytePtr + RNSIZE],
                                                 paramValue,
                                                 pRec.vType);
                         end;
                     if ((result = GREATERTHAN)
                            and ((cond = LT) or (cond = LE))) or
                        ((result = EQUALTO)
                            and (cond = LT)) then
                         begin
                         finished := TRUE;
                         done := TRUE;
                         end
                     else
                         begin
                         if (cond <> NE) or (result <> EQUALTO) then
                             begin
                             Move(page[bytePtr],lrNum,RNSIZE);
                             AddToLrList(lrNum,lrLst);
                             end;
                         if cnt = vCnt then
                             begin
                             finished := TRUE;
                             Move(page[NEXTLOC],sNode,RNSIZE);
                             if sNode = NULL then
                                 begin
                                 done := TRUE;
                                 end
                             else
                                 begin
                                 FetchPage(iFName,sNode,page);
                                 vCnt := page[VCNTLOC];
                                 bytePtr := 1;
                                 cnt := 1;
                                 end;
                             end
                         else
                             begin
                             bytePtr := bytePtr + pRec.vSize + RNSIZE;
                             Inc(cnt);
                             end;
                         end;
                     end;
                 end;
             end;
        EQ : begin
             GetEqualsFromBTree(iFName,paramValue,lrLst,pRec);
             end;
        end;                                        (* end of case statement *)
    end;                                (* end of GetValuesFromBTree routine *)

(*\*)
(* This routine locates all values within the index within a given range and
   returns a list of logical record numbers corresponding to values within
   that range.  The range is determined by paramValue1 and paramValue2.
   paramValue1 must be less than paramValue2.  cond1 and cond2 are used to
   determine if the range is inclusive or exclusive.  cond1 must be either
   GE or GT and cond2 must be either LE or LT for this to work.  If any of
   the above conditions is not true then an empty list will be returned.     *)

procedure GetRangeFromBTree(iFName : FnString;
                            var paramValue1;
                            cond1 : Condition;
                            var paramValue2;
                            cond2 : Condition;
                            var lrLst : LrList);

var
    pRec : ParameterRecord;                    (* holds the index parameters *)
    sNode : NodePtrType;         (* used as pointer to current sequence node *)
    vCnt : Byte;                                (* count of values in a node *)
    result : Comparison;
    page : SinglePage;
    finished,
    done : Boolean;
    cnt : Byte;               (* used to count number of values *)
    lrNum : LrNumber;
    bytePtr : PageRange;      (* used to keep track of current byte *)

    (* used to simplify the body of GetRangeFromBTree *)

    function Completed : Boolean;

    begin
    if cnt > vCnt then
        begin
        Completed := TRUE;
        end
    else
        begin
        case cond1 of
            GE : Completed := (CompareValues(page[bytePtr + RNSIZE],
                                             paramValue1,
                                             pRec.vType) <> LESSTHAN);

            GT : Completed := (CompareValues(page[bytePtr + RNSIZE],
                                             paramValue1,
                                             pRec.vType) = GREATERTHAN);
            end;                                    (* end of case statement *)
        end;
    end;                                         (* end of Completed routine *)

    begin
    CreateLrList(lrLst);
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    if (cond1 in [GT,GE]) and
       (cond2 in [LT,LE]) and
       (CompareValues(paramValue1,paramValue2,pRec.vType) <> GREATERTHAN) then
        begin
        bytePtr := 1;
        cnt := 1;
        sNode := FindSNode(iFName,pRec.rNode,paramValue1,pRec);
        FetchPage(iFName,sNode,page);
        vCnt := page[VCNTLOC];
        while not Completed do
            begin
            bytePtr := bytePtr + pRec.vSize + RNSIZE;
            Inc(cnt);
            end;
        done := FALSE;
        while not done do
            begin
            if cnt <= vCnt then
                begin
                finished := FALSE;
                end
            else
                begin
                done := TRUE;
                finished := TRUE;
                end;
            while not finished do
                begin
                result := CompareValues(page[bytePtr + RNSIZE],
                                             paramValue2,
                                             pRec.vType);
                if (result = GREATERTHAN) or
                   ((result = EQUALTO) and (cond2 = LT)) then
                    begin
                    finished := TRUE;
                    done := TRUE;
                    end
                else
                    begin
                    Move(page[bytePtr],lrNum,RNSIZE);
                    AddToLrList(lrNum,lrLst);
                    if cnt = vCnt then
                        begin
                        finished := TRUE;
                        Move(page[NEXTLOC],sNode,RNSIZE);
                        if sNode = NULL then
                            begin
                            done := TRUE;
                            end
                        else
                            begin
                            FetchPage(iFName,sNode,page);
                            vCnt := page[VCNTLOC];
                            bytePtr := 1;
                            cnt := 1;
                            end;
                        end
                    else
                        begin
                        bytePtr := bytePtr + pRec.vSize + RNSIZE;
                        Inc(cnt);
                        end;
                    end;
                end;
            end;
        end;
    end;                                 (* end of GetRangeFromBTree routine *)

(*\*)
(* This routine is internal only and will search for a partial string match.
   If position is not equal to 0 then cond must be CO and a list is returned
   for all entries that contain a match anywhere in the string.  If position
   is equal to 0 then position is ignored and a matches will be sought
   according to the value of cond.  This routine is used by
   GetSubstringFromBTree and GetSubstringAtPositionFromBTree                 *)

procedure InternalGetSubstring(iFName : FnString;
                               var paramValue;       (* must be a string var *)
                               cond : StringCondition;
                               position : StringLengthRange;
                               var lrLst : LrList);

var
    pRec : ParameterRecord;                    (* holds the index parameters *)
    sNode : NodePtrType;         (* used as pointer to current sequence node *)
    vCnt : Byte;                                (* count of values in a node *)
    result : Comparison;
    page : SinglePage;
    finished,
    done : Boolean;
    cnt : Byte;               (* used to count number of values *)
    lrNum : LrNumber;
    bytePtr : PageRange;      (* used to keep track of current byte *)

    (* used to simplify the body of InternalGetSubstring *)

    function Completed : Boolean;

    begin
    if cnt > vCnt then
        begin
        Completed := TRUE;
        end
    else
        begin
        Completed := (SubstringCompare(page[bytePtr + RNSIZE],
                      paramValue) <> LESSTHAN);
        end;
    end;                                         (* end of Completed routine *)

    begin
    CreateLrList(lrLst);
    FetchFileParameters(iFName,pRec,SizeOf(pRec));
    bytePtr := 1;
    cnt := 1;
    case cond of
        CO,EN :
                      begin
                      sNode := pRec.fSNode;
                      FetchPage(iFName,sNode,page);
                      vCnt := page[VCNTLOC];
                      end;
        ST :
                      begin
                      sNode := FindSNode(iFName,pRec.rNode,
                                         paramValue,pRec);
                      FetchPage(iFName,sNode,page);
                      vCnt := page[VCNTLOC];
                      while not Completed do
                          begin
                          bytePtr := bytePtr + pRec.vSize + RNSIZE;
                          Inc(cnt);
                          end;
                      end;
        end;                                  (* end of inner case statement *)
    done := FALSE;
    while not done do
        begin
        if cnt <= vCnt then
            begin
            finished := FALSE;
            end
        else
            begin
            done := TRUE;
            finished := TRUE;
            end;
        while not finished do
            begin
            case cond of
                ST :
                     begin
                     if StartsWithSubstring(paramValue,
                                            page[bytePtr + RNSIZE]) then
                         begin
                         Move(page[bytePtr],lrNum,RNSIZE);
                         AddToLrList(lrNum,lrLst);
                         end
                     else
                         begin
                         finished := TRUE;
                         done := TRUE;
                         end;
                     end;
                CO :
                     begin
                     if position = 0 then
                         begin
                         if ContainsSubstring(paramValue,
                                              page[bytePtr + RNSIZE]) then
                             begin
                             Move(page[bytePtr],lrNum,RNSIZE);
                             AddToLrList(lrNum,lrLst);
                             end;
                         end
                     else
                         begin
                         if ContainsSubstringAtPosition(paramValue,
                                                        page[bytePtr + RNSIZE],
                                                        position) then
                             begin
                             Move(page[bytePtr],lrNum,RNSIZE);
                             AddToLrList(lrNum,lrLst);
                             end;
                         end;
                     end;
                EN :
                     begin
                     if EndsWithSubstring(paramValue,
                                          page[bytePtr + RNSIZE]) then
                         begin
                         Move(page[bytePtr],lrNum,RNSIZE);
                         AddToLrList(lrNum,lrLst);
                         end;
                     end;
                end;                                (* end of case statement *)
            if not finished then
                begin
                if cnt = vCnt then
                    begin
                    finished := TRUE;
                    Move(page[NEXTLOC],sNode,RNSIZE);
                    if sNode = NULL then
                        begin
                        done := TRUE;
                        end
                    else
                        begin
                        FetchPage(iFName,sNode,page);
                        vCnt := page[VCNTLOC];
                        bytePtr := 1;
                        cnt := 1;
                        end;
                    end
                else
                    begin
                    bytePtr := bytePtr + pRec.vSize + RNSIZE;
                    Inc(cnt);
                    end;
                end;
            end;
        end;
    end;                              (* end of InternalGetSubstring routine *)

(*\*)
(* This routine locates partial string matches in an index of type
   STRINGVALUE.  A partial string match occurs when the string passed in as
   paramValue is contained within a string entry in the index.  You must
   specify where in the string the match must occur.  You accomplish this by
   using cond.  cond can be CO which stands for contains.  In this case, a
   match occurs if the string passed in as paramValue is anywhere in the
   string in the index.  Another option for cond is ST which stands for
   starts.  A match will occur in this instance if paramValue is located at
   the start of the string in the index.  The last option for cond is EN which
   stands for ends.  A match here occurs if paramValue matches the last
   characters in the index string.  Be aware that if paramValue and the string
   being checked are the same length and they match exactly, then a match
   would occur if any of the three options were selected (not earth shattering
   but true nonetheless).

   Otherwise, this works like any of the other retrieval routines.  A list of
   logical record numbers will be returned.

   This is exceptionally useful for many applications.  For example, a field
   might be a 7 digit code stored as a string (STRINGVALUE).  The last two
   digits might mean something in particular (part category, state, or
   whatever).  Using this you can look for all the matches on only the last
   two digits.

   One reality note here!! - For cond <> ST I have to look at every entry in
   the index for matches.  Why this is true should be reasonably obvious.
   Anyway, for cond = EN or cond = CO it will be somewhat slower than for cond
   = ST.  How much slower depends on the size of the index.  It boils down to
   the difference between a O(LOG(n)) algorithm and a O(n) algorithm, the
   former being much faster for n = a large number.  If any of the above is
   confusing ignore it and experiment.  It is still better to use this routine
   than to grovel through all of the data records yourself!!                 *)


procedure GetSubstringFromBTree(iFName : FnString;
                                var paramValue;      (* must be a string var *)
                                cond : StringCondition;
                                var lrLst : LrList);


    begin
    InternalGetSubstring(iFName,paramValue,cond,0,lrLst);
    end;                             (* end of GetSubstringFromBTree routine *)

(*\*)
(* This routine is exactly like GetSubstringFromBTree except that matches only
   occur if the substring passed in as paramValue is located at the exact
   location specified by the position parameter.  Also, the cond parameter is
   omitted since it only makes sense to look for a partial string match at a
   particular position if cond is CO.  In other works, you will get a logical
   record list with entries for all index values which contain paramValue at
   the character position specified by position.                             *)

procedure GetSubstringAtPositionFromBTree(iFName : FnString;
                                          var paramValue;   (* must be a string
                                                                         var *)
                                          position : StringLengthRange;
                                          var lrLst : LrList);

    begin
    InternalGetSubstring(iFName,paramValue,CO,position,lrLst);
    end;                   (* end of GetSubstringAtPositionFromBTree routine *)