qexpryacc.y

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

    if DataSet.Active = False Then DataSet.Open;
    fld := DataSet.FindField(fParam.Name);
    if fld = nil then Exit;
    Result := fld.AsInteger;
  end else
    Result := fParam.AsInteger;
End;

Function TExplicitParamExpr.GetAsBoolean: Boolean;
var
  DataSet: TDataSet;
  fld: TField;
Begin
  Result:= false;
  if fAnalizer.xquery.DataSource <> Nil then
  begin
    DataSet := fanalizer.xquery.DataSource.DataSet;
    If DataSet = Nil Then exit;
    if DataSet.Active = False Then DataSet.Open;
    fld := DataSet.FindField(fParam.Name);
    if fld = nil then Exit;
    Result := fld.AsBoolean;
  end else
    Result := fParam.AsBoolean;
End;

//unley
Function TExplicitParamExpr.GetIsNull: boolean;
Begin
  Result := fParam.IsNull;
End;


//
constructor TExprParser.Create(SqlAnalizer: TObject; DataSet: TDataSet);
begin
  inherited Create;
  fDefaultDataSet := DataSet;
  fAnalizer := SqlAnalizer;
  fIdReferences := TStringList.Create;

  FExprList:= TList.Create;
  FStackedParamCount:= TList.Create;
  FGroupIdentList:= TStringList.create;
  FIdentifierList:= TStringList.create;
end;

destructor TExprParser.Destroy;
var
  I: Integer;
begin
  Expression.Free;
  fIdReferences.Free;

  for I:= 0 to FExprList.Count-1 do
    TObject(FExprList[I]).Free;
  FExprList.Free;
  if FWhenParamList<>nil then
    FWhenParamList.Free;
  if FThenParamList<>nil then
    FThenParamList.Free;
  if FElseExpr<>nil then
    FElseExpr.Free;
  FStackedParamCount.Free;
  FGroupIdentList.free;
  FIdentifierList.free;
  inherited Destroy;
end;

Procedure TExprParser.IDFunc( Sender: TObject; Const Group, Identifier: String;
  ParameterList: TParameterList; Var Expression: TExpression );
Var
  TmpDataSet: TDataSet;
  FieldName, TableName: String;
  NumError, Idx: Integer;
  F: TField;
  Accept: Boolean;
  Params: TParameterList;
  xqField: TxqField;
  Datatype: TExprType;
  MaxLen: Integer;
Begin
  Expression := Nil;
  NumError := 0;
  // The fields will be found in the result set
  If ( fAnalizer <> Nil ) And ( Length( Group ) > 0 ) And
     ( Length( Identifier ) > 0 ) And ( ParameterList = Nil ) Then
  Begin
    With TSqlAnalizer(fAnalizer) Do
    Begin
      If Not WhereContainsOnlyBasicFields And ( JoinList.Count > 0 ) Then
      Begin
        If ResultSet <> Nil Then
        Begin
          // received table.field notation
          FieldName := Group + '.' + Identifier;
          xqField := TSqlAnalizer(fAnalizer).ResultSet.FindField( FieldName );
          If xqField <> Nil Then
            Expression := TResultSetFieldExpr.Create( ParameterList, xqField );
        End;
      End;
    End;
    If Expression = Nil Then
    Begin
      // if was not found on the result set, search on table.field datasets
      TableName := Group;
      TmpDataSet := TSqlAnalizer(fAnalizer).FindDataSetByName( TableName );
      If Not Assigned( TmpDataSet ) Then
        Raise EExpression.Create( Format( SWrongDataSetname, [TableName] ) );
      FieldName := Identifier;
      If TmpDataSet = fDefaultDataSet Then
        Inc( CheckData.RefCount ); // number of primary dataset referenced
      (*else                                    // number of other datasets referenced in the expression
         Inc(CheckData.OtherRefCount);*)
      // create the list of datasets referenced in the expression
      If Assigned( fReferencedDataSets ) Then
      Begin
        Idx := fReferencedDataSets.IndexOf( TmpDataSet );
        If Idx >= 0 Then
          fReferencedDataSets[Idx].Count := fReferencedDataSets[Idx].Count + 1
        Else
          With fReferencedDataSets.Add Do
          Begin
            DataSet := TmpDataSet;
            Count := 1;
          End;
      End;
      // Create expression
      F := TmpDataSet.FindField( FieldName );
      If Assigned( F ) Then
      Begin
        Params := TParameterList.Create;
        Params.Add( TStringLiteral.Create( Group ) );
        Params.Add( TStringLiteral.Create( Identifier ) );
        Expression := TFieldExpr.Create( Params, F, TSqlAnalizer(fAnalizer).xQuery, Self );
        If CheckData.RefCount = 1 Then
          CheckData.Field := F;
        Inc( CheckData.FieldCount );
        If CheckData.FieldCount <= MAX_INDEXED_FIELDS Then
          CheckData.Fields[CheckData.FieldCount] := F; // used in multi-key joining
      End
      Else
        Raise EExpression.CreateFmt( SWrongFieldName, [FieldName] );
    End;
  End;
  If Expression = Nil Then
  Begin
    If Identifier = 'NOW' Then
    begin
      CheckData.HasMorefunctions := True;
      If Not Assigned( ParameterList ) Then
        Expression := TNowExpr.Create( ParameterList )
      else
        NumError := 1;
    End
    Else If Identifier = 'SQLTRIM' Then // SQL TRIM function
    Begin
      CheckData.HasMorefunctions := True;
      If Assigned( ParameterList ) And ( ParameterList.Count = 3 ) Then
      Begin
        If Length( ParameterList.AsString[0] ) <> 1 Then
          Raise EExpression.Create( SWrongLengthInTrim );
        Expression := TSQLTrimExpr.Create( ParameterList )
      End
      Else
        NumError := 1;
    End
    Else If ( Identifier = 'ROUNDDEC' ) Or ( Identifier = 'TRUNCDEC' ) Then
    Begin
      CheckData.HasMorefunctions := True;
      If Assigned( ParameterList ) And ( ParameterList.Count = 2 ) And
        ( ParameterList.Exprtype[0] In [ttFloat, ttInteger] ) And
        ( ParameterList.Exprtype[1] = ttInteger ) Then
      Begin
        Expression := TRoundDecExpr.Create( ParameterList,
          ( AnsiCompareText( Identifier, 'ROUNDDEC' ) = 0 ) )
      End
      Else
        NumError := 1;
    End
    Else If Identifier = 'ISNULL' Then // for use in sql select only
    Begin
      CheckData.HasMorefunctions := True;
      // not enough checking for now
      If Assigned( ParameterList ) And ( ParameterList.Count = 2 ) Then
        Expression := TISNULLExpr.Create( ParameterList )
      Else
        NumError := 1;
    End Else if (fAnalizer = Nil) and (fDefaultDataSet <> Nil) then
    Begin
      // used in filter property in TxQuery
      // now look in the fDataSet fields
      F := fDefaultDataSet.FindField( Identifier );
      If Assigned( F ) Then
      Begin
        If Not Assigned( ParameterList ) Then
          Expression := TFilterFieldExpr.Create( ParameterList, F )
        Else
          NumError := 1;
      End;
    End;
  End;
  { RFC 1.80 }
  if (fAnalizer <> Nil) And (Expression = Nil) And
    Assigned(TSqlAnalizer(fAnalizer).xQuery.OnUDFCheck) And
    Assigned(TSqlAnalizer(fAnalizer).xQuery.OnUDFSolve) then
  Begin
    With TSqlAnalizer(fAnalizer) Do
    Begin // is this an UDF function ?
      Accept := False;
      Datatype:= ttString;
      MaxLen:= 0;
      xQuery.OnUDFCheck( xQuery, Identifier, ParameterList, Datatype, MaxLen, Accept );
      If Accept Then
      Begin
        CheckData.HasMorefunctions := True;
        Expression := TUDFExpr.Create( ParameterList, xQuery, Identifier, Datatype, MaxLen );
      End
      Else
        NumError := 1; // wrong number of params
    End;
  End;

  If NumError = 1 Then
    Raise EExpression.CreateFmt( SWrongParameters, [Identifier] );
End;

Procedure TExprParser.ParseExpression( Const ExprStr: String );
Var
  lexer: TCustomLexer;
  outputStream: TMemoryStream;
  errorStream: TMemoryStream;
  stream: TMemoryStream;
  ErrLine, ErrCol: Integer;
  ErrMsg, Errtxt: String;
Begin
  If Length( ExprStr ) = 0 Then Exit;
  FillChar( CheckData, SizeOf( TCheckData ), 0 );
  If Expression <> Nil Then
    FreeObject( Expression );
  Try
    If Length( ExprStr ) > 0 Then
    Begin
      stream := TMemoryStream.create;
      stream.write( ExprStr[1], Length( ExprStr ) );
      stream.seek( 0, 0 );
      outputStream := TMemoryStream.create;
      errorStream := TMemoryStream.create;
      lexer := TExprLexer.Create;
      lexer.yyinput := Stream;
      lexer.yyoutput := outputStream;
      lexer.yyerrorfile := errorStream;
      // link to the identifier function
      yyLexer := lexer; // lexer and parser linked
      Try
        If yyparse = 1 Then
        Begin
          ErrLine := lexer.yylineno;
          ErrCol := lexer.yycolno - Lexer.yyTextLen - 1;
          ErrMsg := yyerrormsg;
          lexer.GetyyText (Errtxt);
          Raise EXQueryError.CreateFmt( SExprParserError, [ErrMsg, ErrLine, ErrCol, ErrTxt] );
        End;
        Expression := GetExpression;
        CheckData.HasMorefunctions := CheckData.HasMorefunctions Or Self.IsComplex;
      Finally
        stream.free;
        lexer.free;
        outputstream.free;
        errorstream.free;
      End;
    End;
  Except
    On E: Exception Do
    Begin
      Expression := Nil;
      //MessageToUser(E.Message, smsgerror,MB_ICONERROR);
      Raise;
    End;
  End;
End;

Function TExprParser.CheckExpression( Const ExprStr: String ): Boolean;
Var
  lexer: TCustomLexer;
  outputStream: TMemoryStream;
  errorStream: TMemoryStream;
  stream: TMemoryStream;
  ErrLine, ErrCol: Integer;
  ErrMsg, Errtxt: String;
Begin
  FillChar( CheckData, SizeOf( TCheckData ), 0 );
  Result := false;
  If Expression <> Nil Then
    FreeObject( Expression );
  Try
    If Length( ExprStr ) > 0 Then
    Begin
      stream := TMemoryStream.create;
      stream.write( ExprStr[1], Length( ExprStr ) );
      stream.seek( 0, 0 );
      outputStream := TMemoryStream.create;
      errorStream := TMemoryStream.create;
      lexer := TExprLexer.Create;
      lexer.yyinput := Stream;
      lexer.yyoutput := outputStream;
      lexer.yyerrorfile := errorStream;
      // link to the identifier function
      yyLexer := lexer; // lexer and parser linked
      Try
        If yyparse = 1 Then
        Begin
          ErrLine := lexer.yylineno;
          ErrCol := lexer.yycolno - Lexer.yyTextLen - 1;
          ErrMsg := Self.yyerrormsg;
          lexer.GetyyText (Errtxt);
          Raise EXQueryError.CreateFmt( SExprParserError, [ErrMsg, ErrLine, ErrCol, ErrTxt] );
        End;
        Expression := Self.GetExpression;
        CheckData.HasMorefunctions := CheckData.HasMorefunctions Or IsComplex;
        Result := CheckData.RefCount > 0;
      Finally
        stream.free;
        lexer.free;
        outputstream.free;
        errorstream.free;
      End;
    End;
  Except
    On E: Exception Do
    Begin
      Expression := Nil;
      //MessageToUser(E.Message, smsgerror,MB_ICONERROR);
      Raise;
    End;
  End;
End;

Function TExprParser.GetString( const s: string ): string;
begin
  Result:= Copy( s, 2, Length(s) - 2);
end;

// this function returns the final expression obtained
function TExprParser.GetExpression: TExpression;
begin
  Result:= nil;
  if FExprList.Count<>1 then Exit;
  Result:= TExpression(FExprList[0]);
  FExprList.Delete(0);
end;

function TExprParser.GetParamList: TParameterList;
var
  I: Integer;
  NumParams: Integer;
begin
  Result:= nil;
  if FStackedParamCount.Count=0 then
    NumParams:= 0
  else
  begin
    NumParams:= Longint(FStackedParamCount[FStackedParamCount.Count-1]);
    FStackedParamCount.Delete(FStackedParamCount.Count-1);
  end;
  if (FExprList.Count=0) or (NumParams=0) or (NumParams>FExprList.Count) then Exit;
  Result:= TParameterList.Create;
  for I:= 0 to NumParams - 1 do
    Result.Add(FExprList[FExprList.Count - NumParams + I]);
  while NumParams > 0 do
  begin
    FExprList.Delete(FExprList.Count-1);
    Dec(NumParams);
  end;
end;

function TExprParser.ForceParamList(Count: Integer): TParameterList;
var
  I: Integer;
  NumParams: Integer;
begin
  Result:= nil;
  NumParams:= Count;
  if (FExprList.Count=0) or (NumParams=0) or (NumParams>FExprList.Count) then Exit;
  Result:= TParameterList.Create;
  for I:= 0 to NumParams - 1 do
    Result.Add(FExprList[FExprList.Count - NumParams + I]);
  while NumParams > 0 do
  begin
    FExprList.Delete(FExprList.Count-1);
    Dec(NumParams);
  end;
end;

procedure TExprParser.GetTwoOperators;
begin
  Op1:= TExpression(FExprList[FExprList.Count-2]);
  Op2:= TExpression(FExprList[FExprList.Count-1]);
  FExprList.Delete(FExprList.Count-1);
  FExprList.Delete(FExprList.Count-1);
end;

procedure TExprParser.GetOneOperator;
begin
  Op1:= TExpression(FExprList[FExprList.Count-1]);
  FExprList.Delete(FExprList.Count-1);
end;

procedure TExprParser.AddParam;
begin
  FParamCount:= Longint(FStackedParamCount[FStackedParamCount.Count-1]);
  Inc(FParamCount);