xqyacc.y

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

/* Grammar for TxQuery dataset (Delphi 3,4,5,6), (c) 2002 Alfonso Moreno
   NOTES :
   DON'T FORGET TO MOVE THE GENERATED CONSTANTS TO THE PLACE INDICATED
*/

%{

{*****************************************************************************}
{         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;

//
// The generated constants must be placed here
// HERE !!!!
//

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:= '';
     // gis product
     FTempJoinOnItem.GraphicJoin := False;
   End;
End;

procedure TxqParser.AddJoinCandidate(const LeftExpr, RightExpr: String);
begin
  CurrentAnalizer.LJoinCandidateList.Add( LeftExpr );
  CurrentAnalizer.RJoinCandidateList.Add( RightExpr );
end;

procedure TxqParser.AddHavingColumn( const ColText : String );
var
   Column: TColumnItem;
begin
   Column := CurrentAnalizer.ColumnList.Add;