unit XData.Aurelius.ConnectionPool;

{$I XData.inc}

interface

uses
  System.SysUtils,
  Generics.Collections,
  Aurelius.Drivers.Base,
  Aurelius.Drivers.Interfaces,
  Sparkle.Sys.ObjectPool;

type
  TDBConnectionWrapper = class(TInterfaceWrapper<IDBConnection>, IDBConnection,
    IDBConnectionAdapter, IDBBatchConnection)
  strict protected
    procedure Connect;
    procedure Disconnect;
    function IsConnected: Boolean;
    function CreateStatement: IDBStatement;
    function BeginTransaction: IDBTransaction;
    function SqlDialect: string;
  strict protected
    { IDBBatchConnection }
    function CanExecuteBatch: Boolean;
    function ExecuteBatch(const SQL: string; Params: TEnumerable<TDBParam>;
      BatchSize: Integer): Integer;
  strict protected
    function AdaptedConnection: TObject;
  end;

  TDBConnectionPool = class(TInterfacedObject, IDBConnectionPool)
  strict private
    {$IFDEF DELPHIXE4_LVL}
    FPool: TObjectPool<TDBConnectionWrapper>;
    {$ELSE}
    FPool: TCustomObjectPool; // workaround XE compiler bug
    {$ENDIF}
    FFactory: IDBConnectionFactory;
  protected
    {$IFDEF DELPHIXE4_LVL}
    property Pool: TObjectPool<TDBConnectionWrapper> read FPool;
    {$ELSE}
    property Pool: TCustomObjectPool read FPool;
    {$ENDIF}
  public
    constructor Create(const APoolSize: integer; ACreateItem: TPoolCreateItem<IDBConnection>); overload;
    constructor Create(const APoolSize: integer; AFactory: IDBConnectionFactory); overload;
    destructor Destroy; override;
    function GetConnection: IDBConnection;
    procedure CleanUp(InactivityTimeout: Integer);
  end;

implementation

{ TDBConnectionPool }

constructor TDBConnectionPool.Create(const APoolSize: integer;
  ACreateItem: TPoolCreateItem<IDBConnection>);
var
  SelfPtr: Pointer;
begin
  SelfPtr := Self;
  FPool := TObjectPool<TDBConnectionWrapper>.Create(APoolSize,
    TPoolItemAnonymousFactory<TDBConnectionWrapper>.Create(
    function: TDBConnectionWRapper
    var
      LocalSelf: TDBConnectionPool;
    begin
      LocalSelf := TDBConnectionPool(SelfPtr);
      Result := TDBConnectionWrapper.Create(ACreateItem, LocalSelf.FPool);
    end)
  );
end;

procedure TDBConnectionPool.CleanUp(InactivityTimeout: Integer);
begin
  FPool.CleanUp(InactivityTimeout);
end;

constructor TDBConnectionPool.Create(const APoolSize: integer;
  AFactory: IDBConnectionFactory);
var
  SelfPtr: Pointer;
begin
  SelfPtr := Self;
  FFactory := AFactory;
  FPool := TObjectPool<TDBConnectionWrapper>.Create(APoolSize,
    TPoolItemAnonymousFactory<TDBConnectionWrapper>.Create(
    function: TDBConnectionWRapper
    var
      LocalSelf: TDBConnectionPool;
    begin
      LocalSelf := TDBConnectionPool(SelfPtr);
      Result := TDBConnectionWrapper.Create(FFactory.CreateConnection, LocalSelf.FPool);
    end)
  );
end;

destructor TDBConnectionPool.Destroy;
begin
  FPool.Free;
  inherited;
end;

function TDBConnectionPool.GetConnection: IDBConnection;
begin
  {$IFDEF DELPHIXE4_LVL}
  Result := FPool.Acquire;
  {$ELSE}
  Result := TDBConnectionWrapper(FPool.AcquireObject);
  {$ENDIF}
end;

{ TDBConnectionPoolWrapper }

function TDBConnectionWrapper.AdaptedConnection: TObject;
var
  Adapter: IDBConnectionAdapter;
begin
  if Intf.QueryInterface(IDBConnectionAdapter, Adapter) = S_OK then
    Result := Adapter.AdaptedConnection
  else
    Result := nil;
end;

function TDBConnectionWrapper.BeginTransaction: IDBTransaction;
begin
  Result := Intf.BeginTransaction;
end;

function TDBConnectionWrapper.CanExecuteBatch: Boolean;
var
  BatchConnection: IDBBatchConnection;
begin
  Result := Supports(Intf, IDBBatchConnection, BatchConnection)
    and BatchConnection.CanExecuteBatch;
end;

procedure TDBConnectionWrapper.Connect;
begin
  Intf.Connect;
end;

function TDBConnectionWrapper.CreateStatement: IDBStatement;
begin
  Result := Intf.CreateStatement;
end;

procedure TDBConnectionWrapper.Disconnect;
begin
  Intf.Disconnect;
end;

function TDBConnectionWrapper.ExecuteBatch(const SQL: string;
  Params: TEnumerable<TDBParam>; BatchSize: Integer): Integer;
var
  BatchConnection: IDBBatchConnection;
begin
  Assert(Supports(Intf, IDBBatchConnection, BatchConnection));
  Result := BatchConnection.ExecuteBatch(SQL, Params, BatchSize);
end;

function TDBConnectionWrapper.IsConnected: Boolean;
begin
  Result := Intf.IsConnected;
end;

function TDBConnectionWrapper.SqlDialect: string;
begin
  Result := Intf.SqlDialect;
end;

end.
