unit Aurelius.Comp.Connection;

{$I Aurelius.inc}

interface

uses
  SysUtils, Classes, TypInfo, Rtti,
  Bcl.Rtti.ObjectFactory,
  Aurelius.Comp.Adapters,
  Aurelius.Comp.Drivers,
  Aurelius.Drivers.Interfaces;

type
  TCloningMode = (Rtti, Owner, Streaming);

  TAureliusConnection = class(TComponent)
  private
    FAdaptedConnection: TComponent;
    FAdapterName: string;
    FDriverName: string;
    FSQLDialect: string;
    FParams: TStrings;
    FCloningMode: TCloningMode;
    procedure SetAdaptedConnection(const Value: TComponent);
    procedure SetAdapterName(const Value: string);
    function GetAdapter: IAureliusAdapter;
    procedure CheckAdapter;
    procedure CheckAdaptedConnection;
    function GetAdapterFactory: TAureliusAdapterFactory;
    function CreateConnectionFromAdapter: IDBConnection;
    procedure GetClonedConnectionAndOwner(out ClonedConnection, ConnectionOwner: TComponent);
    function CloneAdaptedConnectionWithStreaming: TComponent;
    function CloneAdaptedConnectionWithRtti: TComponent;
    function CloneAdaptedConnectionOwner: TComponent;
  private
    procedure CheckDriver;
    procedure SetParams(const Value: TStrings);
    procedure SetDriverName(const Value: string);
    function GetDriver: IAureliusDriver;
    procedure ParamsChange(Sender: TObject);
    function GetDriverFactory: TAureliusDriverFactory;
    function CreateConnectionFromDriver: IDBConnection;
  private
    property Adapter: IAureliusAdapter read GetAdapter;
    property AdapterFactory: TAureliusAdapterFactory read GetAdapterFactory;
    property Driver: IAureliusDriver read GetDriver;
    property DriverFactory: TAureliusDriverFactory read GetDriverFactory;
  protected
    FPluginConfig: string;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CreateConnection: IDBConnection;
    function CreateConnectionFactory: IDBConnectionFactory;
    property CloningMode: TCloningMode read FCloningMode write FCloningMode;
  published
    property AdapterName: string read FAdapterName write SetAdapterName;
    property DriverName: string read FDriverName write SetDriverName;
    property AdaptedConnection: TComponent read FAdaptedConnection write SetAdaptedConnection;
    property SQLDialect: string read FSQLDialect write FSQLDialect;
    property Params: TStrings read FParams write SetParams;
  end;

  EAureliusConnectionException = class(Exception)
  end;

implementation

uses
  Aurelius.Drivers.Base;

{ TAureliusConnection }

procedure TAureliusConnection.CheckAdaptedConnection;
begin
  if FAdaptedConnection = nil then
    raise EAureliusConnectionException.Create('AdaptedConnection not specified');

  CheckAdapter;
  if not Adapter.IsAdaptedConnectionValid(FAdaptedConnection) then
    raise EAureliusConnectionException.CreateFmt(
      'Adapted connection %s is not supported for adapter %s', [FAdaptedConnection.ClassName, Adapter.Name]);
end;

procedure TAureliusConnection.CheckAdapter;
begin
  if AdapterName = '' then
    raise EAureliusConnectionException.Create('AdapterName not specified');
  if Adapter = nil then
    raise EAureliusConnectionException.CreateFmt('Adapter "%s" not found', [AdapterName]);
end;

procedure TAureliusConnection.CheckDriver;
begin
  if DriverName = '' then
    raise EAureliusConnectionException.Create('DriverName not specified');
  if Driver = nil then
    raise EAureliusConnectionException.CreateFmt('Driver "%s" not found', [DriverName]);
end;

function TAureliusConnection.CloneAdaptedConnectionWithRtti: TComponent;
var
  Rtti: TRttiContext;
  Prop: TRttiProperty;
  Props: TArray<TRttiProperty>;
  ConnectionProp: TRttiProperty;
begin
  if AdaptedConnection = nil then Exit(nil);

  Rtti := TRttiContext.Create;
  try
    Result := TComponentClass(AdaptedConnection.ClassType).Create(nil);
    try
      Props := Rtti.GetType(AdaptedConnection.ClassType).GetProperties;

      // Set events before properties
      for Prop in Props do
        if (Prop.Visibility = mvPublished) and Assigned(Prop.PropertyType) and
          (Prop.PropertyType.TypeKind = tkMethod) and Prop.IsWritable and Prop.IsReadable then
          Prop.SetValue(Result, Prop.GetValue(AdaptedConnection));

      ConnectionProp := nil;
      // Now properties
      for Prop in Props do
        if (Prop.Visibility = mvPublished) and Assigned(Prop.PropertyType) and
          (Prop.PropertyType.TypeKind <> tkMethod) and Prop.IsWritable and Prop.IsReadable then
        begin
          if SameText(Prop.Name, 'Connected') or SameText(Prop.Name, 'Active') then
            ConnectionProp := Prop
          else
            Prop.SetValue(Result, Prop.GetValue(AdaptedConnection));
        end;
      if ConnectionProp <> nil then
        ConnectionProp.SetValue(Result, ConnectionProp.GetValue(AdaptedConnection));
    except
      Result.Free;
      raise;
    end;
  finally
    Rtti.Free;
  end;
end;

function TAureliusConnection.CloneAdaptedConnectionWithStreaming: TComponent;
var
  Stream: TMemoryStream;
begin
  if AdaptedConnection = nil then Exit(nil);

  RegisterClass(TPersistentClass(AdaptedConnection.ClassType));
  Stream := TMemoryStream.Create;
  try
    Stream.WriteComponent(AdaptedConnection);
    Stream.Position := 0;
    Result := Stream.ReadComponent(nil);
  finally
    Stream.Free;
  end;
end;

function TAureliusConnection.CloneAdaptedConnectionOwner: TComponent;
begin
  if AdaptedConnection = nil then Exit(nil);
  if AdaptedConnection.Owner = nil then
    raise EAureliusConnectionException.Create('Cannot clone adapted connection without an owner');

  Result := TComponentClass(AdaptedConnection.Owner.ClassType).Create(nil);
end;

constructor TAureliusConnection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParams := TStringList.Create;
  TStringList(FParams).OnChange := ParamsChange;
end;

function TAureliusConnection.CreateConnection: IDBConnection;
begin
  if AdapterName <> '' then
    Result := CreateConnectionFromAdapter
  else
  if DriverName <> '' then
    Result := CreateConnectionFromDriver
  else
    raise EAureliusConnectionException.Create('Cannot connect, set either AdapterName or DriverName');
end;

function TAureliusConnection.CreateConnectionFactory: IDBConnectionFactory;
begin
  Result := TDBConnectionFactory.Create(CreateConnection);
end;

function TAureliusConnection.CreateConnectionFromAdapter: IDBConnection;
var
  Args: TAdapterFactoryArgs;
  ClonedConnection: TComponent;
  ConnectionOwner: TComponent;
begin
  CheckAdapter;
  CheckAdaptedConnection;

  GetClonedConnectionAndOwner(ClonedConnection, ConnectionOwner);
  Args := TAdapterFactoryArgs.Create(ClonedConnection, SQLDialect, ConnectionOwner);
  try
    Result := AdapterFactory(Args);
  finally
    Args.Free;
  end;
end;

function TAureliusConnection.CreateConnectionFromDriver: IDBConnection;
var
  Args: TDriverFactoryArgs;
begin
  CheckDriver;
  Args := TDriverFactoryArgs.Create(Params);
  try
    Result := DriverFactory(Args);
  finally
    Args.Free;
  end;
end;

destructor TAureliusConnection.Destroy;
begin
  FParams.Free;
  inherited;
end;

function TAureliusConnection.GetAdapterFactory: TAureliusAdapterFactory;
begin
  CheckAdapter;
  if csDesigning in ComponentState then
  begin
    Result := Adapter.DesignAdapterFactory;
    if Result = nil then
      raise EAureliusConnectionException.CreateFmt('Adapter "%s" is not supported at design-time', [Adapter.Name]);
  end
  else
  begin
    Result := Adapter.AdapterFactory;
    if Result = nil then
      raise EAureliusConnectionException.CreateFmt('Adapter "%s" cannot create IDBConnection', [Adapter.Name]);
  end;
end;

procedure TAureliusConnection.GetClonedConnectionAndOwner(out ClonedConnection,
  ConnectionOwner: TComponent);
begin
  if csDesigning in ComponentState then
  begin
    ClonedConnection := AdaptedConnection;
    ConnectionOwner := nil;
  end
  else
    case FCloningMode of
      TCloningMode.Rtti:
        begin
          ClonedConnection := CloneAdaptedConnectionWithRtti;
          ConnectionOwner := ClonedConnection;
        end;
      TCloningMode.Streaming:
        begin
          ClonedConnection := CloneAdaptedConnectionWithStreaming;
          ConnectionOwner := ClonedConnection;
        end;
      TCloningMode.Owner:
        begin
          ConnectionOwner := CloneAdaptedConnectionOwner;
          try
            ClonedConnection := ConnectionOwner.FindComponent(AdaptedConnection.Name);
            if ClonedConnection = nil then
              raise EAureliusConnectionException.Create('Could not find connection after cloning owner');
          except
            ConnectionOwner.Free;
            raise;
          end;
        end;
    end;
end;

function TAureliusConnection.GetDriver: IAureliusDriver;
begin
  Result := TAureliusDriverRegister.Instance.FindDriver(DriverName);
end;

function TAureliusConnection.GetDriverFactory: TAureliusDriverFactory;
begin
  CheckDriver;
  Result := Driver.DriverFactory;
  if Result = nil then
    raise EAureliusConnectionException.CreateFmt('Driver "%s" cannot create IDBConnection', [Driver.Name]);
end;

function TAureliusConnection.GetAdapter: IAureliusAdapter;
begin
  Result := TAureliusAdapterRegister.Instance.FindAdapter(AdapterName);
end;

procedure TAureliusConnection.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FAdaptedConnection) then
    AdaptedConnection := nil;
end;

procedure TAureliusConnection.ParamsChange(Sender: TObject);
begin
end;

procedure TAureliusConnection.SetAdaptedConnection(const Value: TComponent);
begin
  if Value <> FAdaptedConnection then
  begin
    if FAdaptedConnection <> nil then
      FAdaptedConnection.RemoveFreeNotification(Self);
    FAdaptedConnection := Value;
    if FAdaptedConnection <> nil then
      FAdaptedConnection.FreeNotification(Self);
  end;
end;

procedure TAureliusConnection.SetAdapterName(const Value: string);
begin
  if FAdapterName <> Value then
  begin
    FAdapterName := Value;
    if not (Assigned(Adapter) and Adapter.IsAdaptedConnectionValid(AdaptedConnection)) then
      AdaptedConnection := nil;
    if not (Assigned(Adapter) and Adapter.IsSqlDialectValid(SqlDialect)) then
      SQLDialect := '';
    if (SQLDialect = '') and Assigned(Adapter) and (Length(Adapter.SqlDialects) = 1) then
      SQLDialect := Adapter.SqlDialects[0];

    if AdapterName <> '' then
      DriverName := ''
  end;
end;

procedure TAureliusConnection.SetDriverName(const Value: string);
begin
  if FDriverName <> Value then
  begin
    FDriverName := Value;

    if DriverName <> '' then
      AdapterName := '';
  end;
end;

procedure TAureliusConnection.SetParams(const Value: TStrings);
begin
  FParams.Assign(Value);
end;

end.

