unit XData.Comp.ConnectionPool;

interface

uses
  System.Classes, System.SysUtils,
  Aurelius.Comp.Connection,
  Aurelius.Drivers.Interfaces;

type
  IDBConnectionPool = Aurelius.Drivers.Interfaces.IDBConnectionPool;

  TXDataCustomConnectionPool = class(TComponent)
  public
    function GetPoolInterface: IDBConnectionPool; virtual; abstract;
  end;

  TPoolInterfaceEvent = procedure(Sender: TObject; var Pool: IDBConnectionPool) of object;

  TXDataConnectionPool = class(TXDataCustomConnectionPool)
  private
    FConnection: TAureliusConnection;
    FSize: Integer;
    FPoolIntf: IDBConnectionPool;
    FOnPoolInterfaceCreate: TPoolInterfaceEvent;
    procedure SetConnection(const Value: TAureliusConnection);
    procedure SetSize(const Value: Integer);
    procedure CheckConnection;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    function GetPoolInterface: IDBConnectionPool; override;
  published
    property Connection: TAureliusConnection read FConnection write SetConnection;
    property Size: Integer read FSize write SetSize default 20;
    property OnPoolInterfaceCreate: TPoolInterfaceEvent read FOnPoolInterfaceCreate write FOnPoolInterfaceCreate;
  end;

  EXDataConnectionPoolException = class(Exception)
  end;

implementation

uses
  XData.Aurelius.ConnectionPool;

{ TXDataConnectionPool }

procedure TXDataConnectionPool.CheckConnection;
begin
  if not Assigned(Connection) then
    raise EXDataConnectionPoolException.Create('Connection not specified');
end;

constructor TXDataConnectionPool.Create(AOwner: TComponent);
begin
  inherited;
  FSize := 20;
end;

function TXDataConnectionPool.GetPoolInterface: IDBConnectionPool;
var
  Factory: IDBConnectionFactory;
begin
  if FPoolIntf = nil then
  begin
    CheckConnection;
    Factory := Connection.CreateConnectionFactory;
    FPoolIntf := TDBConnectionPool.Create(Self.Size, Factory);
    if Assigned(OnPoolInterfaceCreate) then
      FOnPoolInterfaceCreate(Self, FPoolIntf);
  end;
  Result := FPoolIntf;
end;

procedure TXDataConnectionPool.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FConnection) and (Operation = opRemove) then
    FConnection := nil;
end;

procedure TXDataConnectionPool.SetConnection(const Value: TAureliusConnection);
begin
  if FConnection = Value then Exit;

  if Assigned(FConnection) then
    FConnection.RemoveFreeNotification(Self);
  FConnection := Value;
  if Assigned(FConnection) then
    FConnection.FreeNotification(Self);
end;

procedure TXDataConnectionPool.SetSize(const Value: Integer);
begin
  if FSize = Value then Exit;
  if Value > 0 then
    FSize := Value
  else
    FSize := 1;
end;

end.
