gasqlparserhelperclasses.pas

一个sql语法分析程序

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

unit gaSQLParserHelperClasses;

interface

uses
  gaAdvancedSQLParser, gaBasicSQLParser;

type
  TgaSQLStatementPart = class (TgaSQLTokenList)
  private
    FIsInvalid: Boolean;
    FParseComplete: Boolean;
    function GetParseComplete: Boolean;
    procedure SetIsInvalid(const Value: Boolean);
    procedure SetParseComplete(const Value: Boolean);
  protected
    procedure CheckModifyAllowed; virtual;
    function GetAsString: string; override;
    function InternalGetParseComplete: Boolean; virtual;
    procedure InternalSetParseComplete; virtual;
    procedure SetAsString(const Value: string); virtual;
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement); override;
    property AsString read GetAsString write SetAsString;
    property IsInvalid: Boolean read FIsInvalid write SetIsInvalid;
    property ParseComplete: Boolean read GetParseComplete write 
            SetParseComplete;
  end;
  
  TgaSQLExpression = class (TgaSQLStatementPart)
  private
    FIsCorrect: Boolean;
    FIsExpression: Boolean;
    FOldOnStatementAdd: TgaTokenEvent;
    FParenCount: Integer;
    function GetCanParseEnd: Boolean;
    function GetExpression: string;
  protected
    procedure AddParen(AToken: TgaSQLTokenObj); virtual;
    procedure ParseExpression(AToken: TgaSQLTokenObj); virtual;
    procedure RemoveParen(AToken: TgaSQLTokenObj); virtual;
    procedure SetIsExpression(const Value: Boolean);
    property CanParseEnd: Boolean read GetCanParseEnd;
    property ParenCount: Integer read FParenCount write FParenCount;
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement); override;
    procedure ExecuteTokenAdded(Sender: TObject; AToken: TgaSQLTokenObj); 
            override;
    property Expression: string read GetExpression;
    property IsCorrect: Boolean read FIsCorrect;
    property IsExpression: Boolean read FIsExpression;
  end;
  
  TgaSQLStatementPartClass = class of TgaSQLStatementPart;

  TFieldExprParseState = (fepsNoSymbolsParsed, fepsFieldExpression,
    fepsFieldAlias, fepsExpression, fepsFieldAliasParsed, fepsFieldParseFinished);
  TgaSQLField = class (TgaSQLExpression)
  private
    FFieldAlias: TgaSQLTokenListBookmark;
    FFieldName: TgaSQLTokenListBookmark;
    FFieldParseState: TFieldExprParseState;
    FFieldPrefixies: TgaSQLTokenList;
    function GetFieldAlias: string;
    function GetFieldName: string;
    function GetFieldPrefix: string;
    procedure SetFieldAlias(const Value: string);
    procedure SetFieldName(const Value: string);
    procedure SetFieldPrefix(const Value: string);
  protected
    procedure InternalSetParseComplete; override;
    procedure ParseFieldAlias(AToken: TgaSQLTokenObj);
    procedure ParseFieldExpression(AToken: TgaSQLTokenObj);
    procedure ParsePreFieldExpression(AToken: TgaSQLTokenObj);
    procedure StartExpressionParse;
    property FieldParseState: TFieldExprParseState read FFieldParseState;
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement); override;
    destructor Destroy; override;
    procedure ExecuteTokenAdded(Sender: TObject; AToken: TgaSQLTokenObj); 
            override;
    property FieldAlias: string read GetFieldAlias write SetFieldAlias;
    property FieldAliasToken: TgaSQLTokenListBookmark read FFieldAlias;
    property FieldName: string read GetFieldName write SetFieldName;
    property FieldNameToken: TgaSQLTokenListBookmark read FFieldName;
    property FieldPrefix: string read GetFieldPrefix write SetFieldPrefix;
    property FieldPrefixies: TgaSQLTokenList read FFieldPrefixies;
  end;
  
  TTableExprParseState = (tepsNoSymbolsParsed, tepsTableName, tepsTableAlias,
    tepsTableAliasParsed, tepsTableParseFinished);
  TgaSQLTable = class (TgaSQLStatementPart)
  private
    FIsAliasAllowed: Boolean;
    FTableAlias: TgaSQLTokenListBookmark;
    FTableName: TgaSQLTokenListBookmark;
    FTableParseState: TTableExprParseState;
    FTablePrefixies: TgaSQLTokenList;
    function GetTableAlias: string;
    function GetTableName: string;
    function GetTablePrefix: string;
    procedure SetTableAlias(const Value: string);
    procedure SetTableName(const Value: string);
    procedure SetTablePrefix(const Value: string);
  protected
    procedure InternalSetParseComplete; override;
    procedure ParsePreTableName(AToken: TgaSQLTokenObj);
    procedure ParseTableAlias(AToken: TgaSQLTokenObj);
    procedure ParseTableName(AToken: TgaSQLTokenObj);
    property TableParseState: TTableExprParseState read FTableParseState write 
            FTableParseState;
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement); override;
    destructor Destroy; override;
    procedure ExecuteTokenAdded(Sender: TObject; AToken: TgaSQLTokenObj); 
            override;
    property IsAliasAllowed: Boolean read FIsAliasAllowed write FIsAliasAllowed;
    property TableAlias: string read GetTableAlias write SetTableAlias;
    property TableAliasToken: TgaSQLTokenListBookmark read FTableAlias;
    property TableName: string read GetTableName write SetTableName;
    property TableNameToken: TgaSQLTokenListBookmark read FTableName;
    property TablePrefix: string read GetTablePrefix write SetTablePrefix;
    property TablePrefixies: TgaSQLTokenList read FTablePrefixies;
  end;
  
  TgaSQLWhereExpression = class (TgaSQLExpression)
  protected
    function GetAsString: string; override;
    procedure SetAsString(const Value: string); override;
  end;
  
  TgaSQLStatementPartList = class (TgaListOfSQLTokenLists)
  private
    FCurrentPart: TgaSQLStatementPart;
    FOwnerStatement: TgaCustomSQLStatement;
    FParseComplete: Boolean;
    FStatementPartType: TgaSQLStatementPartClass;
    FTokenList: TgaSQLTokenList;
    function GetParseComplete: Boolean;
    procedure SetParseComplete(const Value: Boolean);
  protected
    function GetAsString: string; override;
    function GetCurrentPart: TgaSQLStatementPart; virtual;
    procedure InternalSetParseComplete; virtual;
    procedure SetAsString(const Value: string); virtual;
    property OwnerStatement: TgaCustomSQLStatement read FOwnerStatement;
    property StatementPartType: TgaSQLStatementPartClass read 
            FStatementPartType;
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement; 
            AStatementPartType: TgaSQLStatementPartClass);
    destructor Destroy; override;
    procedure Clear; override;
    procedure ExecuteTokenAdded(Sender: TObject; AToken: TgaSQLTokenObj); 
            override;
    property AsString read GetAsString write SetAsString;
    property CurrentPart: TgaSQLStatementPart read GetCurrentPart;
    property ParseComplete: Boolean read GetParseComplete write 
            SetParseComplete;
    property TokenList: TgaSQLTokenList read FTokenList;
  end;
  
  TgaSQLFieldList = class (TgaSQLStatementPartList)
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement);
  end;
  
  TgaSQLTableList = class (TgaSQLStatementPartList)
  public
    constructor Create(AOwnerStatement: TgaCustomSQLStatement);
  end;
  
  TgaSQLOrderByList = class (TgaSQLFieldList)
  protected
    function GetAsString: string; override;
    procedure SetAsString(const Value: string); override;
  end;
  
procedure ParseStringToTokens(const AString: string; ATokenList: TgaSQLTokenHolderList);

implementation

uses
  SysUtils, TypInfo, gaSQLParserConsts;

procedure ParseStringToTokens(const AString: string; ATokenList: TgaSQLTokenHolderList);
var
  lSQLParser: TgaBasicSQLParser;
  lTokenObj: TgaSQLTokenObj;
begin
  ATokenList.Clear;
  lSQLParser := TgaBasicSQLParser.Create(nil);
  try
    lSQLParser.SQLText.Text := AString;
    while lSQLParser.TokenType <> stEnd do
    begin
      lTokenObj := ATokenList.NewToken;
      lTokenObj.AssignTokenInfo(lSQLParser);
      lSQLParser.NextToken;
    end;
  finally
    lSQLParser.Free;
  end;
end;

{
********************************* TgaSQLTable **********************************
}
constructor TgaSQLTable.Create(AOwnerStatement: TgaCustomSQLStatement);
begin
  inherited;
  FIsAliasAllowed := True;
  OwnerStatement.AddTable(Self);
end;

destructor TgaSQLTable.Destroy;
begin
  OwnerStatement.RemoveTable(Self);
  FTableAlias.Free;
  FTableName.Free;
  FTablePrefixies.Free;
  inherited Destroy;
end;

procedure TgaSQLTable.ExecuteTokenAdded(Sender: TObject; AToken: 
        TgaSQLTokenObj);
begin
  inherited;
  if AToken.TokenType = stComment then
    Exit;
  case TableParseState of
    tepsNoSymbolsParsed:
      ParsePreTableName(AToken);
    tepsTableName:
      ParseTableName(AToken);
    tepsTableAlias:
      ParseTableAlias(AToken);
    tepsTableAliasParsed:
      if not (AToken.TokenType in [stDelimitier, stComma, stEnd]) then
        IsInvalid := True;
    tepsTableParseFinished:
      raise Exception.Create(SerrTableParseFinised);
    { fepsExpression:
      Shouldn't get here as IsExpression should be true then }
    else
      raise Exception.CreateFmt(SerrUnecpectedFieldParseState,
        [GetEnumName(TypeInfo(TTableExprParseState), Ord(TableParseState))]);
  end;
  if (AToken.TokenType = stComma) then
    ParseComplete := True;
end;

function TgaSQLTable.GetTableAlias: string;
begin
  if Assigned(FTableAlias) then
    Result := GetTokenObjAsString(FTableAlias.TokenObj)
  else
    Result := EmptyStr;
end;

function TgaSQLTable.GetTableName: string;
begin
  if Assigned(FTableName) then
    Result := GetTokenObjAsString(FTableName.TokenObj)
  else
    Result := EmptyStr;
end;

function TgaSQLTable.GetTablePrefix: string;
begin
  Result := TablePrefixies.AsString;
end;

procedure TgaSQLTable.InternalSetParseComplete;
begin
  inherited;
  TableParseState := tepsTableParseFinished;
end;

procedure TgaSQLTable.ParsePreTableName(AToken: TgaSQLTokenObj);
begin
  case AToken.TokenType of
    stSymbol, stQuotedSymbol, stPeriod:
    begin
      FTablePrefixies := TgaSQLTokenList.CreateMirror(OwnerStatement, OwnerStatement.CurrentSQL);
      FTablePrefixies.SetStartPos(OwnerStatement.CurrentSQL, True);
      FTableParseState := tepsTableName;
    end;
    stDelimitier:
      {skip leading delimitiers};
    else
      IsInvalid := True;
  end;
end;

procedure TgaSQLTable.ParseTableAlias(AToken: TgaSQLTokenObj);
begin
  case AToken.TokenType of
    stDelimitier:
      {no special processing};
    stSymbol, stQuotedSymbol, stString:
      if not AToken.TokenSymbolIs('AS') then
      begin
        FTableAlias := GetBookmark;
        FTableParseState := tepsTableAliasParsed;
      end;
    stOther:
      if AToken.TokenString = ';' then
        FTableParseState := tepsTableAliasParsed
      else
        IsInvalid := True;
    else
      IsInvalid := True;
  end;
  
end;

procedure TgaSQLTable.ParseTableName(AToken: TgaSQLTokenObj);
begin
  case AToken.TokenType of
    stSymbol, stQuotedSymbol, stPeriod:
      ; { Do nothing as added tokens are inserted at the end of the prefixies
          list automatically }
    stDelimitier, stComma:
    begin
      FTablePrefixies.Last;
      // last one should be the current comma or delimitier
      FTablePrefixies.Previous;
      if FTablePrefixies.CurrentItem.TokenType <> stPeriod then
      begin
        Locate(FTablePrefixies.CurrentItem);
        FTableName := GetBookmark;
        FTablePrefixies.Previous;
      end;
      FTablePrefixies.SetEndPos(FTablePrefixies, True);
      if IsAliasAllowed then
        FTableParseState := tepsTableAlias
      else
        FTableParseState := tepsTableAliasParsed;
    end;
    stOther:
      if AToken.TokenString = ';' then
        FTableParseState := tepsTableAliasParsed
      else
        IsInvalid := True;
    else
      IsInvalid := True;
  end;
end;

procedure TgaSQLTable.SetTableAlias(const Value: string);
var
  tmpTokenList: TgaSQLTokenHolderList;
  tmpToken: TgaSQLTokenObj;
begin
  if TableAlias <> Value then
  begin
    CheckModifyAllowed;
    if (not IsAliasAllowed) and (Value <> EmptyStr) then
      raise Exception.Create(SerrTableAliasNotAllowed);
    if not Assigned(FTableName) then
      raise Exception.Create(SerrNoTableForAlias);
    tmpTokenList := TgaSQLTokenHolderList.Create(nil);
    try
      ParseStringToTokens(Value, tmpTokenList);
      TrimTokenList(tmpTokenList, True);
      if tmpTokenList.Count > 1 then
        raise Exception.CreateFmt(SerrWrongTokenCountInArg, ['Table alias', 1, tmpTokenList.Count]);
      tmpTokenList.First;
      if Assigned(FTableAlias) then
        FTableAlias.TokenObj := tmpTokenList.CurrentItem
      else begin
        tmpToken := TgaSQLTokenObj.Create;
        tmpToken.SetTokenInfo(' ', stDelimitier, False, #0);
        GotoBookmark(FTableName);
        InsertAfterCurrent(tmpToken, True);
        InsertAfterCurrent(tmpTokenList.CurrentItem, True);
        FTableAlias := GetBookmark;
      end;
    finally
      tmpTokenList.Free;
    end;
  end;
end;

procedure TgaSQLTable.SetTableName(const Value: string);
var
  tmpTokenList: TgaSQLTokenHolderList;
begin
  if TableName <> Value then
  begin
    CheckModifyAllowed;
    tmpTokenList := TgaSQLTokenHolderList.Create(nil);
    try
      ParseStringToTokens(Value, tmpTokenList);
      TrimTokenList(tmpTokenList, True);
      if tmpTokenList.Count <> 1 then
        raise Exception.CreateFmt(SerrWrongTokenCountInArg, ['Table name', 1, tmpTokenList.Count]);
      tmpTokenList.First;
      FTableName.TokenObj := tmpTokenList.CurrentItem;
    finally
      tmpTokenList.Free;
    end;
  end;
end;

procedure TgaSQLTable.SetTablePrefix(const Value: string);
var
  tmpStr: string;
  tmpTokenList: TgaSQLTokenHolderList;
begin
  if Value[Length(Value)] = '.' then
    tmpStr := Value
  else
    tmpStr := Value + '.';
  if (TablePrefix <> tmpStr) then
  begin
    CheckModifyAllowed;
    tmpTokenList := TgaSQLTokenHolderList.Create(nil);
    try
      ParseStringToTokens(tmpStr, tmpTokenList);
      TrimTokenList(tmpTokenList, True);
      TablePrefixies.CopyListContest(tmpTokenList);
    finally
      tmpTokenList.Free;
    end;
  end;
end;

{
**************************** TgaSQLWhereExpression *****************************
}
function TgaSQLWhereExpression.GetAsString: string;
begin
  Result := EmptyStr;
  if IsEmpty then
    Exit;
  First;
  if CurrentItem.TokenSymbolIs('WHERE') then
  begin
    Next;
    while (not Eof) and (CurrentItem.TokenType = stDelimitier) do
      Next;
  end;
  while not Eof do
  begin
    Result := Result + CurrentItem.TokenAsString;
    Next;
  end;
end;

procedure TgaSQLWhereExpression.SetAsString(const Value: string);
var
  tmpStr: string;
  tmpToken: TgaSQLTokenObj;
begin
  if (Trim(Value) = '') or (SameText('where ', Copy(Value, 1, 6))) then
    tmpStr := Value
  else
    tmpStr := 'where ' + Value;
  inherited SetAsString(tmpStr);
  Last;
  if CurrentItem.TokenType <> stDelimitier then
  begin
    tmpToken := TgaSQLTokenObj.Create;
    tmpToken.SetTokenInfo(#13#10, stDelimitier, False, #0);
    Add(tmpToken);
    ExecuteTokenAdded(Self, tmpToken);
  end;
end;

{
********************************* TgaSQLField **********************************
}
constructor TgaSQLField.Create(AOwnerStatement: TgaCustomSQLStatement);
begin
  inherited;
  FFieldPrefixies := TgaSQLTokenList.CreateMirror(AOwnerStatement, Self);
  SetIsExpression(False);
  OwnerStatement.AddField(Self);
end;

destructor TgaSQLField.Destroy;
begin
  if Assigned(OwnerStatement) then
    OwnerStatement.RemoveField(Self);
  FFieldAlias.Free;
  FFieldName.Free;
  FFieldPrefixies.Free;
  inherited Destroy;
end;

procedure TgaSQLField.ExecuteTokenAdded(Sender: TObject; AToken: 
        TgaSQLTokenObj);
begin
  inherited;
  { Field is written in SQL as follows:
    [table alias][.]FieldName[whitespace][FieldAlias],}
  if AToken.TokenType = stComment then
    Exit;
  if not IsExpression then
  begin
    case FieldParseState of
      fepsNoSymbolsParsed: