gasqlparserhelperclasses.pas

一个sql语法分析程序

        ParsePreFieldExpression(AToken);
      fepsFieldExpression:
        ParseFieldExpression(AToken);
      fepsFieldAlias:
        ParseFieldAlias(AToken);
      fepsFieldAliasParsed:
        if AToken.TokenType <> stDelimitier then
          StartExpressionParse;
      fepsFieldParseFinished:
        raise Exception.Create(SerrFieldParseFinised);
      { fepsExpression:
        Shouldn't get here as IsExpression should be true then }
      else
        raise Exception.CreateFmt(SerrUnecpectedFieldParseState,
          [GetEnumName(TypeInfo(TFieldExprParseState), Ord(FieldParseState))]);
    end;
    if (AToken.TokenType = stComma) then
      ParseComplete := True;
  end;
end;

function TgaSQLField.GetFieldAlias: string;
begin
  if Assigned(FFieldAlias) then
    Result := GetTokenObjAsString(FFieldAlias.TokenObj)
  else
    Result := EmptyStr;
end;

function TgaSQLField.GetFieldName: string;
begin
  if Assigned(FFieldName) then
    Result := GetTokenObjAsString(FFieldName.TokenObj)
  else
    Result := EmptyStr;
end;

function TgaSQLField.GetFieldPrefix: string;
begin
  Result := FFieldPrefixies.AsString;
end;

procedure TgaSQLField.InternalSetParseComplete;
begin
  inherited;
  FFieldParseState := fepsFieldParseFinished;
end;

procedure TgaSQLField.ParseFieldAlias(AToken: TgaSQLTokenObj);
begin
  case AToken.TokenType of
    stDelimitier:
      {no special processing};
    stSymbol, stQuotedSymbol, stString:
      if not AToken.TokenSymbolIs('AS') then
      begin
        FFieldAlias := GetBookmark;
        FFieldParseState := fepsFieldAliasParsed;
      end;
    else
      StartExpressionParse;
  end;
end;

procedure TgaSQLField.ParseFieldExpression(AToken: TgaSQLTokenObj);
begin
  case AToken.TokenType of
    stSymbol, stQuotedSymbol, stPeriod:
      ;
    stDelimitier, stComma:
    begin
      FFieldPrefixies.Last;
      // last one should be the current comma or delimitier
      FFieldPrefixies.Previous;
      if FFieldPrefixies.CurrentItem.TokenType <> stPeriod then
      begin
        Locate(FFieldPrefixies.CurrentItem);
        FFieldName := GetBookmark;
        FFieldPrefixies.Previous;
      end;
      FFieldPrefixies.SetEndPos(FFieldPrefixies, True);
      FFieldParseState := fepsFieldAlias;
      { #ToDo2 Should there be an property do determ whete field alias is
                allowed or not }
    end;
    stOther:
      if AToken.TokenString <> '*' then
        StartExpressionParse;
    else
      StartExpressionParse;
  end;
end;

procedure TgaSQLField.ParsePreFieldExpression(AToken: TgaSQLTokenObj);
begin
  case AToken.TokenType of
    stSymbol, stQuotedSymbol, stPeriod:
    begin
      FFieldPrefixies.SetStartPos(Self, True);
      FFieldParseState := fepsFieldExpression;
    end;
    stDelimitier:
        { skip leading whitespaces };
    stComma:
      IsInvalid := True;
    stOther:
      if AToken.TokenString = '*' then
      begin
        FFieldName := GetBookmark;
        FFieldParseState := fepsFieldAliasParsed;
      end else
        StartExpressionParse;
    else
      StartExpressionParse;
  end;
end;

procedure TgaSQLField.SetFieldAlias(const Value: string);
var
  tmpTokenList: TgaSQLTokenHolderList;
  tmpToken: TgaSQLTokenObj;
begin
  if FieldAlias <> Value then
  begin
    CheckModifyAllowed;
    tmpTokenList := TgaSQLTokenHolderList.Create(nil);
    try
      ParseStringToTokens(Value, tmpTokenList);
      TrimTokenList(tmpTokenList, True);
      if tmpTokenList.Count > 1 then
        raise Exception.CreateFmt(SerrWrongTokenCountInArg, ['Field alias', 1, tmpTokenList.Count]);
      tmpTokenList.First;
      if Assigned(FFieldAlias) then
        FFieldAlias.TokenObj := tmpTokenList.CurrentItem
      else begin
        if IsExpression then
          Last
        else
          GotoBookmark(FFieldName);
        tmpToken := TgaSQLTokenObj.Create;
        tmpToken.SetTokenInfo(' ', stDelimitier, False, #0);
        InsertAfterCurrent(tmpToken, True);
        InsertAfterCurrent(tmpTokenList.CurrentItem, True);
        FFieldAlias := GetBookmark;
      end;
    finally
      tmpTokenList.Free;
    end;
  end;
end;

procedure TgaSQLField.SetFieldName(const Value: string);
var
  tmpTokenList: TgaSQLTokenHolderList;
begin
  if FieldName <> Value then
  begin
    CheckModifyAllowed;
    if IsExpression then
      raise Exception.Create(SerrFieldAttrCantBeChangedInExpression);
    tmpTokenList := TgaSQLTokenHolderList.Create(nil);
    try
      ParseStringToTokens(Value, tmpTokenList);
      TrimTokenList(tmpTokenList, True);
      if tmpTokenList.Count <> 1 then
        raise Exception.CreateFmt(SerrWrongTokenCountInArg, ['Field name', 1, tmpTokenList.Count]);
      tmpTokenList.First;
      FFieldName.TokenObj := tmpTokenList.CurrentItem;
    finally
      tmpTokenList.Free;
    end;
  end;
end;

procedure TgaSQLField.SetFieldPrefix(const Value: string);
var
  tmpStr: string;
  tmpTokenList: TgaSQLTokenHolderList;
begin
  if Value[Length(Value)] = '.' then
    tmpStr := Value
  else
    tmpStr := Value + '.';
  if (FieldPrefix <> tmpStr) then
  begin
    CheckModifyAllowed;
    if IsExpression then
      raise Exception.Create(SerrFieldAttrCantBeChangedInExpression);
    tmpTokenList := TgaSQLTokenHolderList.Create(nil);
    try
      ParseStringToTokens(tmpStr, tmpTokenList);
      TrimTokenList(tmpTokenList, True);
      FieldPrefixies.CopyListContest(tmpTokenList)
    finally
      tmpTokenList.Free;
    end;
  end;
end;

procedure TgaSQLField.StartExpressionParse;
begin
  FreeAndNil(FFieldName);
  FreeAndNil(FFieldAlias);
  FreeAndNil(FFieldPrefixies);
  FIsExpression := True;
  FFieldParseState := fepsExpression;
  First;
  while not Eof do
  begin
    ParseExpression(CurrentItem);
    Next;
  end;
end;

{
*************************** TgaSQLStatementPartList ****************************
}
constructor TgaSQLStatementPartList.Create(AOwnerStatement: 
        TgaCustomSQLStatement; AStatementPartType: TgaSQLStatementPartClass);
begin
  inherited Create;
  FTokenList := TgaSQLTokenList.CreateMirror(AOwnerStatement, 
          AOwnerStatement.CurrentSQL);
  FTokenList.SetStartPos(AOwnerStatement.CurrentSQL, True);
  FStatementPartType := AStatementPartType;
  FOwnerStatement := AOwnerStatement;
end;

destructor TgaSQLStatementPartList.Destroy;
begin
  FreeAndNil(FTokenList);
  inherited Destroy;
end;

procedure TgaSQLStatementPartList.Clear;
begin
  FCurrentPart := nil;
  inherited Clear;
  if Assigned(TokenList) then
    TokenList.Clear;
end;

procedure TgaSQLStatementPartList.ExecuteTokenAdded(Sender: TObject; AToken: 
        TgaSQLTokenObj);
begin
  CurrentPart.ExecuteTokenAdded(Sender, AToken);
  if CurrentPart.ParseComplete then
    FCurrentPart := nil;
  TokenList.Locate(AToken);
end;

function TgaSQLStatementPartList.GetAsString: string;
begin
  Result := inherited GetAsString;
end;

function TgaSQLStatementPartList.GetCurrentPart: TgaSQLStatementPart;
begin
  if not Assigned(FCurrentPart) then
  begin
    FCurrentPart := StatementPartType.Create(OwnerStatement);
    Add(FCurrentPart);
  end;
  Result := FCurrentPart;
end;

function TgaSQLStatementPartList.GetParseComplete: Boolean;
begin
  Result := FParseComplete;
end;

procedure TgaSQLStatementPartList.InternalSetParseComplete;
begin
  FParseComplete := True;
  TokenList.SetEndPos(TokenList, True);
  TokenList.ActiveDataShare := False;
end;

procedure TgaSQLStatementPartList.SetAsString(const Value: string);
var
  tmpTokenList: TgaSQLTokenHolderList;
  AItem: TgaSQLTokenObj;
begin
  tmpTokenList := TgaSQLTokenHolderList.Create(nil);
  try
    ParseStringToTokens(Value, tmpTokenList);
    TrimTokenList(tmpTokenList, True, [stEnd]);
    if tmpTokenList.Count = 0 then
      tmpTokenList.AddToken(TgaSQLTokenObj.CreatePlaceHolder);
    Clear;
    tmpTokenList.First;
    while not tmpTokenList.Eof do
    begin
      AItem := tmpTokenList.CurrentItem;
      TokenList.Add(AItem);
      // #Todo2 this can be optimized
      OwnerStatement.CurrentSQL.Locate(AItem);
      ExecuteTokenAdded(Self, AItem);
      tmpTokenList.Next;
    end;
  finally
    tmpTokenList.Free;
  end;
end;

procedure TgaSQLStatementPartList.SetParseComplete(const Value: Boolean);
begin
  if Value then
    InternalSetParseComplete;
end;

{
******************************* TgaSQLFieldList ********************************
}
constructor TgaSQLFieldList.Create(AOwnerStatement: TgaCustomSQLStatement);
begin
  inherited Create(AOwnerSTatement, TgaSQLField);
end;

{
******************************* TgaSQLTableList ********************************
}
constructor TgaSQLTableList.Create(AOwnerStatement: TgaCustomSQLStatement);
begin
  inherited Create(AOwnerSTatement, TgaSQLTable);
end;

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

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

{
***************************** TgaSQLStatementPart ******************************
}
constructor TgaSQLStatementPart.Create(AOwnerStatement: TgaCustomSQLStatement);
begin
  if not Assigned(AOwnerStatement) then
    raise Exception.Create(SerrStmPartWithoutStm);
  inherited CreateMirror(AOwnerStatement, AOwnerStatement.CurrentSQL);
end;

procedure TgaSQLStatementPart.CheckModifyAllowed;
begin
  if not Assigned(OwnerStatement) then
    raise Exception.Create(SerrNowOwnerParser)
end;

function TgaSQLStatementPart.GetAsString: string;
begin
  Result := inherited GetAsString;
end;

function TgaSQLStatementPart.GetParseComplete: Boolean;
begin
  Result := InternalGetParseComplete;
end;

function TgaSQLStatementPart.InternalGetParseComplete: Boolean;
begin
  Result := FParseComplete;
end;

procedure TgaSQLStatementPart.InternalSetParseComplete;
begin
  FParseComplete := True;
  SetEndPos(Self, True);
  ActiveDataShare := False;
end;

procedure TgaSQLStatementPart.SetAsString(const Value: string);
var
  tmpTokenList: TgaSQLTokenHolderList;
begin
  CheckModifyAllowed;
  tmpTokenList := TgaSQLTokenHolderList.Create(nil);
  try
    ParseStringToTokens(Value, tmpTokenList);
    TrimTokenList(tmpTokenList, True, [stEnd]);
    if tmpTokenList.Count = 0 then
      tmpTokenList.AddToken(TgaSQLTokenObj.CreatePlaceHolder);
    CopyListContest(tmpTokenList);
  finally
    tmpTokenList.Free;
  end;
end;

procedure TgaSQLStatementPart.SetIsInvalid(const Value: Boolean);
begin
  FIsInvalid := Value;
end;

procedure TgaSQLStatementPart.SetParseComplete(const Value: Boolean);
begin
  if Value then
    InternalSetParseComplete;
end;

{
******************************* TgaSQLExpression *******************************
}
constructor TgaSQLExpression.Create(AOwnerStatement: TgaCustomSQLStatement);
begin
  inherited Create(AOwnerStatement);
  FisExpression := True;
  FIsCorrect := True;
end;

procedure TgaSQLExpression.AddParen(AToken: TgaSQLTokenObj);
begin
  if FParenCount = 0 then
  begin
    FOldOnStatementAdd := OwnerStatement.OnTokenAdded;
    OwnerStatement.OnTokenAdded := ExecuteTokenAdded;
  end;
  Inc(FParenCount);
end;

procedure TgaSQLExpression.ExecuteTokenAdded(Sender: TObject; AToken: 
        TgaSQLTokenObj);
begin
  inherited ;
  if AToken.TokenType = stComment then
    Exit;
  if IsExpression then
    ParseExpression(AToken);
end;

function TgaSQLExpression.GetCanParseEnd: Boolean;
begin
  Result := ParenCount = 0;
end;

function TgaSQLExpression.GetExpression: string;
begin
  if IsExpression then
    Result := AsString
  else
    Result := EmptyStr;
end;

procedure TgaSQLExpression.ParseExpression(AToken: TgaSQLTokenObj);
begin
  // #Todo3 Expression parsing not implemented... yet
  case AToken.TokenType of
    stLParen:
      AddParen(AToken);
    stRParen:
      RemoveParen(AToken);
  end;
end;

procedure TgaSQLExpression.RemoveParen(AToken: TgaSQLTokenObj);
begin
  Dec(FParenCount);
  if ParenCount = 0 then
    OwnerStatement.OnTokenAdded := FOldOnStatementAdd;
  if ParenCount < 0 then
    FIsCorrect := False;
end;

procedure TgaSQLExpression.SetIsExpression(const Value: Boolean);
begin
  FIsExpression := Value;
end;

end.