{*******************************************************}
{                                                       }
{       Advanced SQL statement parser                   }
{       Copyright (c) 2001 AS Gaiasoft                  }
{       Created by Gert Kello                           }
{                                                       }
{*******************************************************}

unit gaAdvancedSQLParser;

interface

uses
  Classes, gaBasicSQLParser, gaLnkList;

type
  TSQLStatementType = (sstSelect, sstInsert, sstUpdate, sstDelete,
    sstCreate, sstAlter, sstDrop, sstUnknown, sstNoStatementFound);

  TSQLStatementTypes = set of TSQLStatementType;

  TgaCustomSQLStatement = class;

  TgaSQLTokenObj = class (TObject)
  private
    FIsOriginal: Boolean;
    FQuoteChar: Char;
    FTokenQuoted: Boolean;
    FTokenString: string;
    FTokenType: TSQLToken;
    function GetTokenAsString: string;
  public
    constructor CreatePlaceHolder;
    procedure AssignTokenInfo(ASQLParser: TgaBasicSQLParser);
    procedure SetTokenInfo(const AString: string; ATokenType: TSQLToken; 
            AQuoted: Boolean; AQuoteChar: char);
    function TokenSymbolIs(const S: string): Boolean;
    property IsOriginal: Boolean read FIsOriginal write FIsOriginal;
    property QuoteChar: Char read FQuoteChar;
    property TokenAsString: string read GetTokenAsString;
    property TokenQuoted: Boolean read FTokenQuoted;
    property TokenString: string read FTokenString;
    property TokenType: TSQLToken read FTokenType;
  end;
  
  TgaTokenEvent = procedure (Sender: TObject; AToken: TgaSQLTokenObj) of object;
  TgaSQLTokenListBookmark = class (TgaDoubleListBookmark)
  private
    function GetTokenObj: TgaSQLTokenObj;
    procedure SetTokenObj(Value: TgaSQLTokenObj);
  public
    property TokenObj: TgaSQLTokenObj read GetTokenObj write SetTokenObj;
  end;
  
  TgaSQLTokenList = class (TgaSharedDoubleList)
  private
    FOwnerStatement: TgaCustomSQLStatement;
  protected
    procedure GetAllTokens(ATokenList: TgaSQLTokenList);
    function GetAsString: string; virtual;
    function GetCurrentItem: TgaSQLTokenObj; reintroduce; virtual;
    function GetTokenObjAsString(ATokenObj: TgaSQLTokenObj): string;
    procedure SetCurrentItem(Value: TgaSQLTokenObj); reintroduce; virtual;
    property OwnerStatement: TgaCustomSQLStatement read FOwnerStatement;
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement); virtual;
    constructor CreateMirror(AOwnerStatement: TgaCustomSQLStatement; 
            AMirroredList: TgaSQLTokenList); virtual;
    procedure ExecuteTokenAdded(Sender: TObject; AToken: TgaSQLTokenObj); 
            virtual;
    function GetBookmark: TgaSQLTokenListBookmark; reintroduce; virtual;
    property AsString: string read GetAsString;
    property CurrentItem: TgaSQLTokenObj read GetCurrentItem write 
            SetCurrentItem;
  end;
  
  TgaAdvancedSQLParser = class;

  TgaListOfSQLTokenLists = class (TgaSharedDoubleList)
  private
    FOwnsLists: Boolean;
  protected
    procedure GetAllTokens(ATokenList: TgaSQLTokenList);
    function GetAsString: string; virtual;
    function GetCurrentItem: TgaSQLTokenList; reintroduce; virtual;
    function GetLastItem: TgaSQLTokenList; reintroduce; virtual;
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  public
    constructor Create;
    procedure ExecuteTokenAdded(Sender: TObject; AToken: TgaSQLTokenObj); 
            virtual;
    property AsString: string read GetAsString;
    property CurrentItem: TgaSQLTokenList read GetCurrentItem;
    property LastItem: TgaSQLTokenList read GetLastItem;
    property OwnsLists: Boolean read FOwnsLists write FOwnsLists;
  end;
  
  TgaSQLSTatementClass = class of TgaCustomSQLStatement;

  TgaSQLTokenHolderList = class (TgaSQLTokenList)
  private
    FOwnsAll: Boolean;
    FOwnsNonOriginal: Boolean;
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  public
    procedure AddToken(AToken: TgaSQLTokenObj);
    function NewToken: TgaSQLTokenObj; virtual;
    procedure SetOwner(AOwner: TgaCustomSQLStatement);
    property OwnsAll: Boolean read FOwnsAll write FOwnsAll;
    property OwnsNonOriginal: Boolean read FOwnsNonOriginal write 
            FOwnsNonOriginal;
  end;
  
  TgaNoSQLStatement = class;

  TgaCustomSQLStatement = class (TObject)
  private
    FAllFields: TgaListOfSQLTokenLists;
    FAllTables: TgaListOfSQLTokenLists;
    FCurrentSQL: TgaSQLTokenHolderList;
    FCurrentToken: TgaSQLTokenObj;
    FInternalStatementState: Integer;
    FOnTokenAdded: TgaTokenEvent;
    FOriginalSQL: TgaSQLTokenHolderList;
    FOwnerParser: TgaAdvancedSQLParser;
    FOwnerStm: TgaCustomSQLStatement;
    FStatusCode: Integer;
    procedure SetStatusCode(Value: Integer);
  protected
    procedure DoAfterStatementStateChange; virtual;
    procedure DoBeforeStatementStateChange(const NewStateOrd: LongInt); virtual;
    procedure DoStatementComplete; virtual;
    function GetAsString: string; virtual;
    function GetStatementType: TSQLStatementType; virtual; abstract;
    procedure ModifyStatementInErrorState(Sender: TObject; AToken: 
            TgaSQLTokenObj); virtual;
    procedure ModifyStatementInNormalState(Sender: TObject; AToken: 
            TgaSQLTokenObj); virtual;
    property CurrentToken: TgaSQLTokenObj read FCurrentToken write 
            FCurrentToken;
    property InternalStatementState: Integer read FInternalStatementState write 
            FInternalStatementState;
    property OwnerParser: TgaAdvancedSQLParser read FOwnerParser;
    property OwnerStm: TgaCustomSQLStatement read FOwnerStm;
  public
    constructor Create(AOwner: TgaAdvancedSQLParser); virtual;
    constructor CreateFromStatement(AOwner: TgaAdvancedSQLParser; AStatement: 
            TgaNoSQLStatement); virtual;
    constructor CreateOwned(AOwner: TgaAdvancedSQLParser; AOwnerStatement: 
            TgaCustomSQLStatement); virtual;
    destructor Destroy; override;
    procedure AddField(AField: TgaSQLTokenList);
    procedure AddTable(ATable: TgaSQLTokenList);
    procedure Clear; virtual;
    procedure DoTokenAdded(Sender: TObject; AToken: TgaSQLTokenObj); virtual;
    procedure DoTokenParsed;
    procedure ReleaseOwnedItems;
    procedure RemoveField(AField: TgaSQLTokenList);
    procedure RemoveTable(ATable: TgaSQLTokenList);
    property AllFields: TgaListOfSQLTokenLists read FAllFields;
    property AllTables: TgaListOfSQLTokenLists read FAllTables;
    property AsString: string read GetAsString;
    property CurrentSQL: TgaSQLTokenHolderList read FCurrentSQL;
    property OnTokenAdded: TgaTokenEvent read FOnTokenAdded write FOnTokenAdded;
    property OriginalSQL: TgaSQLTokenHolderList read FOriginalSQL;
    property StatementType: TSQLStatementType read GetStatementType;
    property StatusCode: Integer read FStatusCode write SetStatusCode;
  end;
  
  TgaAdvancedSQLParser = class (TgaBasicSQLParser)
  private
    FCurrentStatement: TgaCustomSQLStatement;
    FOnStatementComplete: TNotifyEvent;
    function GetCurrentStatement: TgaCustomSQLStatement;
  protected
    procedure DoStatementComplete; virtual;
    procedure DoTokenParsed; override;
    procedure SetCurrentStatement(AStatement: TgaCustomSQLStatement);
  public
    destructor Destroy; override;
    class function AddStatementClass(const ATokenSymbol: string; 
            AStatementClass: TgaSQLSTatementClass): Integer;
    function GetStatementClass: TgaSQLSTatementClass;
    class function GetStatementClassForToken(const ATokenSymbol: string): 
            TgaSQLSTatementClass;
    class procedure RemoveStatementClass(const ATokenSymbol: string; 
            AStatementClass: TgaSQLSTatementClass);
    procedure Reset; override;
    property CurrentStatement: TgaCustomSQLStatement read GetCurrentStatement;
    property OnStatementComplete: TNotifyEvent read FOnStatementComplete write 
            FOnStatementComplete;
  end;
  
  TgaUnkownSQLStatement = class (TgaCustomSQLStatement)
  protected
    function GetStatementType: TSQLStatementType; override;
  end;
  
  TgaNoSQLStatement = class (TgaCustomSQLStatement)
  protected
    function GetStatementType: TSQLStatementType; override;
    procedure ModifyStatementInNormalState(Sender: TObject; AToken: 
            TgaSQLTokenObj); override;
  end;
  
const
  DMLStatementTypes = [sstSelect, sstInsert, sstUpdate, sstDelete];
  DDLStatementTypes = [sstCreate, sstAlter, sstDrop];

  errWrongKeywordSequence = $101;
  errUnexpectedTokenInStatement = $102;

procedure TrimTokenList(ATokenList: TgaSQLTokenList;
    const FreeRemovedTokens: boolean;
    TrimmedTokenTypes: TSQLTokenTypes = [stDelimitier, stEnd]);

implementation

uses
  SysUtils, gaSelectStm, gaUpdateStm, gaDeleteStm, gaInsertStm,
  gaSQLParserConsts;

var
  StatementClassList: TStrings;

procedure TrimTokenList(ATokenList: TgaSQLTokenList;
    const FreeRemovedTokens: boolean;
    TrimmedTokenTypes: TSQLTokenTypes = [stDelimitier, stEnd]);
begin
  ATokenList.First;
  while (not ATokenList.Eof) and (ATokenList.CurrentItem.TokenType in TrimmedTokenTypes) do
  begin
    if FreeRemovedTokens then
      ATokenList.CurrentItem.Free;
    ATokenList.DeleteCurrent;
  end;
  ATokenList.Last;
  while (not ATokenList.Bof) and (ATokenList.CurrentItem.TokenType in TrimmedTokenTypes) do
  begin
    if FreeRemovedTokens then
      ATokenList.CurrentItem.Free;
    ATokenList.DeleteCurrent;
    ATokenList.Previous;
  end;
end;

{
**************************** TgaSQLTokenHolderList *****************************
}
procedure TgaSQLTokenHolderList.AddToken(AToken: TgaSQLTokenObj);
begin
  Add(AToken);
  Last;
end;

function TgaSQLTokenHolderList.NewToken: TgaSQLTokenObj;
begin
  Result := TgaSQLTokenObj.Create;
  AddToken(Result);
end;

procedure TgaSQLTokenHolderList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  if Action = lnDeleted then
    if OwnsAll then
      TgaSQLTokenObj(Ptr).Free
    else begin
      if OwnsNonOriginal then
        if not TgaSQLTokenObj(Ptr).IsOriginal then
          TgaSQLTokenObj(Ptr).Free;
    end;
  inherited Notify(Ptr, Action);
end;

procedure TgaSQLTokenHolderList.SetOwner(AOwner: TgaCustomSQLStatement);
begin
  FOwnerStatement := AOwner;
end;

{
**************************** TgaCustomSQLStatement *****************************
}
constructor TgaCustomSQLStatement.Create(AOwner: TgaAdvancedSQLParser);
begin
  inherited Create;
  FOwnerParser := AOwner;
  FStatusCode := 0;
  FOnTokenAdded := ModifyStatementInNormalState;
  FAllFields := TgaListOfSQLTokenLists.Create;
  FAllTables := TgaListOfSQLTokenLists.Create;
  FCurrentSQL := TgaSQLTokenHolderList.Create(Self);
  FOriginalSQL := TgaSQLTokenHolderList.Create(Self);
  FOriginalSQL.OwnsAll := True;
  FCurrentSQL.OwnsNonOriginal := True;
  FAllTables.OwnsLists := False;
  FAllFields.OwnsLists := False;
end;

constructor TgaCustomSQLStatement.CreateFromStatement(AOwner: 
        TgaAdvancedSQLParser; AStatement: TgaNoSQLStatement);
begin
  FOwnerParser := AOwner;
  FStatusCode := 0;
  FOnTokenAdded := ModifyStatementInNormalState;
  FCurrentToken := AStatement.CurrentToken;
  FAllFields := AStatement.AllFields;
  FAllTables := AStatement.AllTables;
  FCurrentSQL := AStatement.CurrentSQL;
  FOriginalSQL := AStatement.OriginalSQL;
  AStatement.ReleaseOwnedItems;
  CurrentSQL.SetOwner(Self);
  OriginalSQL.SetOwner(Self);
  inherited Create;
end;

constructor TgaCustomSQLStatement.CreateOwned(AOwner: TgaAdvancedSQLParser; 
        AOwnerStatement: TgaCustomSQLStatement);
begin
  inherited Create;
  FOwnerParser := AOwner;
  FOwnerStm := AOwnerStatement;
  FStatusCode := 0;
  FOnTokenAdded := ModifyStatementInNormalState;
  FAllFields := TgaListOfSQLTokenLists.Create;
  FAllTables := TgaListOfSQLTokenLists.Create;
  FCurrentSQL := TgaSQLTokenHolderList.CreateMirror(Self, AOwnerStatement.CurrentSQL);
  FOriginalSQL := TgaSQLTokenHolderList.CreateMirror(Self, AOwnerStatement.CurrentSQL);
  FOriginalSQL.OwnsAll := False;
  FCurrentSQL.OwnsNonOriginal := False;
  FAllTables.OwnsLists := False;
  FAllFields.OwnsLists := False;
end;

destructor TgaCustomSQLStatement.Destroy;
begin
  Clear;
  FAllFields.Free;
  FAllTables.Free;
  FCurrentSQL.Free;
  FOriginalSQL.Free;
  inherited Destroy;
end;

procedure TgaCustomSQLStatement.AddField(AField: TgaSQLTokenList);
begin
  AllFields.Add(AField);
  if Assigned(OwnerStm) then
    OwnerStm.AddField(AField);
end;

procedure TgaCustomSQLStatement.AddTable(ATable: TgaSQLTokenList);
begin
  FAllTables.Add(ATable);
  if Assigned(OwnerStm) then
    OwnerStm.AddTable(ATable);
end;

procedure TgaCustomSQLStatement.Clear;
begin
  if Assigned(CurrentSQL) then
    CurrentSQL.Clear;
  if Assigned(OriginalSQL) then
    OriginalSQL.Clear;
  if Assigned(AllTables) then
    AllTables.Clear;
  if Assigned(AllFields) then
    AllFields.Clear;
end;

procedure TgaCustomSQLStatement.DoAfterStatementStateChange;
begin
  ;// Do nothing here
end;

procedure TgaCustomSQLStatement.DoBeforeStatementStateChange(const NewStateOrd: 
        LongInt);
begin
  ;// Do nothing here
end;

procedure TgaCustomSQLStatement.DoStatementComplete;
begin
  if Assigned(FOwnerParser) then
    FOwnerParser.DoStatementComplete;
end;

procedure TgaCustomSQLStatement.DoTokenAdded(Sender: TObject; AToken: 
        TgaSQLTokenObj);
begin
  CurrentSQL.Last;
  if Assigned(FOnTokenAdded) then FOnTokenAdded(Sender, AToken);
end;