unit MultiDBConnectionPool;

interface

uses
  Generics.Collections, SyncObjs, SysUtils,
  Aurelius.Drivers.Interfaces;


const
  DefaultDBHeaderName = 'database-name';

type
  IMultiDBConnectionPool = interface(IDBConnectionPool)
  ['{FB53FB08-0404-427F-AD8D-A690CBAD69CA}']
    procedure AddOrSetPool(const PoolName: string; Pool: IDBConnectionPool);
    procedure RemovePool(const PoolName: string);
  end;

  TMultiDBConnectionPool = class(TInterfacedObject, IDBConnectionPool, IMultiDBConnectionPool)
  strict private
    FSection: TCriticalSection;
    FPools: TDictionary<string, IDBConnectionPool>;
    FHeaderName: string;
  public
    constructor Create; overload;
    constructor Create(const DBHeaderName: string); overload;
    destructor Destroy; override;
    procedure AddOrSetPool(const PoolName: string; Pool: IDBConnectionPool);
    procedure RemovePool(const PoolName: string);
  public
    function GetConnection: IDBConnection;
  end;

implementation

uses
  XData.Server.Module;

{ TMultiDBConnectionPool }

procedure TMultiDBConnectionPool.AddOrSetPool(const PoolName: string;
  Pool: IDBConnectionPool);
begin
  FSection.Enter;
  try
    FPools.AddOrSetValue(PoolName, Pool);
  finally
    FSection.Leave;
  end;
end;

constructor TMultiDBConnectionPool.Create;
begin
  Create(DefaultDBHeaderName);
end;

constructor TMultiDBConnectionPool.Create(const DBHeaderName: string);
begin
  FSection := TCriticalSection.Create;
  FPools := TDictionary<string, IDBConnectionPool>.Create;
  FHeaderName := DBHeaderName;
end;

destructor TMultiDBConnectionPool.Destroy;
begin
  FPools.Free;
  FSection.Free;
  inherited;
end;

function TMultiDBConnectionPool.GetConnection: IDBConnection;
var
  PoolName: string;
  Pool: IDBConnectionPool;
begin
  if (TXDataOperationContext.Current = nil) then
    raise Exception.Create('Could not retrieve XData context.');

  PoolName := TXDataOperationContext.Current.Request.Headers.Get(FHeaderName);
  FSection.Enter;
  try
    if not FPools.TryGetValue(PoolName, Pool) then
      Pool := nil;
  finally
    FSection.Leave;
  end;

  if Pool = nil then
    raise Exception.CreateFmt('Could not retrieve database pool "%s"', [PoolName]);

  Result := Pool.GetConnection;
end;

procedure TMultiDBConnectionPool.RemovePool(const PoolName: string);
begin
  FSection.Enter;
  try
    FPools.Remove(PoolName);
  finally
    FSection.Leave;
  end;
end;

end.
