galnklist.pas

一个sql语法分析程序

{******************************************************************************}
{                                                                              }
{       ga SQL Parser package                                                  }
{       gaDoubleLinklist classes for internal data storage                     }
{                                                                              }
{       Copyright (c) 2001 AS Gaiasoft                                         }
{       Portions copyright (c) Julian M Bucknall, from Algorithms Alfresco in  }
{       The Delphi Magazine (www.thedelphimagazine.com)                        }
{                                                                              }
{       Redesigned by Gert Kello                                               }
{                                                                              }
{******************************************************************************}

//: Unit for gaLinkList classes 
{:
Unit for gaLinkList and gaListBookmark classes
}
unit gaLnkList;

interface

uses
  SysUtils, Classes;

type
  TgaNodeNotification = (nnAdded, nnDeleted, nnCleared);

type
  PdllNode = ^TdllNode;
  TdllNode = packed record
    dllnNext : PdllNode;
    dllnPrev : PdllNode;
    dllnData : Pointer;
  end;

  //: Abstract list bookmark class 
  {:
  Abstract base class for list bookmarks.
  Contains properties to determ wheter the bookmark is valid or not and to get
  read/write access to the item pointed by bookmark.
  Descendants of the class should at least override the access methods
  GetIsValid, GetItem and SetItem.
  They would propably need to add property to store the bookmark pointer and
  the list for which the bookmark is created.
  }
  TgaListBookmark = class (TObject)
  protected
    //: GetIsValid is the abstract read access method of the IsValid property. 
    function GetIsValid: Boolean; virtual; abstract;
    //: GetItem is the read access method of the Item property 
    function GetItem: Pointer; virtual; abstract;
    //: SetItem is the write access method of the Item property. 
    procedure SetItem(Value: Pointer); virtual; abstract;
  public
    //: Property IsValid determs whether the bookmark is valid or not 
    {:
    Property IsValid is read and run time only.
    It determs whether the bookmark is valid or not.
    }
    property IsValid: Boolean read GetIsValid;
    //: Property Item gives an read/write access to the item represented by the bookmark 
    {:
    Property Item is read / write, at run time only.
    It gives an read/write access to the item represented by the cursor.
    The descendants are required to implement the access methods GetItem and
    SetItem.
    }
    property Item: Pointer read GetItem write SetItem;
  end;
  
  TgaSimpleDoubleList = class (TObject)
  private
    //: FHead is the state field of the Head property. 
    {:
    FHead is the state field of the Head property.
    }
    FHead: PdllNode;
    {:
    FTail is the state field of the Tail property.
    }
    FTail: PdllNode;
    //: GetHead is the read access method of the Head property. 
    function GetHead: PdllNode;
    //: GetTail is the read access method of the Tail property. 
    function GetTail: PdllNode;
  protected
    //: Checks and corrects the Head and Tail node of the list 
    procedure CheckListBorders; virtual;
    procedure InitDoubleList; virtual;
    procedure InternalDelete(ANode: PdllNode);
    function InternalInsert(AItem : pointer; AInsertItem: PdllNode): PdllNode;
    class function IsList(AHead, ATail: PdllNode): Boolean;
    function IsNodeInside(ANode: PdllNode): Boolean;
    function NodeOf(AItem: pointer): PdllNode;
    procedure Notify(Ptr: Pointer; Action: TListNotification); virtual;
    procedure NotifyChange(AOldItem, ANewItem: pointer);
    procedure NotifyNodeChange(ANode: PdllNode; Action: TgaNodeNotification); 
            virtual;
    {:
    Property Head is read only.
    }
    property Head: PdllNode read GetHead;
    {:
    Property Tail is read only.
    It represents the node after the last node in the list.
    If List has a cursor then Eof := Cursor = Tail;
    }
    property Tail: PdllNode read GetTail;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; virtual;
  end;
  
  TgaSharedDoubleList = class;

  TgaDoubleList = class (TgaSimpleDoubleList)
  private
    {:
    Field FActiveDataUserList.
    }
    FActiveDataUserList: TgaSimpleDoubleList;
    {:
    Field FDataUserList.
    }
    FDataUserList: TgaSimpleDoubleList;
    {:
    FCount is the state field of the Count property.
    }
    FCount: Integer;
    {:
    FCursor is the state field of the Cursor property.
    }
    FCursor: PdllNode;
    FNodeRevID: Cardinal;
    function GetBof: Boolean;
    function GetCursor: PdllNode;
    function GetEof: Boolean;
    function GetFirstItem: Pointer;
    function GetLastItem: Pointer;
    procedure SetFirstItem(Value: Pointer);
    procedure SetLastItem(Value: Pointer);
  protected
    procedure FreeDataUserList;
    procedure AddActiveDataUser(ADataUser: TgaSharedDoubleList); virtual;
    procedure AddDataUser(ADataUser: TgaSharedDoubleList); virtual;
    procedure RemoveActiveDataUser(ADataUser: TgaSharedDoubleList); virtual;
    procedure RemoveDataUser(ADataUser: TgaSharedDoubleList); virtual;
    procedure CheckListCursor; virtual;
    function Extract(Item: Pointer): Pointer;
    function GetCurrentItem: Pointer; virtual;
    function GetIsEmpty: Boolean; virtual;
    procedure InitDoubleList; override;
    function IsCursorCorrect: Boolean; virtual;
    procedure NotifyNodeChange(ANode: PdllNode; Action: TgaNodeNotification); 
            override;
    procedure SetCurrentItem(Value: Pointer); virtual;
    {:
    Property Cursor is read only.
    }
    property Cursor: PdllNode read GetCursor;
    {:
    A number wich is icremented for every list node change (for dataowner lists)
    or dtores the last state when the list was validated against the DataOwner 
    list
    }
    property NodeRevID: Cardinal read FNodeRevID;
  public
    destructor Destroy; override;
    procedure Add(Item: Pointer); virtual;
    procedure CopyListContest(ACopyList: TgaDoubleList); virtual;
    procedure DeleteCurrent;
    procedure First;
    function GetBookmark: TgaListBookmark; virtual;
    procedure GotoBookmark(ABookmark: TgaListBookmark);
    procedure InsertAfterCurrent(AItem: Pointer; MoveCursorToNewItem: boolean); 
            virtual;
    procedure Last;
    function Locate(AItem: Pointer): Boolean;
    procedure Next;
    procedure Pack;
    procedure Previous;
    procedure Remove(Item: Pointer);
    {:
    Property Bof is read and run time only.
    }
    property Bof: Boolean read GetBof;
    {:
    Property Count is read and run time only.
    }
    property Count: Integer read FCount;
    {:
    Property CurrentItem is read / write, at run time only.
    }
    property CurrentItem: Pointer read GetCurrentItem write SetCurrentItem;
    {:
    Property Eof is read and run time only.
    }
    property Eof: Boolean read GetEof;
    {:
    Property FirstItem is read / write, at run time only.
    }
    property FirstItem: Pointer read GetFirstItem write SetFirstItem;
    {:
    Property IsEmpty is read and run time only.
    }
    property IsEmpty: Boolean read GetIsEmpty;
    {:
    Property LastItem is read / write, at run time only.
    }
    property LastItem: Pointer read GetLastItem write SetLastItem;
  end;
  
  TgaSharedDoubleList = class (TgaDoubleList)
  private
    {:
    FDataOwner is the state field of the DataOwner property.
    }
    FDataOwner: TgaDoubleList;
    {:
    Field FFirstNode.
    }
    FFirstNode: PdllNode;
    {:
    Field FLastNode.
    }
    FLastNode: PdllNode;
    {:
    FActiveDataShare is the state field of the ActiveDataShare property.
    }
    FActiveDataShare: Boolean;
    FCursorNodeRev: Cardinal;
    {:
    FIsDataOwner is the state field of the IsDataOwner property.
    }
    FIsDataOwner: Boolean;
    procedure SetActiveDataShare(Value: Boolean);
  protected
    procedure DataOwnerDestroyed;
    procedure InitDoubleList; override;
    procedure AddActiveDataUser(ADataUser: TgaSharedDoubleList); override;
    procedure AddDataUser(ADataUser: TgaSharedDoubleList); override;
    procedure CheckListBorders; override;
    procedure CheckListCursor; override;
    //: Calls Dataowners Notify in addition if the list is mirroring list 
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    //: Called from DataOwner.NotifyNodeChange if ActiveDataShare = True 
    procedure NotifyMasterChanged(ANode: PdllNode; Action: TgaNodeNotification);
            virtual;
    //: Calls inherited if IsDataOwner, otherwise calls DataOwners NotifyNodeChange 
    procedure NotifyNodeChange(ANode: PdllNode; Action: TgaNodeNotification); 
            override;
    procedure RemoveActiveDataUser(ADataUser: TgaSharedDoubleList); override;
    procedure RemoveDataUser(ADataUser: TgaSharedDoubleList); override;
    procedure ValidateCursor(CorrectIfInvalid: Boolean); virtual;
    procedure ValidateListBorders; virtual;
  public
    constructor Create;
    constructor CreateMirror(AMirroredList: TgaDoubleList);
    destructor Destroy; override;
    procedure SetEndPos(APositionedList: TgaDoubleList; StrictEndPos: Boolean);
    procedure SetStartPos(APositionedList: TgaDoubleList; StrictStartPos: 
            boolean);
    procedure Add(Item: Pointer); override;
    procedure Clear; override;
    //: procedure InsertAfterCurrent overrides inherited InsertAfterCurrent. 
    procedure InsertAfterCurrent(AItem: Pointer; MoveCursorToNewItem: boolean); 
            override;
    {:
    Property DataOwner is read and run time only.
    if DataOwner = Self, then IsDataOwner = True;
    the IsDataOwner and IsDataOwner proeprties are set in the constructor and
    can't be changed during the life of the list
    }
    property DataOwner: TgaDoubleList read FDataOwner;
    {:
    Property ActiveDataShare is read / write, at run time only.
    Determs wheter the mirroring list is notified by the master list with the
    call to NotifyMasterChanged
    }
    property ActiveDataShare: Boolean read FActiveDataShare write 
            SetActiveDataShare;
    {:
    Property IsDataOwner is read and run time only.
    }
    property IsDataOwner: Boolean read FIsDataOwner;
  end;
  
  //: Bookmark for the TgaDoubleList, TgaSharedDoubleList and their descendants 
  {:
  TgaDoubleListBookmark implements abstract methods (GetIsValid, GetItem and
  SetItem) of the TgaListBookmark. It implements functionality to work as
  Bookmark for TgaDoubleLinkList, TgaSharedDoubleLinkList and their descendants.
  }
  TgaDoubleListBookmark = class (TgaListBookmark)
  private
    {:
    FCursor is the state field of the Cursor property.
    }
    FCursor: PdllNode;
    FNodeRevID: Cardinal;
    {:
    FOwnerList is the state field of the OwnerList property.
    }
    FOwnerList: TgaDoubleList;
  protected
    //: Overrides abstarct TgaListBookmark.GetIsValid 
    function GetIsValid: Boolean; override;
    //: Function GetItem overrides abstract GetItem 
    function GetItem: Pointer; override;
    function IsValidFor(AList: TgaDoubleList): Boolean; virtual;
    procedure SetItem(Value: Pointer); override;
    {:
    Property Cursor is read only.
    }
    property Cursor: PdllNode read FCursor;
    property NodeRevID: Cardinal read FNodeRevID;
    {:
    Property OwnerList is read only.
    }
    property OwnerList: TgaDoubleList read FOwnerList;
  public
    constructor Create(AOwnerList: TgaDoubleList);
  end;
  
  EgaLinkListError = class (Exception)
  end;
  
  EgaListBookmarkError = class (Exception)
  end;
  
implementation

resourcestring
// START resource string wizard section
  SListIsNotAMirroringList = 'List is not a mirroring list: %s';
  SListIsNotDataOwner = 'List is not the data owner: %s';
  SListIsDataOwner = 'List is the data owner: %s';
  SListsDoNotShareData = 'Lists do not share data: %s';
  SMirrorListValidateFailed = 'Mirror list validate failed: %s';
  SInvalidBookmark = 'Invalid bookmark: %s';
  SCantSetTheStartOrEndPostions = 'Can''t set the start or end postions';
  SStrictFirstNodeNotPartOfTheMasterList = 'Strict first node is invalid - not part of the master list';
  SStrictFirstNodePointsToTheHeadOfMasterList = 'Strict first node is invalid - points to the Head item of master list';
  SCantGetItem = 'Can''t get the item';
  SCantSetItem = 'Can''t set the item';
  SBookmarkClassInvalid = 'Bookmark is a member of invalid class';
  SHeadNodeNotInMasterList = 'Head node is invalid - not part of the master list';
  SInvalidCursor = 'Cursor is not part of the list';
  SNoHeadNode = 'Invalid link list - no head node';
  SCantAddActiveDataUser = 'Can''t add active data user';
  SCantAddDataUser = 'Can''t add data user';
  SCantRemoveActiveDataUser = 'Can''t remove active data user';
  SCantRemoveDataUser = 'Can''t remove data user';
  SNoCurrentItemForTheOperation = 'Either Bof or Eof is true - no current item for the operation';
  SCantChangeActiveDataShare = 'Can''t change ActiveDataShare';
  SCannotDeleteHeadOrTailNode = 'Can''t delete Head or Tail node';
  SNoItemsInTheList = 'There is no items in the list';
  SInvalidHeadOrTail = 'Invalid Head or Tail node - possibly Head after Tail or Tail not a part of master list';

// END resource string wizard section

procedure dnmFreeNode(aNode : PdllNode);
begin
  Dispose(aNode);
end;

function dnmAllocNode : PdllNode;
begin
  New(Result);
end;

{:
GetIsValid is the read access method of the IsValid property.
Descendant classes should override this method to give appropriate result
}
{:
GetItem is the read access method of the Item property.
It retrives the value of the item represented by the cursor. The method has 
to be overridden by the descendant classes.
}
{:
SetItem is the write access method of the Item property.
It changes the value of the item represented by the cursor. The method has 
to be overridden by the descendant classes.
}
{
***************************** TgaSimpleDoubleList ******************************
}
constructor TgaSimpleDoubleList.Create;
{:
Constructor Create overrides the inherited Create.
First inherited Create is called, then the internal data structure is
initialized via call to InitDoubleList;
}
begin
  inherited Create;
  InitDoubleList;
end;

destructor TgaSimpleDoubleList.Destroy;
{:
Destructor Destroy overrides the inherited Destroy.
First the Clear methodis called, then all owned fields are free'd,
finally inherited Destroy is called.
}
begin
  Clear;
  if Assigned(FHead) then
    dnmFreeNode(FHead);
  if Assigned(FTail) then
    dnmFreeNode(FTail);
  inherited Destroy;
end;

procedure TgaSimpleDoubleList.CheckListBorders;
{:
procedure CheckListBorders - Checks that the Head and Tail node are correct.
Corrects them if required.
This method is called only from GetTail and GetHead methods.
It should be as optimized as much as possible because it get's called every
time the Head or Tail node is used (getEof or GetBof for example).
For TgaSimpleDoubleList and TgaDoubleList, theese nodes are always correct.
}
begin
  ; // TgaSimpleDoubleList and TgaDoubleList have always correct border nodes
end;

procedure TgaSimpleDoubleList.Clear;
{:
procedure Clear.
Clears the contest of the list.
It first calls NotifyNodeChange with nil ChangedNode (to indicate that zero
or more nodes might be affected) and nnCleared action. Then, for every
item in the list, the holding node is removed and Notify is called to indicate
that the item has been deleted.
This form of clear is not allowed for mirroring lists - they must not call
NotifyNodeChange with nnCleared flag.
}
var
  Temp: PdllNode;
  tmpData: Pointer;
begin
  if Assigned(FHead) then
  begin
    { There is no need to correct list state here - this form of clear can be
      executed *ONLY* if the list is master list }
    NotifyNodeChange(nil, nnCleared);
    Temp := FHead^.dllnNext;