unit Aurelius.Comp.Adapters;

interface

uses
  SysUtils, Classes, Generics.Collections,
  Aurelius.Drivers.Interfaces,
  Aurelius.Global.Exceptions;

type
  TAdapterFactoryArgs = class
  private
    FAdaptedConnection: TComponent;
    FOwner: TComponent;
    FSqlDialect: string;
  public
    constructor Create(AAdaptedConnection: TComponent; const ASqlDialect: string;
      AOwner: TComponent);
    property AdaptedConnection: TComponent read FAdaptedConnection;
    property SqlDialect: string read FSqlDialect;
    property Owner: TComponent read FOwner;
  end;

  TAureliusAdapterFactory = reference to function(Args: TAdapterFactoryArgs): IDBConnection;

  IAureliusAdapter = interface
  ['{A69B0AF9-6D8F-477D-813F-739BB69F2F56}']
    function GetName: string;
    function GetSqlDialects: TArray<string>;
    function IsAdaptedConnectionValid(Connection: TComponent): Boolean;
    function IsSqlDialectValid(const SqlDialect: string): Boolean;
    function GetAdapterFactory: TAureliusAdapterFactory;
    procedure SetAdapterFactory(Value: TAureliusAdapterFactory);
    function GetDesignAdapterFactory: TAureliusAdapterFactory;
    procedure SetDesignAdapterFactory(Value: TAureliusAdapterFactory);

    property Name: string read GetName;
    property SqlDialects: TArray<string> read GetSqlDialects;
    property AdapterFactory: TAureliusAdapterFactory read GetAdapterFactory write SetAdapterFactory;
    property DesignAdapterFactory: TAureliusAdapterFactory read GetDesignAdapterFactory write SetDesignAdapterFactory;
  end;

  TAureliusAdapter = class(TInterfacedObject, IAureliusAdapter)
  strict private
    FName: string;
    FSqlDialects: TArray<string>;
    FAdaptedClassName: string;
    FAdapterFactory: TAureliusAdapterFactory;
    FDesignAdapterFactory: TAureliusAdapterFactory;
  strict protected
    function GetName: string; virtual;
    function GetSqlDialects: TArray<string>; virtual;
    function IsAdaptedConnectionValid(Connection: TComponent): Boolean; virtual;
    function IsSqlDialectValid(const SqlDialect: string): Boolean; virtual;
    function GetAdapterFactory: TAureliusAdapterFactory;
    procedure SetAdapterFactory(Value: TAureliusAdapterFactory);
    function GetDesignAdapterFactory: TAureliusAdapterFactory;
    procedure SetDesignAdapterFactory(Value: TAureliusAdapterFactory);
  public
    constructor Create(const AName, AAdaptedClassName: string; const ASqlDialects: string);
  end;

  TAureliusAdapterRegister = class
  private
    class var FInstance: TAureliusAdapterRegister;
  private
    FAdapters: TDictionary<string, IAureliusAdapter>;
    FSqlDialectUnits: TDictionary<string, TArray<string>>;
    FAdapterUnits: TDictionary<string, TArray<string>>;
    procedure PrivateCreate;
    procedure PrivateDestroy;
    function GetAdapters: TEnumerable<IAureliusAdapter>;
    procedure AddDefaultAdapters;
    procedure AddSqlDialectUnits;
    procedure AddAdapterUnits;
  public
    function GetSqlDialectUnits(const SqlDialect: string): TArray<string>;
    procedure RegisterSqlDialectUnits(const SqlDialect: string; const Units: string);
    function GetAdapterUnits(const AdapterName: string): TArray<string>;
    procedure RegisterAdapterUnits(const AdapterName: string; const Units: string);
    procedure RegisterAdapterFactory(const AdapterName: string; Factory: TAureliusAdapterFactory);
    procedure RegisterDesignAdapterFactory(const AdapterName: string; Factory: TAureliusAdapterFactory);
  public
    class function Instance: TAureliusAdapterRegister;
    procedure RegisterAdapter(Adapter: IAureliusAdapter);
    function GetAdapter(const AdapterName: string): IAureliusAdapter;
    function FindAdapter(const AdapterName: string): IAureliusAdapter;
    property Adapters: TEnumerable<IAureliusAdapter> read GetAdapters;
  end;

  EAureliusAdapterNotFound = class(EOPFBaseException)
  public
    constructor Create(const AdapterName: string);
  end;

implementation

uses
  StrUtils;

function SplitStrings(const Values: string): TArray<string>;
begin
  Result := TArray<string>(SplitString(Values, ','));
end;

{ EAureliusAdapterNotFound }

constructor EAureliusAdapterNotFound.Create(const AdapterName: string);
begin
  inherited CreateFmt('Aurelius connection adapter "%s" not found', [AdapterName]);
end;

{ TAureliusAdapterRegister }

procedure TAureliusAdapterRegister.AddDefaultAdapters;
begin
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('AbsoluteDB', 'TABSDatabase', 'AbsoluteDB')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('AnyDac', 'TADConnection', 'DB2,Firebird,Interbase,MSSQL,MySQL,Oracle,PostgreSQL,Sqlite')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('dbExpress', 'TSQLConnection', 'Firebird,Interbase,MSSQL,MySQL,Oracle')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('dbGo', 'TADOConnection', 'DB2,MSSQL')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('DOA', 'TOracleSession', 'Oracle')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('ElevateDB', 'TEDBDatabase', 'ElevateDB')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('FIBPlus', 'TFIBDatabase', 'Firebird,Interbase')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('FireDac', 'TFDConnection', 'DB2,Firebird,Interbase,MSSQL,MySQL,Oracle,PostgreSQL,Sqlite')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('IBObjects', 'TIB_Connection', 'Firebird,Interbase')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('IBExpress', 'TIBDatabase', 'Firebird,Interbase')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('NexusDB', 'TnxDatabase', 'NexusDB')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('SqlDirect', 'TSDDatabase', 'DB2,Interbase,MSSQL,MySQL,Oracle')));
//  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('SQLite', '', 'Sqlite')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('UniDac', 'TCustomDAConnection', 'DB2,Firebird,Interbase,MSSQL,MySQL,NexusDB,Oracle,PostgreSQL,Sqlite')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('UIB', 'TUIBDatabase', 'Firebird,Interbase')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('RemoteDB', 'TXDatabase', 'DB2,ElevateDB,Firebird,Interbase,MSSQL,MySQL,NexusDB,Oracle,PostgreSQL')));
  RegisterAdapter(IAureliusAdapter(TAureliusAdapter.Create('ZeosLib', 'TZConnection', 'Firebird,MSSQL,MySQL,Oracle')));
end;

procedure TAureliusAdapterRegister.AddAdapterUnits;
begin
  RegisterAdapterUnits('AbsoluteDB', 'Aurelius.Drivers.AbsoluteDB');
  RegisterAdapterUnits('AnyDac', 'Aurelius.Drivers.AnyDac');
  RegisterAdapterUnits('dbExpress', 'Aurelius.Drivers.dbExpress');
  RegisterAdapterUnits('dbGo', 'Aurelius.Drivers.dbGo');
  RegisterAdapterUnits('DOA', 'Aurelius.Drivers.DOA');
  RegisterAdapterUnits('ElevateDB', 'Aurelius.Drivers.ElevateDB');
  RegisterAdapterUnits('FIBPlus', 'Aurelius.Drivers.FIBPlus');
  RegisterAdapterUnits('FireDac', 'Aurelius.Drivers.FireDac');
  RegisterAdapterUnits('IBObjects', 'Aurelius.Drivers.IBObjects');
  RegisterAdapterUnits('IBExpress', 'Aurelius.Drivers.IBExpress');
  RegisterAdapterUnits('NexusDB', 'Aurelius.Drivers.NexusDB');
  RegisterAdapterUnits('SqlDirect', 'Aurelius.Drivers.SqlDirect');
//  RegisterAdapterUnits('SQLite', 'Aurelius.Drivers.SQLite');
  RegisterAdapterUnits('UniDac', 'Aurelius.Drivers.UniDac');
  RegisterAdapterUnits('UIB', 'Aurelius.Drivers.UIB');
  RegisterAdapterUnits('RemoteDB', 'Aurelius.Drivers.RemoteDB');
  RegisterAdapterUnits('ZeosLib', 'Aurelius.Drivers.ZeosLib');
end;

procedure TAureliusAdapterRegister.AddSqlDialectUnits;
begin
  RegisterSqlDialectUnits('AbsoluteDB', 'Aurelius.Sql.AbsoluteDB,Aurelius.Schema.AbsoluteDB');
  RegisterSqlDialectUnits('DB2', 'Aurelius.Sql.DB2,Aurelius.Schema.DB2');
  RegisterSqlDialectUnits('ElevateDB', 'Aurelius.Sql.ElevateDB,Aurelius.Schema.ElevateDB');
  RegisterSqlDialectUnits('Firebird', 'Aurelius.Sql.Firebird,Aurelius.Schema.Firebird');
  RegisterSqlDialectUnits('Firebird3', 'Aurelius.Sql.Firebird3,Aurelius.Schema.Firebird3');
  RegisterSqlDialectUnits('Interbase', 'Aurelius.Sql.Interbase,Aurelius.Schema.Interbase');
  RegisterSqlDialectUnits('MSSQL', 'Aurelius.Sql.MSSQL,Aurelius.Schema.MSSQL');
  RegisterSqlDialectUnits('MySQL', 'Aurelius.Sql.MySQL,Aurelius.Schema.MySQL');
  RegisterSqlDialectUnits('NexusDB', 'Aurelius.Sql.NexusDB,Aurelius.Schema.NexusDB');
  RegisterSqlDialectUnits('Oracle', 'Aurelius.Sql.Oracle,Aurelius.Schema.Oracle');
  RegisterSqlDialectUnits('PostgreSQL', 'Aurelius.Sql.PostgreSQL,Aurelius.Schema.PostgreSQL');
  RegisterSqlDialectUnits('Sqlite', 'Aurelius.Sql.Sqlite,Aurelius.Schema.Sqlite');
end;

function TAureliusAdapterRegister.FindAdapter(
  const AdapterName: string): IAureliusAdapter;
begin
  if not FAdapters.TryGetValue(UpperCase(AdapterName), Result) then
    Result := nil;
end;

function TAureliusAdapterRegister.GetAdapter(
  const AdapterName: string): IAureliusAdapter;
begin
  Result := FindAdapter(AdapterName);
  if Result = nil then
    raise EAureliusAdapterNotFound.Create(AdapterName);
end;

function TAureliusAdapterRegister.GetAdapters: TEnumerable<IAureliusAdapter>;
begin
  Result := FAdapters.Values;
end;

function TAureliusAdapterRegister.GetAdapterUnits(
  const AdapterName: string): TArray<string>;
begin
  if not FAdapterUnits.TryGetValue(UpperCase(AdapterName), Result) then
    SetLength(Result, 0);
end;

function TAureliusAdapterRegister.GetSqlDialectUnits(
  const SqlDialect: string): TArray<string>;
begin
  if not FSqlDialectUnits.TryGetValue(UpperCase(SqlDialect), Result) then
    SetLength(Result, 0);
end;

class function TAureliusAdapterRegister.Instance: TAureliusAdapterRegister;
begin
  if FInstance = nil then
  begin
    FInstance := TAureliusAdapterRegister.Create;
    FInstance.PrivateCreate;
  end;
  Result := FInstance;
end;

procedure TAureliusAdapterRegister.PrivateCreate;
begin
  FAdapters := TDictionary<string, IAureliusAdapter>.Create;
  FSqlDialectUnits := TDictionary<string, TArray<string>>.Create;
  FAdapterUnits := TDictionary<string, TArray<string>>.Create;
  AddDefaultAdapters;
  AddSqlDialectUnits;
  AddAdapterUnits;
end;

procedure TAureliusAdapterRegister.PrivateDestroy;
begin
  FAdapters.Free;
  FSqlDialectUnits.Free;
  FAdapterUnits.Free;
end;

procedure TAureliusAdapterRegister.RegisterAdapterFactory(
  const AdapterName: string; Factory: TAureliusAdapterFactory);
var
  Adapter: IAureliusAdapter;
begin
  Adapter := FindAdapter(AdapterName);
  if Assigned(Adapter) then
    Adapter.AdapterFactory := Factory;
end;

procedure TAureliusAdapterRegister.RegisterDesignAdapterFactory(
  const AdapterName: string; Factory: TAureliusAdapterFactory);
var
  Adapter: IAureliusAdapter;
begin
  Adapter := FindAdapter(AdapterName);
  if Assigned(Adapter) then
    Adapter.DesignAdapterFactory := Factory;
end;

procedure TAureliusAdapterRegister.RegisterAdapter(Adapter: IAureliusAdapter);
begin
  if not FAdapters.ContainsKey(UpperCase(Adapter.Name)) then
    FAdapters.Add(UpperCase(Adapter.Name), Adapter)
  else
    FAdapters[UpperCase(Adapter.Name)] := Adapter;
end;

procedure TAureliusAdapterRegister.RegisterAdapterUnits(
  const AdapterName: string; const Units: string);
begin
  FAdapterUnits.AddOrSetValue(UpperCase(AdapterName), SplitStrings(Units));
end;

procedure TAureliusAdapterRegister.RegisterSqlDialectUnits(
  const SqlDialect: string; const Units: string);
begin
  FSqlDialectUnits.AddOrSetValue(UpperCase(SqlDialect), SplitStrings(Units));
end;

{ TAureliusAdapter }

function TAureliusAdapter.IsAdaptedConnectionValid(Connection: TComponent): Boolean;
var
  Clazz: TClass;
begin
  Result := False;
  if Connection = nil then Exit;
  Clazz := Connection.ClassType;
  while Clazz <> nil do
  begin
    if SameText(Clazz.ClassName, FAdaptedClassName) then
      Exit(True);
    Clazz := Clazz.ClassParent;
  end;
end;

function TAureliusAdapter.IsSqlDialectValid(const SqlDialect: string): Boolean;
var
  SupportedSqlDialect: string;
begin
  for SupportedSqlDialect in GetSqlDialects do
    if SameText(SqlDialect, SupportedSqlDialect) then
      Exit(True);
  Result := False;
end;

procedure TAureliusAdapter.SetAdapterFactory(Value: TAureliusAdapterFactory);
begin
  FAdapterFactory := Value;
end;

procedure TAureliusAdapter.SetDesignAdapterFactory(
  Value: TAureliusAdapterFactory);
begin
  FDesignAdapterFactory := Value;
end;

constructor TAureliusAdapter.Create(const AName, AAdaptedClassName: string;
  const ASqlDialects: string);
begin
  FName := AName;
  FSqlDialects := SplitStrings(ASqlDialects);
  FAdaptedClassName := AAdaptedClassName;
end;

function TAureliusAdapter.GetAdapterFactory: TAureliusAdapterFactory;
begin
  Result := FAdapterFactory;
end;

function TAureliusAdapter.GetDesignAdapterFactory: TAureliusAdapterFactory;
begin
  Result := FDesignAdapterFactory;
end;

function TAureliusAdapter.GetName: string;
begin
  Result := FName;
end;

function TAureliusAdapter.GetSqlDialects: TArray<string>;
begin
  Result := FSqlDialects;
end;

{ TAdapterFactoryArgs }

constructor TAdapterFactoryArgs.Create(AAdaptedConnection: TComponent;
  const ASqlDialect: string; AOwner: TComponent);
begin
  FAdaptedConnection := AAdaptedConnection;
  FSqlDialect := ASqlDialect;
  FOwner := AOwner;
end;

initialization
finalization
  if TAureliusAdapterRegister.FInstance <> nil then
  begin
    TAureliusAdapterRegister.FInstance.PrivateDestroy;
    TAureliusAdapterRegister.FInstance.Free;
    TAureliusAdapterRegister.FInstance := nil;
  end;

end.
