xqjoins.pas

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

unit xqJoins;

{$I XQ_FLAG.INC}
interface

Uses
  SysUtils, Classes, Db, XQMiscel, xqbase, qexpryacc, qbaseexpr ;

Type

  TJoinAction = ( jkLeftInnerJoin,   
                  jkRightInnerJoin,  
                  jkLeftOuterJoin,   
                  jkRightOuterJoin,  
                  jkFullOuterJoin ); 

  TJOINOnList = Class;

  TJOINOnItem = Class
  Private
    FJOINOnList: TJOINOnList;   { belongs to }
    FJOINAction: TJOINAction;   { left inner JOIN, left outer JOIN, etc. }
    FJOINExpression: String;
    FLeftRefTest: string;
    FRightRefTest: string;
    FSortList: TxqSortList;
    { the expression resolver for the full JOIN expression }
    FResolver: TExprParser;
    { field used to obtain the value on the right Dataset in order to sort
      the FSortList }
    FField: TField;
    FLeftField: TField;
    // gis product
    FGraphicJoin : Boolean;
  Public
    Constructor Create( JOINOnList: TJOINOnList );
    Destructor Destroy; Override;
    Procedure Assign( Source: TJOINOnItem );

    Property JOINAction: TJOINAction Read FJOINAction Write FJOINAction;
    Property JOINExpression: String Read FJOINExpression Write FJOINExpression;
    Property Resolver: TExprParser Read FResolver Write FResolver;
    Property SortList: TxqSortList read FSortList;
    Property LeftRefTest: string read FLeftRefTest write FLeftRefTest;
    Property RightRefTest: string read FRightRefTest write FRightRefTest;
    // gis product
    Property GraphicJoin: Boolean read FGraphicJoin write FGraphicJoin;
  End;

  TJOINOnList = Class
  Private
    FAnalizer: TObject;
    FItems: TList;
    Function GetCount: Integer;
    Function GetItem( Index: Integer ): TJOINOnItem;
  Public
    Constructor Create( Analizer: TObject );  // TObject in order to avoid redundancy with xquery.pas unit
    Destructor Destroy; Override;
    Function Add: TJOINOnItem;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Procedure PrepareJOIN;
    procedure DoJOINOn;

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

implementation

uses
  xquery, xqconsts;

{-------------------------------------------------------------------------------}
{                  Implement TJOINOnItem                                        }
{-------------------------------------------------------------------------------}

Constructor TJOINOnItem.Create( JOINOnList: TJOINOnList );
Begin
  Inherited Create;
  fJOINOnList := JOINOnList;
  FSortList := TMemSortList.Create( True );
End;

Destructor TJOINOnItem.Destroy;
Begin
  If Assigned( FResolver ) Then FResolver.Free;
  FSortList.Free;
  Inherited Destroy;
End;

Procedure TJOINOnItem.Assign( Source: TJOINOnItem );
Begin
  FJOINAction     := Source.FJOINAction;
  FJOINExpression := Source.FJOINExpression;
  FLeftRefTest   := Source.FLeftRefTest;
  FRightRefTest  := Source.FRightRefTest;
End;

{-------------------------------------------------------------------------------}
{                  Implement TJOINOnList                                        }
{-------------------------------------------------------------------------------}

Constructor TJOINOnList.Create( Analizer: TObject );
Begin
  Inherited Create;
  FAnalizer:= Analizer;
  FItems := TList.Create;
End;

Destructor TJOINOnList.Destroy;
Begin
  Clear;
  FItems.Free;
  Inherited Destroy;
End;

Function TJOINOnList.GetCount;
Begin
  Result := FItems.Count;
End;

Function TJOINOnList.GetItem( Index: Integer ): TJOINOnItem;
Begin
  Result := FItems[Index];
End;

Function TJOINOnList.Add: TJOINOnItem;
Begin
  Result := TJOINOnItem.Create( Self );
  FItems.Add( Result );
End;

Procedure TJOINOnList.Clear;
Var
  I: Integer;
Begin
  For I := 0 To FItems.Count - 1 Do
    TJOINOnItem( FItems[I] ).Free;
  FItems.Clear;
End;

Procedure TJOINOnList.Delete( Index: Integer );
Begin
  TJOINOnItem( FItems[Index] ).Free;
  FItems.Delete( Index );
End;

procedure TJOINOnList.DoJOINOn;

  Procedure OuterDisableDatasets( Start: Integer );
  Var
    D: TDataset;
    I: Integer;
  Begin
    With TSqlAnalizer( FAnalizer ) Do
    Begin
      For I := Start To TableList.Count - 1 Do
      Begin
        D := TableList[I].Dataset;
        If xQuery.DisabledDatasets.IndexOf( D ) < 0 Then
          xQuery.DisabledDatasets.Add( D );
      End;
    End;
  End;

  Procedure RecursiveJOIN( Start: Integer; Var TotalRecsAdded: Integer );
  Var
    RecsAdded: Integer;
    JOI: TJOINOnItem;
    RightDataset: TDataset;
    HasMoreJOINs: Boolean;
    MustRemove: Boolean;
    ThisCount: Integer;
  Begin
    RecsAdded := 0;

    With TSqlAnalizer( FAnalizer ) Do
    Begin
      JOI := JOINList[Start];

      HasMoreJOINs:= Start < JoinList.Count -1 ;

      If JOI.JOINAction = jkLeftInnerJOIN Then
      Begin
        If Not JOI.FLeftField.IsNull Then
        Begin
          { filter the right Dataset with the value of the related left field }
          JOI.FSortList.Filter( JOI.FLeftField.Value );

          RightDataset := TableList[ Start + 1 ].Dataset;

          // search for records meeting the criteria
          JOI.FSortList.First;
          While Not JOI.FSortList.Eof do
          Begin
            RightDataset.GotoBookmark( TBookmark( JOI.FSortList.SourceRecno ) );

            If JOI.Resolver.Expression.AsBoolean Then
            Begin
              If HasMoreJOINs Then
              Begin
                { call recursively }
                RecursiveJOIN( Start + 1, RecsAdded )
              End
              Else
              Begin
                { falta aqui agregar los disabled Datasets  }
                AddThisRecord( DefDataset );
                Inc( RecsAdded );
              End;
            End;

            JOI.FSortList.Next;
          End;
        End;
      End Else if JOI.JOINAction = jkLeftOuterJOIN Then
      Begin
        { con esto se cubre el caso en que el campo es nulo }
        ThisCount:= 0;
        RightDataset := TableList[ Start + 1 ].Dataset;
        If JOI.FLeftField.IsNull Then
        Begin
          { disable all right Datasets }
          if HasMoreJoins then
          begin
            MustRemove:= false;
            If xQuery.DisabledDatasets.IndexOf( RightDataset ) < 0 Then
            begin
              xQuery.DisabledDatasets.Add( RightDataset );
              MustRemove:= true;
            end;
            RecursiveJOIN( Start + 1, ThisCount );
            If MustRemove then
              xQuery.DisabledDatasets.Remove( RightDataset );
          end;
        End Else
        Begin
          JOI.FSortList.Filter( JOI.FLeftField.Value );
          JOI.FSortList.First;
          While Not JOI.FSortList.Eof do
          Begin
            RightDataset.GotoBookmark( TBookmark( JOI.FSortList.SourceRecno ) );
            If JOI.Resolver.Expression.AsBoolean Then
            Begin
              If HasMoreJOINs Then
              Begin
                { call recursively }
                RecursiveJOIN( Start + 1, ThisCount )
              End
              Else
              Begin
                AddThisRecord( DefDataset );
                Inc( ThisCount );
              End;
            End;
            JOI.FSortList.Next;
          End;

          MustRemove:= False;
          If ThisCount = 0 Then
          Begin
            { disable this Dataset because it has no meeting records }
            If xQuery.DisabledDatasets.IndexOf( RightDataset ) < 0 Then
            begin
              xQuery.DisabledDatasets.Add( RightDataset );
              MustRemove:= True;
            end;
          End;

          If ( ThisCount = 0 ) And HasMoreJOINs Then
          Begin
            RecursiveJOIN( Start + 1, ThisCount );
          End;

          If MustRemove Then
          Begin
            xQuery.DisabledDatasets.Remove( RightDataset );
          End;

        End;

        Inc( RecsAdded, ThisCount );

        If RecsAdded = 0 Then
        Begin
          OuterDisableDatasets( Start + 1 );
          AddThisRecord( DefDataset );
          Inc( RecsAdded );
        End;

      End;

      Inc( TotalRecsAdded, RecsAdded );

    End;

  End;

Var
  I, nRecs: Integer;
Begin
  { recursively JOINing }

  //ADCON
  TSqlAnalizer(FAnalizer).xQuery.DisabledDatasets.Clear;

  nRecs := 0;

  RecursiveJOIN( 0, nRecs );

  with TSqlAnalizer(FAnalizer) do
  begin

    If WhereContainsOnlyBasicFields Or ( nRecs = 0 ) Or
      ( SubQueryList.Count > 0 ) Or ( Length( WhereStr ) = 0 ) Then Exit;

    { delete the records not meeting WHERE expression }
    For I := ResultSet.RecordCount Downto ( ResultSet.RecordCount - nRecs + 1 ) Do
    Begin
      ResultSet.Recno := I;
      If Not MainWhereResolver.Expression.AsBoolean Then
      Begin
        ResultSet.Delete;
      End ;
    End;
  end;
end;

procedure TJOINOnList.PrepareJOIN;
Var
  I, J, Index : Integer ;
  ThisRef, LeftRef, fname, tname, aname , lrt, rrt: string ;
  DSet : TDataset ;
  FieldExprType : TExprType ;
begin
  with TSqlAnalizer( FAnalizer ) do
  begin
    For I := 0 To FItems.Count - 1 Do
    Begin
      With TJOINOnItem( FItems[I] ) Do
      Begin
        lrt := UpperCase( FLeftRefTest );
        rrt := UpperCase( FRightRefTest );
        Index:= AnsiPos( '.', lrt );
        if Index = 0 then
          { if table not defined, then use the default}
          lrt := AddSquareBrackets( TableList[0].TableName ) + '.' + lrt;
        Index:= AnsiPos( '.', rrt);
        if Index = 0 then
          { if table not defined, then use the default}
          rrt := AddSquareBrackets( TableList[0].TableName ) + '.' + rrt;

        { In this version, only the AND operator is allowed in a JOIN, example
          SELECT * FROM customer INNER JOIN orderItems ON
            ( Customer.ItemID = OrderItems.ItemID ) AND
            ( Customer.CusID = OrderItems.CustomerID )

          The following JOIN is not allowed or will give unexpected results
          SELECT * FROM customer INNER JOIN orderItems ON
            ( Customer.ItemID = OrderItems.ItemID ) OR
            ( Customer.CusID = OrderItems.CustomerID ) }

        { Detect which one of the two is }
        tname := UpperCase( TableList[ I + 1 ].TableName );
        aname := UpperCase( TableList[ I + 1 ].Alias );

        If ( AnsiPos( TrimSquareBrackets( tname), TrimSquareBrackets( lrt ) ) = 1 ) Or
           ( AnsiPos( TrimSquareBrackets( aname), TrimSquareBrackets( lrt ) ) = 1 ) Then
        Begin
          ThisRef := lrt  ;
          LeftRef := rrt ;
        End Else If ( AnsiPos( TrimSquareBrackets( tname ), TrimSquareBrackets( rrt ) ) = 1 ) Or
                    ( AnsiPos( TrimSquareBrackets( aname ), TrimSquareBrackets( rrt ) ) = 1 ) Then
        Begin
          ThisRef := rrt ;
          LeftRef := lrt ;
        End Else
          Raise ExQueryError.Create( SJOINInvalidFieldName );

        DSet := TableList[ I + 1 ].Dataset;

        Resolver := TExprParser.Create( FAnalizer, DefDataset );
        Try
          FResolver.ParseExpression( JOINExpression );
          { now define the sort list for the first field on the referenced
            fields of the right table }
          Index:= AnsiPos( '.', ThisRef);
          fname := TrimSquareBrackets( Copy( ThisRef, Index + 1, Length( ThisRef ) ) );
          { ahora ordena por esta tabla. Nota: necesito guardar los bookmarks
            de la tabla para rapidamente localizar el registro correspondiente
            ya que se efectuara un ordenamiento por esa tabla
            The sort list will save the bookmark instead of the recno of the Dataset
            }
          { detect the field type in the sort list }
          FField:= DSet.FindField( fname );
          if FField = Nil then
            Raise ExQueryError.Create( SJOINInvalidFieldName );
          SortList.BookmarkedDataset := DSet;
          FieldExprType:= XQMiscel.Field2Exprtype( FField.Datatype );
          SortList.AddField( FieldExprType, FField.Size, False );
          { now add all the records and sort }
          DSet.First;
          While Not DSet.Eof do
          Begin
            SortList.Insert;
            SortList.SourceRecno := Longint( DSet.GetBookmark );
            Case FieldExprType Of
              ttString : SortList.Fields[0].AsString  := FField.AsString;
              ttFloat  : SortList.Fields[0].AsFloat   := FField.AsFloat;
              ttInteger: SortList.Fields[0].AsInteger := FField.AsInteger;
              ttBoolean: SortList.Fields[0].AsBoolean := FField.AsBoolean;
            End;
            DSet.Next;
          End;
          { sort the records }
          SortList.Sort;
        Except
          FreeObject( FResolver );
          Raise;
        End;
        { ahora busca la tabla izquierda que se relaciona con este JOIN }
        FLeftField := Nil;
        Index:= AnsiPos( '.', LeftRef);
        fname := TrimSquareBrackets( Copy( LeftRef, Index + 1, Length( LeftRef ) ) );
        for J:= 0 to I do
        begin
          tname := UpperCase( TableList[ J ].TableName );
          aname := UpperCase( TableList[ J ].Alias );
          If ( AnsiPos( TrimSquareBrackets( tname ), TrimSquareBrackets( LeftRef ) ) = 1 ) Or
             ( AnsiPos( TrimSquareBrackets( aname ), TrimSquareBrackets( LeftRef ) ) = 1 ) Then
          begin
            FLeftField := TableList[ J ].Dataset.FindField( fname );
            if Assigned( FLeftField ) then Break;
          end;
        end;
        if FLeftField = Nil then
          Raise ExQueryError.Create( SJOINInvalidFieldName );
      End;
    End;
  End;
end;

end.