qexpryacc.pas

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

// Template for ExprParser


{**********************************************}
{   Expression Parser                          }
{   Copyright (C) 2002 by Alfonso Moreno       }
{**********************************************}
unit QExprYacc;

{$I xq_flag.INC}
{$R Qexpryacc.res}
interface

uses
  SysUtils, Classes, Windows, Dialogs, QYaccLib, QBaseExpr, Db
(*$IFDEF LEVEL6*)
  , Variants
(*$ENDIF*)
  ;

const
  MAX_INDEXED_FIELDS = 10;

type

  TReferencedDatasetList = Class;

  TReferencedDataSetItem = Class
  Private
    FReferencedDataSets: TReferencedDataSetList;
    FDataSet: TDataSet;
    FCount: Integer;
  Public
    Constructor Create( RefDataSetList: TReferencedDataSetList );
    Property DataSet: TDataSet Read fDataSet Write fDataSet;
    Property Count: Integer Read fCount Write fCount;
  End;

  TReferencedDataSetList = Class
    FItems: TList;
    Function GetCount: Integer;
    Function GetItem( Index: Integer ): TReferencedDataSetItem;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Function Add: TReferencedDataSetItem;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Function IndexOf( DataSet: TDataSet ): Integer;

    Property Count: Integer Read GetCount;
    Property Items[Index: Integer]: TReferencedDataSetItem Read GetItem; Default;
  End;

  TCheckData = Record
    Field: TField; // the field referenced
    RefCount: Integer; // No of references to a field
    FieldCount: Integer; // number of fields referenced in expression
    Fields: Array[1..MAX_INDEXED_FIELDS] Of TField; // the fields referenced (used for joining)
    HasMorefunctions: Boolean; // expression have more functions
  End;

  TExprParser = class(TCustomParser)
  private
    fDefaultDataSet: TDataSet;
    fAnalizer: TObject;
    fIdReferences: TStrings;
    fReferencedDataSets: TReferencedDataSetList;

    FExprList: TList;
    fTempParams: TParameterList;
    fGroupIdent: string;
    fIdentifier: string;
    fGroupIdentList: TStringList;
    fIdentifierList: TStringList;
    { is not this a simple expression ? like TABLE.FIELD
      this is used for detecting if giving the same data type to the
      result set as the original field }
    fIsComplex: Boolean;
    { used to obtain a pair of operators }
    Op1, Op2: TExpression;
    { a stacked list of params referencing to FExprList }
    fStackedParamCount: TList;
    { the number of parameters for the last function }
    fParamCount: Integer;
    { for the case..when..else..end }
    fWhenParamList: TParameterList;
    fThenParamList: TParameterList;
    fElseExpr: TExpression;
    { used in unknown identifiers }
    IDF: TExpression;
    Procedure IDFunc( Sender: TObject; Const Group, Identifier: String;
      ParameterList: TParameterList; Var Expression: TExpression );
    Function GetExplicitParam( const ParamName: string ): string;
    function AddExpression(Expression: TExpression): TExpression;
    function GetParamList: TParameterList;
    function ForceParamList(Count: Integer): TParameterList;
    procedure GetTwoOperators;
    procedure GetOneOperator;
    procedure AddParam;
    function GetString( const s: string ): string;
  public
    SubqueryExpr: TExpression; // used for subqueries only (special case)
    CheckData: TCheckData; // used when checking expression
    Expression: TExpression; // the real expression to evaluate

    constructor Create(SqlAnalizer: TObject; DataSet: TDataSet);
    destructor Destroy; override;
    function yyparse : integer; override;
    function GetExpression: TExpression;
    Procedure ParseExpression( Const ExprStr: String );
    Function CheckExpression( Const ExprStr: String ): Boolean;

    Property ReferencedDataSets: TReferencedDataSetList Read fReferencedDataSets Write fReferencedDataSets;
    Property IdReferences: TStrings Read FIdReferences;

    property IsComplex: Boolean read FIsComplex write FIsComplex;
  end;

const _IDENTIFIER = 257;
const _UINTEGER = 258;
const _SINTEGER = 259;
const _NUMERIC = 260;
const _STRING = 261;
const _COMA = 262;
const _LPAREN = 263;
const _RPAREN = 264;
const _PERIOD = 265;
const _COLON = 266;
const RW_OR = 267;
const RW_XOR = 268;
const RW_AND = 269;
const _EQ = 270;
const _NEQ = 271;
const _GT = 272;
const _LT = 273;
const _GE = 274;
const _LE = 275;
const RW_BETWEEN = 276;
const RW_IN = 277;
const RW_LIKE = 278;
const _PLUS = 279;
const _SUB = 280;
const _DIV = 281;
const RW_DIV = 282;
const _MULT = 283;
const RW_MOD = 284;
const RW_SHL = 285;
const RW_SHR = 286;
const UMINUS = 287;
const _EXP = 288;
const RW_NOT = 289;
const _ILLEGAL = 290;
const _COMMENT = 291;
const _BLANK = 292;
const _TAB = 293;
const _NEWLINE = 294;
const RW_TRUE = 295;
const RW_FALSE = 296;
const RW_STRING = 297;
const RW_FLOAT = 298;
const RW_INTEGER = 299;
const RW_BOOLEAN = 300;
const RW_CASE = 301;
const RW_WHEN = 302;
const RW_THEN = 303;
const RW_ELSE = 304;
const RW_END = 305;
const RW_IF = 306;
const RW_CAST = 307;
const RW_AS = 308;
const RW_ESCAPE = 309;

type YYSType = record
               yystring : string
               end(*YYSType*);

// global definitions:

var yylval : YYSType;

implementation

uses
  xquery, xqmiscel, Math, xqconsts, qlexlib, QExprLex, xqbase;

Constructor TReferencedDataSetItem.Create( RefDataSetList:
  TReferencedDataSetList );
Begin
  Inherited Create;
  fReferencedDataSets := RefDataSetList;
End;

Constructor TReferencedDataSetList.Create;
Begin
  Inherited Create;
  fItems := TList.Create;
End;

Destructor TReferencedDataSetList.Destroy;
Begin
  Clear;
  fItems.Free;
  Inherited Destroy;
End;

Function TReferencedDataSetList.GetCount: Integer;
Begin
  Result := fItems.Count;
End;

Function TReferencedDataSetList.GetItem( Index: Integer ): TReferencedDataSetItem;
Begin
  Result := fItems[Index];
End;

Function TReferencedDataSetList.Add: TReferencedDataSetItem;
Begin
  Result := TReferencedDataSetItem.Create( Self );
  fItems.Add( Result );
End;

Procedure TReferencedDataSetList.Clear;
Var
  I: Integer;
Begin
  For I := 0 To fItems.Count - 1 Do
    TReferencedDataSetItem( fItems[I] ).Free;
  fItems.Clear;
End;

Procedure TReferencedDataSetList.Delete( Index: Integer );
Begin
  TReferencedDataSetItem( fItems[Index] ).Free;
  fItems.Delete( Index );
End;

Function TReferencedDataSetList.IndexOf( DataSet: TDataSet ): Integer;
Var
  I: Integer;
Begin
  result := -1;
  For I := 0 To fItems.Count - 1 Do
    If TReferencedDataSetItem( fItems[I] ).Dataset = Dataset Then
    Begin
      result := I;
      Exit;
    End;
End;


Type

  TExplicitParamExpr = Class( TExpression )
  Private
    fAnalizer: TSqlAnalizer;
    fParam: TParam;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprtype; Override;
    Function GetIsNull: boolean; Override;
  Public
    Constructor Create( Analizer: TSqlAnalizer; Param: TParam );
  End;

  TFieldExpr = Class( Tfunction )
  Private
    FField: TField;
    FxQuery: TCustomxQuery;
    FParser: TExprParser;
  Protected
    Function GetMaxString: String; Override;
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprtype; Override;
    Function GetIsNull: boolean; Override;
  Public
    Constructor Create( ParameterList: TParameterList;
      F: TField; xQuery: TCustomxQuery; Parser: TExprParser );
    Property Field: TField Read FField;
  End;

  TResultSetFieldExpr = Class( TFunction )
  Private
    fxqField: TxqField;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprtype; Override;
    Function GetIsNull: boolean; Override;
  Public
    Constructor Create( ParameterList: TParameterList; xqField: TxqField );
  End;

  TStrToDateExpr = Class( Tfunction )
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprtype: TExprtype; Override;
  End;

  TNowExpr = Class( Tfunction )
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprtype: TExprtype; Override;
  End;

  TSQLTrimExpr = Class( Tfunction )
  Protected
    Function GetMaxString: String; Override;
    Function GetAsString: String; Override;
    Function GetExprtype: TExprtype; Override;
  End;

  TRoundDecExpr = Class( Tfunction )
  Private
    FIsRound: Boolean;
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( ParameterList: TParameterList; IsRound: Boolean );
  End;

  TUDFExpr = Class( Tfunction )
  Private
    FxQuery: TCustomXQuery;
    FIdentifier: String;
    FResulttype: TExprtype;
    FParams: TParameterList;
    FMaxLen: Integer;
  Protected
    Function GetMaxString: String; Override;
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( ParameterList: TParameterList; xQuery: TCustomXQuery;
      Const Identifier: String; Resulttype: TExprtype; MaxLen: Integer );
  End;

  TISNULLExpr = Class( Tfunction )
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  End;

  TNULLValueExpr = Class( Tfunction )
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  End;

  TFilterFieldExpr = Class( Tfunction )
  Private
    fField: TField;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( ParameterList: TParameterList; F: TField );
  End;

Constructor TFieldExpr.Create( ParameterList: TParameterList;
  F: TField; xQuery: TCustomxQuery; Parser: TExprParser );
Begin
  Inherited Create( ParameterList );
  fField := F;
  fxQuery := xQuery;
  fParser := Parser;
End;

Function TFieldExpr.GetExprType: TExprtype;
Begin
  If Not(fField.Datatype In [ftMemo, ftFmtMemo]) And (fField.Datatype In ftNonTexttypes) Then
    Result := ttInteger
  Else
  Begin
    Case fField.Datatype Of
      ftString, ftMemo, ftFmtMemo(*$IFDEF LEVEL4*), ftFixedChar, ftWideString(*$ENDIF*)
(*$IFDEF LEVEL5*), ftGUID(*$ENDIF*):
        Result := ttString;
      ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, ftLargeInt:
        Result := ttFloat;
      ftAutoInc, ftSmallInt, ftInteger, ftWord:
        Result := ttInteger;
      ftBoolean:
        Result := ttBoolean;
    Else
      result := ttString;
    End;
  End;
End;

Function TFieldExpr.GetMaxString: String;
Begin
  If Not( fField.Datatype In [ftMemo, ftFmtMemo] ) And
        ( fField.DataType In ftNonTextTypes ) Then
  begin
  end else
  Begin
    If ( fField.DataType In [ftString, ftMemo, ftFmtMemo(*$IFDEF LEVEL4*), ftFixedChar,
      ftWideString(*$ENDIF*)
(*$IFDEF LEVEL5*), ftGUID(*$ENDIF*)] ) Then
    Begin
      if fField.DataType In [ftMemo, ftFmtMemo] then
      begin
        Result:= StringOfChar( 'X', 10 );
      end else
      begin
        Result:= StringOfChar( 'X', fField.Size );
      end;
    End;
  End;
End;

Function TFieldExpr.GetAsString: String;
Begin
  Result := '';
  If FxQuery.IsDataSetDisabled( fField.DataSet ) Then Exit;

  If Not( fField.Datatype In [ftMemo, ftFmtMemo] ) And
        ( fField.DataType In ftNonTextTypes ) Then
  begin
  end else
  Begin
    Result := fField.AsString;
  End;
End;

Function TFieldExpr.GetAsFloat: Double;
Begin
  Result := 0;
  If FxQuery.IsDataSetDisabled( fField.DataSet ) Then Exit;
  Result := fField.AsFloat;
End;

Function TFieldExpr.GetAsInteger: Integer;
Begin
  Result := 0;
  If FxQuery.IsDataSetDisabled( fField.DataSet ) Then
    Exit;
  Result := fField.AsInteger;
End;

Function TFieldExpr.GetAsBoolean: Boolean;
Begin
  Result := False;
  If FxQuery.IsDataSetDisabled( fField.DataSet ) Then
    Exit;
  Result := fField.AsBoolean;
End;

//unley

Function TFieldExpr.GetIsNull: boolean;