xqyacc.pas

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

// From Template for TxQuery (c) 2002 Alfonso Moreno



{*****************************************************************************}
{         Parser for TxQuery component                                        }
{         Copyright (c) 2002 by Alfonso Moreno                                }
{*****************************************************************************}

unit xqYacc;

{$I XQ_FLAG.INC}
{$R xqyacc.res}
interface

uses
   SysUtils, Classes, Windows, Dialogs, QLexLib, QYaccLib, xqBase, xquery,
   DB, xqmiscel, CnvStrUtils, xqJoins
{$IFDEF LEVEL3}
   , DBTables
{$ENDIF}
   ;


type
  TxqParser = class( TCustomParser )
  private
    FAnalizer        : TSqlAnalizer;
    FCurrAnalizer    : TSqlAnalizer;    { only a pointer. never created }
    FForLength       : String;
    FEscapeChar      : String;
    FTrimPosition    : Integer;
    FExtractField    : Integer;
    FCastType        : Integer;
    FCastLen         : Integer;
    FIsDistinctAggr  : Boolean;
    FAsAlias         : String;
    FNumInserts      : Integer;   { used in INSERTO INTO...}
    FAggregateList   : TAggregateList;
    FColSubqueryList : TList;     { the list of subqueries for the current select }
    FIsFullPath      : Boolean;
    FTempJoinOnItem  : TJoinOnItem;
    FJoinInWhereTables: TStringList;
    FJoinInWhereFields: TStringList;
    FTableName       : string;
    FFieldName       : string;
    Fwhenlist        : string;
    FIsNotInList     : Boolean;
    FInPredicateList : TStringList;
    { For CREATE TABLE }
    FNumTables, FFieldType, FScale, FPrecision, FSize, FBlobType: Integer;
    FtempTopNInSelect: Integer;
    FtempTopNInGroupBy: Integer;

    procedure SetFieldParams(AFieldType, AScale, APrecision, ASize, ABlobType: Integer);
    procedure SetTableName(const TableName: String);
    procedure SetAlterTableName(const TableName: String);
    procedure AddCreateField(const FieldName: String);
    procedure AddAlterField(const FieldName: String; DropField: Boolean);
    procedure AddPrimaryKeyField(const FieldName: String);
    function CurrentCreateTable: TCreateTableItem;
    function CurrentAlterTable: TCreateTableItem;
    function GetCurrentAnalizer: TSqlAnalizer;
    function CurrentInsertItem : TInsertItem;
    function AddSubqueryInSelect : String;
    procedure CreateNewSubquery;
    function GetRootAnalizer: TSQLAnalizer;
    function GetString(const s: string): string;
    function CreateInListExpression( const Expr : String ): String;
    Procedure SetJoinTestTbls( Const Test1, Test2: string);
  public

    constructor Create(Analizer: TSqlAnalizer);
    destructor Destroy; override;

    function yyparse : integer; override;
    procedure yyerror(const msg : string);

    { specials }
    procedure AddColumn(const AColText : String; IsTransformColumn: Boolean);
    function AddAggregate( pAggregate: TAggregateKind;
                           const pAggregateStr: String ): String;
    procedure AddGroupBy(const ColName: String);
    procedure AddOrderBy(const ColName: String; Descending: Boolean);
    procedure AddTable(const TableName, Alias: String; IsFullPath: Boolean);
    procedure AddJoin();
    procedure AddJoinCandidate(const LeftExpr, RightExpr: String);
    procedure AddHavingColumn( const ColText : String );
    procedure AddUpdateColumn(const ColumnName, ColumnExpr: String);
    procedure AddWhereOptimize(const AFieldName, ARangeStart,
       ARangeEnd : String; ARelOperator : TRelationalOperator);

    property Analizer: TSqlAnalizer read fAnalizer write fAnalizer;
    property AsAlias: String read fAsAlias write fAsAlias;
    property CurrentAnalizer: TSqlAnalizer read GetCurrentAnalizer;
    property TableName: string read fTableName;
    property FieldName: string read fFieldName;
  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 _LSQUARE = 265;
const _RSQUARE = 266;
const _PERIOD = 267;
const _SEMICOLON = 268;
const _COLON = 269;
const RW_OR = 270;
const RW_AND = 271;
const _EQ = 272;
const _NEQ = 273;
const _GT = 274;
const _LT = 275;
const _GE = 276;
const _LE = 277;
const RW_BETWEEN = 278;
const RW_IN = 279;
const RW_LIKE = 280;
const _PLUS = 281;
const _SUB = 282;
const _DIV = 283;
const _MULT = 284;
const RW_MOD = 285;
const RW_IDIV = 286;
const RW_SHL = 287;
const RW_SHR = 288;
const UMINUS = 289;
const _EXP = 290;
const RW_NOT = 291;
const _ILLEGAL = 292;
const _COMMENT = 293;
const _BLANK = 294;
const _TAB = 295;
const _NEWLINE = 296;
const RW_TRUE = 297;
const RW_FALSE = 298;
const RW_SELECT = 299;
const RW_DISTINCT = 300;
const RW_FROM = 301;
const RW_WHERE = 302;
const RW_ORDER = 303;
const RW_BY = 304;
const RW_ASC = 305;
const RW_DESC = 306;
const RW_AS = 307;
const RW_INNER = 308;
const RW_OUTER = 309;
const RW_FULL = 310;
const RW_JOIN = 311;
const RW_ON = 312;
const RW_GROUP = 313;
const RW_HAVING = 314;
const RW_ANY = 315;
const RW_ALL = 316;
const RW_SUM = 317;
const RW_AVG = 318;
const RW_COUNT = 319;
const RW_MIN = 320;
const RW_MAX = 321;
const RW_STDEV = 322;
const RW_LEFT = 323;
const RW_RIGHT = 324;
const RW_LEADING = 325;
const RW_TRAILING = 326;
const RW_BOTH = 327;
const RW_TRIM = 328;
const RW_EXTRACT = 329;
const RW_YEAR = 330;
const RW_MONTH = 331;
const RW_DAY = 332;
const RW_HOUR = 333;
const RW_MINUTE = 334;
const RW_SECOND = 335;
const RW_FOR = 336;
const RW_SUBSTRING = 337;
const RW_DELETE = 338;
const RW_UPDATE = 339;
const RW_INSERT = 340;
const RW_INTO = 341;
const RW_VALUES = 342;
const RW_SET = 343;
const RW_CAST = 344;
const RW_CHAR = 345;
const RW_INTEGER = 346;
const RW_BOOLEAN = 347;
const RW_DATE = 348;
const RW_TIME = 349;
const RW_DATETIME = 350;
const RW_FLOAT = 351;
const RW_ESCAPE = 352;
const RW_CREATE = 353;
const RW_TABLE = 354;
const RW_SMALLINT = 355;
const RW_MONEY = 356;
const RW_AUTOINC = 357;
const RW_PRIMARY = 358;
const RW_KEY = 359;
const RW_BLOB = 360;
const RW_INDEX = 361;
const RW_UNIQUE = 362;
const RW_DROP = 363;
const RW_TRANSFORM = 364;
const RW_PIVOT = 365;
const RW_UNION = 366;
const RW_WITH = 367;
const RW_IS = 368;
const RW_NULL = 369;
const RW_ALTER = 370;
const RW_COLUMN = 371;
const RW_ADD = 372;
const RW_APPEND = 373;
const RW_CASE = 374;
const RW_WHEN = 375;
const RW_THEN = 376;
const RW_ELSE = 377;
const RW_END = 378;
const RW_PACK = 379;
const RW_ZAP = 380;
const RW_REINDEX = 381;
const RW_RANGE = 382;
const RW_USING = 383;
const RW_FIELDS = 384;
const RW_TO = 385;
const RW_TOP = 386;

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

// global definitions:

var yylval : YYSType;

implementation

uses
   xqLex, xqConsts;

(*----------------------------------------------------------------------------*)
procedure TxqParser.yyerror(const msg : string);
begin
   yyerrorMsg := msg;
   { yyerrorMsg := IntToStr(yyLexer.yylineno) +  ': ' + msg + ' at or before '+ yyLexer.yytext + '. ' +
   Format('Line %d, Column %d',[yyLexer.yylineno,yyLexer.yycolno]);
   if Analizer.xQuery.ShowErrorMessage then
      ShowMessage( yyerrorMsg ); }
end;

constructor TxqParser.Create(Analizer: TSqlAnalizer);
begin
   inherited Create;
   fAnalizer:= Analizer;
   fInPredicateList := TStringList.Create;
   fTempJoinOnItem:= TJoinOnItem.Create(nil);
   fJoinInWhereTables:= TStringList.create;
   fJoinInWhereFields:= TStringList.create;
end;

destructor TxqParser.Destroy;
begin
   if Assigned(fAggregateList) then
      fAggregateList.Free;
   if Assigned(fTempJoinOnItem) then
     FreeObject(fTempJoinOnItem);
   fJoinInWhereTables.Free;
   fJoinInWhereFields.Free;
   fInPredicateList.Free;
   inherited Destroy;
end;

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

procedure TxqParser.CreateNewSubquery;
var
  TmpAnalizer : TSqlAnalizer;
begin
  TmpAnalizer := GetCurrentAnalizer;
  fCurrAnalizer := TSqlAnalizer.Create( TmpAnalizer, fAnalizer.xQuery );
  TmpAnalizer.SubqueryList.Add( fCurrAnalizer );
end;

function TxqParser.GetRootAnalizer: TSQLAnalizer;
begin
  Result := GetCurrentAnalizer;
  while Result.ParentAnalizer <> nil do Result := Result.ParentAnalizer;
end;

function TxqParser.GetCurrentAnalizer: TSqlAnalizer;
begin
   if fCurrAnalizer= nil then fCurrAnalizer := Self.fAnalizer;
   Result := fCurrAnalizer;
end;

procedure TxqParser.AddColumn(const AColText : String; IsTransformColumn: Boolean);
var
  Column : TColumnItem;
  TmpAnalizer: TSqlAnalizer;

  function StripFields(const s: String): String;
  var
     p, i, j: Integer;
     Found: Boolean;
  begin
     Result:= s;
     p:= Pos('\f"', Result);
     while p > 0 do
     begin
       j:= p + 3;
       i:= j;
       Found:= True;
       while j <= Length(Result) do
       begin
         if Result[j] = '"' then
         begin
            Found:= True;
            Break;
         end;
         Inc(j);
       end;
       if Not Found then Exit;    { fatal error }
       if j <= Length(Result) then
         Result:= Copy(Result, 1, p - 1) + Copy(Result, i, j - i) +
           Copy(Result, j + 1, Length(Result));

       p:= Pos('\f"', Result);
     end;
  end;

begin
  if IsTransformColumn then
     Column := CurrentAnalizer.TransformColumnList.Add
  else
     Column := CurrentAnalizer.ColumnList.Add;
  with Column do
  begin
     ColumnExpr:= AColText;
     { this mean that aggregate columns are embedded in ColumnExpr}
     if Assigned(Self.fAggregateList) then
     begin
       Column.AggregateList.Free;    { free previous aggregate list}
       Column.AggregateList := Self.fAggregateList; { assign the current list}
       Self.fAggregateList:= nil;    { define as nil the current }
     end;
     if Assigned(Self.fColSubqueryList) then
     begin
       TmpAnalizer := GetRootAnalizer;
       if TmpAnalizer = CurrentAnalizer then begin
          Column.SubqueryList.Free;
          Column.SubqueryList := Self.fColSubqueryList;
          Self.fColSubqueryList:= nil;
          if Length(Self.fAsAlias)= 0 then
             Self.fAsAlias := 'Subquery';
       end;
     end;
     CastType  := Self.fCastType;
     CastLen   := IMax(1, Self.fCastLen);      // only used for strings
     if Length(self.fAsAlias) > 0 then
     begin
       AsAlias:= self.fAsAlias;
       IsAsExplicit:= True;
     end else
     begin
       IsAsExplicit := False;
       AsAlias := StripFields(AColText);
       if AggregateList.Count > 0  then
         case AggregateList[0].Aggregate of
            akSUM: AsAlias := SAggrSUM + StripFields(AggregateList[0].AggregateStr);
            akAVG: AsAlias := SAggrAVG + StripFields(AggregateList[0].AggregateStr);
            akSTDEV: AsAlias := SAggrSTDEV + StripFields(AggregateList[0].AggregateStr);
            akMIN: AsAlias := SAggrMIN + StripFields(AggregateList[0].AggregateStr);
            akMAX: AsAlias := SAggrMAX + StripFields(AggregateList[0].AggregateStr);
            akCOUNT: AsAlias := SAggrCOUNT;
         end;
     end;
  end;

  fAsAlias  := '';
  fCastType := 0;
  fCastLen  := 0;
end;

{ This function will return an aggregate encoded with something like :
  (Aggregate 1) }
function TxqParser.AddAggregate( pAggregate: TAggregateKind;
  const pAggregateStr: String ) : String;
begin
  if fAggregateList = nil then
     fAggregateList := TAggregateList.Create;
  with fAggregateList.Add do
  begin
     AggregateStr := pAggregateStr;
     Aggregate    := pAggregate;
     IsDistinctAg := Self.fIsDistinctAggr;
  end;
  Result := Format('{Aggregate %d}', [fAggregateList.Count - 1]);

  Self.fIsDistinctAggr := False;
end;

{ This function will return a subquery encoded with something like :
  (Subquery 1) }
function TxqParser.AddSubqueryInSelect : String;
var
  MainAnalizer, Analizer: TSqlAnalizer;
begin
  if fColSubqueryList = nil then
     fColSubqueryList := TList.Create;
  { Now add the subquery.
    Important: No nested subqueries are allowed in this release. Example
    SELECT custno, (SELECT custno FROM customer WHERE
      custno >= ALL(SELECT custno FROM customer WHERE custno BETWEEN 1000 AND 2000)) FROM customer; )
    But this is allowed:
     SELECT custno, (SELECT SUM(amountpaid) FROM customer WHERE custno BETWEEN 1000 AND 2000) /
        (SELECT Count(*) FROM customer WHERE custno BETWEEN 2000 AND 3000) FROM customer;
  }
  { do to the following trick, nested subqueries in the SELECT columns are not allowed }
  MainAnalizer := GetRootAnalizer;
  Analizer := TSqlAnalizer( MainAnalizer.SubqueryList[0] );
  MainAnalizer.SubQueryList.Clear;
  fColSubqueryList.Add( Analizer );
  Result := Format( '{Subquery %d}',[fColSubqueryList.Count - 1] );
end;

procedure TxqParser.AddGroupBy(const ColName: String);
var
  GroupBy: TOrderByItem;
  Index, Code: integer;
begin
  Val(ColName, Index, Code);
  GroupBy := CurrentAnalizer.GroupByList.Add;
  if Code = 0 then
  begin
     GroupBy.Alias := '';
     GroupBy.ColIndex := Index - 1;
  end else
  begin
     GroupBy.Alias := ColName;
     GroupBy.ColIndex:= -1;   { means: not defined by number }
  end;
end;

procedure TxqParser.AddOrderBy(const ColName: String; Descending: Boolean);
var
  OrderBy     : TOrderByItem;
  Index, Code : integer;
begin
  Val(ColName, Index, Code);
  OrderBy:= CurrentAnalizer.OrderByList.Add;
  if Code = 0 then
  begin
     OrderBy.Alias := '';
     OrderBy.ColIndex := Index - 1;
  end else
  begin
     OrderBy.Alias := ColName;
     { means: not defined by number and must be solved in checkintegrity }
     OrderBy.ColIndex:= -1;
  end;
  OrderBy.Desc:= Descending;
end;

Procedure TxqParser.AddTable(const TableName, Alias: String; IsFullPath: Boolean);
var
   Table: TTableItem;
   s: String;
begin
   Table:= CurrentAnalizer.TableList.Add;
   if IsFullPath then
   begin
      s := Copy(TableName,2,Length(TableName)-2);
      Table.TableName := s;
   end else
      Table.TableName := TableName;
   Table.IsFullPath := IsFullPath;
   if Length(Alias) > 0 then
      Table.Alias := Alias
   else
   begin
      if IsFullPath then
         Table.Alias := ChangeFileExt(ExtractFileName(s),'')
      else
         Table.Alias := TableName;
   end;
end;

Procedure TxqParser.SetJoinTestTbls( Const Test1, Test2: string );
Begin
  If Length( fTempJoinOnItem.LeftRefTest ) > 0 Then Exit;
  fTempJoinOnItem.LeftRefTest:= Test1;
  fTempJoinOnItem.RightRefTest:= Test2;
End;

Procedure TxqParser.AddJoin();
Begin
   With CurrentAnalizer.JoinList.Add Do
     Assign( FTempJoinOnItem );
   { initializes the item used }
   With fTempJoinOnItem Do
   Begin
     JoinAction:= jkLeftInnerJoin;
     JoinExpression:= '';
     FTempJoinOnItem.LeftRefTest:= '';
     FTempJoinOnItem.RightRefTest:= '';