//////////////////////////////////////////////////
//  NexusDB Data Access Components
//  Copyright © 2009-2013 Devart. All right reserved.
//////////////////////////////////////////////////

{$IFNDEF CLR}

{$I NexusDac.inc}
unit NexusConnectionPoolUni;
{$ENDIF}

interface

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils, Classes, SyncObjs, Variants,
  CRTypes, MemData, CRAccess, CRConnectionPool, DASQLMonitor,
{$IFNDEF UNIDACPRO}
  NexusClasses;
{$ELSE}
  NexusClassesUni;
{$ENDIF}

{$IFNDEF DUMMY}
type
  TNexusConnectionParameters = class(TCRConnectionParameters)
  protected
    procedure AssignTo(Dest: TPersistent); override;
    function ConnectParamsToString: string; override;
  public
    Database: string;
    ConnectionTimeout: integer;
    HeartbeatInterval: integer;
    LostConnectionTimeout: integer;
    WatchdogInterval: integer;
    CommandTimeout: integer;
    DatabaseReadOnly: boolean;
    Port: string;

    function Equals(Obj: TCRConnectionParameters): boolean; override;
    function SetProp(Prop: integer; const Value: variant): boolean; override;
  end;

  TNexusLocalConnectionPool = class(TCRLocalConnectionPool)
  protected
    function CreateNewConnector: TCRConnection; override;
  end;

  TNexusConnectionPoolManager = class(TCRConnectionPoolManager)
  protected
    function CreateCRConnectionPool(ConnectionParameters: TCRConnectionParameters): TCRConnectionPool; override;
  public
    class procedure Clear; {$IFDEF CLR}static;{$ENDIF}
    class function GetConnection(ConnectionParameters: TCRConnectionParameters; SQLMonitorClass: TDASQLMonitorClass): TCRConnection; override;
  end;
{$ENDIF} // DUMMY

implementation

uses
  CRFunctions;
  
{$IFNDEF DUMMY}
var
  ConnectionPoolManager: TNexusConnectionPoolManager;
  LockPoolManagerCreate: TCriticalSection;

{ TNexusConnectionPoolParamters }

function TNexusConnectionParameters.Equals(Obj: TCRConnectionParameters): boolean;
var
  NexusObj: TNexusConnectionParameters;
begin
  Result := inherited Equals(Obj);
  if Result and (Obj is TNexusConnectionParameters) then begin
    NexusObj := TNexusConnectionParameters(Obj);
    Result :=
      (AnsiCompareText(NexusObj.Database, Database) = 0) and
      (ConnectionTimeout = NexusObj.ConnectionTimeout) and
      (HeartbeatInterval = NexusObj.HeartbeatInterval) and
      (LostConnectionTimeout = NexusObj.LostConnectionTimeout) and
      (WatchdogInterval = NexusObj.WatchdogInterval) and
      (CommandTimeout = NexusObj.CommandTimeout) and
      (DatabaseReadOnly = NexusObj.DatabaseReadOnly) and
      (Port = NexusObj.Port);
  end;
end;

function TNexusConnectionParameters.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDatabase:
      Database := Value;
    prPort:
      Port := Value;
    prConnectionTimeout:
      ConnectionTimeout := Value;
    prHeartbeatInterval:
      HeartbeatInterval := Value;
    prLostConnectionTimeout:
      LostConnectionTimeout := Value;
    prWatchdogInterval:
      WatchdogInterval := Value;
    prCommandTimeout:
      CommandTimeout := Value;
    prDatabaseReadOnly:
      DatabaseReadOnly := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

procedure TNexusConnectionParameters.AssignTo(Dest: TPersistent);
begin
  if Dest is TNexusConnectionParameters then begin
    TNexusConnectionParameters(Dest).Database := Database;
    TNexusConnectionParameters(Dest).Port := Port;
    TNexusConnectionParameters(Dest).ConnectionTimeout := ConnectionTimeout;
    TNexusConnectionParameters(Dest).HeartbeatInterval := HeartbeatInterval;
    TNexusConnectionParameters(Dest).LostConnectionTimeout := LostConnectionTimeout;
    TNexusConnectionParameters(Dest).WatchdogInterval := WatchdogInterval;
    TNexusConnectionParameters(Dest).CommandTimeout := CommandTimeout;
    TNexusConnectionParameters(Dest).DatabaseReadOnly := DatabaseReadOnly;
  end;

  inherited;
end;

function TNexusConnectionParameters.ConnectParamsToString: string;
begin
  Result := inherited ConnectParamsToString + Format(
    'Port=%d'#13'Database=%s'#13,
    [Port, Database]);
end;

{ TNexusLocalConnectionPool }

function TNexusLocalConnectionPool.CreateNewConnector: TCRConnection;
begin
  Result := TNexusConnection.Create;

  try
    Result.SetProp(prDatabase, TNexusConnectionParameters(ConnectionParameters).Database);
    Result.SetProp(prPort, TNexusConnectionParameters(ConnectionParameters).Port);
    Result.SetProp(prConnectionTimeout, TNexusConnectionParameters(ConnectionParameters).ConnectionTimeout);
    Result.SetProp(prHeartbeatInterval, TNexusConnectionParameters(ConnectionParameters).HeartbeatInterval);
    Result.SetProp(prLostConnectionTimeout, TNexusConnectionParameters(ConnectionParameters).LostConnectionTimeout);
    Result.SetProp(prWatchdogInterval, TNexusConnectionParameters(ConnectionParameters).WatchdogInterval);
    Result.SetProp(prCommandTimeout, TNexusConnectionParameters(ConnectionParameters).CommandTimeout);
    Result.SetProp(prDatabaseReadOnly, TNexusConnectionParameters(ConnectionParameters).DatabaseReadOnly);
  
    Result.OnError := ConnectionParameters.OnError;
    Result.SetUsername(ConnectionParameters.Username);
    Result.SetPassword(ConnectionParameters.Password);
    Result.SetServer(ConnectionParameters.Server);
  except
    Result.Free;
    raise;
  end;
end;

{ TNexusConnectionPoolManager }

function TNexusConnectionPoolManager.CreateCRConnectionPool(ConnectionParameters: TCRConnectionParameters): TCRConnectionPool;
begin
  Result := TNexusLocalConnectionPool.Create(Self, ConnectionParameters);
end;

class procedure TNexusConnectionPoolManager.Clear;
begin
  if ConnectionPoolManager <> nil then
    ConnectionPoolManager.InternalClear;
end;

class function TNexusConnectionPoolManager.GetConnection(ConnectionParameters: TCRConnectionParameters;
  SQLMonitorClass: TDASQLMonitorClass): TCRConnection;
begin
  LockPoolManagerCreate.Enter;
  try
    if ConnectionPoolManager = nil then begin
      ConnectionPoolManager := TNexusConnectionPoolManager.Create;
      ConnectionPoolManager.SQLMonitorClass := SQLMonitorClass;
    end;
  finally
    LockPoolManagerCreate.Leave;
  end;    

  Result := ConnectionPoolManager.InternalGetConnection(ConnectionParameters);
end;

{$IFDEF WIN32}
{$IFNDEF FPC}
var
  OldDLLProc: TDLLProc;

procedure LibraryProc(Reason: integer);
begin
  if Reason = DLL_PROCESS_DETACH then begin
    ConnectionPoolManager.Free;
    ConnectionPoolManager := nil;
  end;
  if Assigned(OldDLLProc) then
    OldDLLProc(Reason);
end;
{$ENDIF}
{$ENDIF}

initialization
{$IFDEF WIN32}
{$IFNDEF FPC}
  OldDLLProc := DLLProc;
  DLLProc := @LibraryProc;
{$ENDIF}
{$ENDIF}
  ConnectionPoolManager := nil;
  LockPoolManagerCreate := TCriticalSection.Create;
  
finalization
  ConnectionPoolManager.Free;
  ConnectionPoolManager := nil;
  LockPoolManagerCreate.Free;

{$ENDIF} // DUMMY

end.
