Injector (WIP)

sources/MVCFramework.Injector.pas

@@ -0,0 +1,121 @@
+unit MVCFramework.Injector;
+
+interface
+
+uses
+  System.Generics.Collections, System.Rtti, System.SysUtils;
+
+type
+  TMVCServiceContainer = class
+  private
+    type
+      TRegistrationType = (rtTransient, rtSingleton {, rtSingletonPerThread});
+      TRegistration = class
+        Intf: TGUID;
+        Clazz: TClass;
+        Instance: IInterface;
+        RegistrationType: TRegistrationType;
+      end;
+  private
+    fRegistry: TObjectDictionary<string, TRegistration>;
+  protected
+    function GetKey(const aGUID: TGUID; const aName: String): String;
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+    procedure RegisterType<TImpl: class>(const aInterface: TGUID; const aName : string = ''; const aRegType: TRegistrationType = rtTransient);
+    function Resolve<TIntf: IInterface>(const aName: string = ''; const aParams: TArray<TValue> = nil): TIntf;
+    type
+      EMVCContainerError = class(Exception) end;
+      EMVCUnknownService = class(EMVCContainerError) end;
+      EMVCInterfaceNotSupported = class(EMVCContainerError) end;
+      EMVCUnknownConstructor = class(EMVCContainerError) end;
+  end;
+
+implementation
+
+uses
+  MVCFramework.Rtti.Utils, System.TypInfo;
+
+{ TMVCServiceContainer }
+
+constructor TMVCServiceContainer.Create;
+begin
+  inherited;
+  fRegistry := TObjectDictionary<String, TRegistration>.Create([doOwnsValues]);
+end;
+
+destructor TMVCServiceContainer.Destroy;
+begin
+  fRegistry.Free;
+  inherited;
+end;
+
+function TMVCServiceContainer.GetKey(const aGUID: TGUID; const aName: String): String;
+begin
+  Result := aGUID.ToString + '_' + aName;
+end;
+
+procedure TMVCServiceContainer.RegisterType<TImpl>(const aInterface: TGUID; const aName: string; const aRegType: TRegistrationType);
+var
+  lType: TRttiType;
+  lReg: TRegistration;
+begin
+  lType := TRttiUtils.GlContext.GetType(TImpl);
+  if Supports(TImpl, aInterface) then
+  begin
+    lReg := TRegistration.Create;
+    lReg.Clazz := TImpl;
+    lReg.RegistrationType := aRegType;
+    fRegistry.Add(GetKey(aInterface, aName), lReg);
+  end
+  else
+  begin
+    raise EMVCUnknownService.Create(lType.Name + ' doesn''t supports requested interface');
+  end;
+end;
+
+function TMVCServiceContainer.Resolve<TIntf>(const aName: string; const aParams: TArray<TValue>): TIntf;
+var
+  lReg: TRegistration;
+  lTypeInfo: PTypeInfo;
+  lType: TRttiType;
+  lService: TObject;
+begin
+  lTypeInfo := TypeInfo(TIntf);
+  if not fRegistry.TryGetValue(GetKey(lTypeInfo.TypeData.GUID, aName), lReg) then
+  begin
+    raise EMVCUnknownService.CreateFmt('Unknown service for "%s"', [lTypeInfo.Name]);
+  end;
+  lType := TRttiUtils.GlContext.GetType(lReg.Clazz);
+
+  case lReg.RegistrationType of
+    rtTransient:
+    begin
+      lService := TRttiUtils.CreateObject(lType, AParams);
+      Supports(lService, lTypeInfo.TypeData.GUID, Result);
+    end;
+
+    rtSingleton:
+    begin
+      if lReg.Instance = nil then
+      begin
+        TMonitor.Enter(Self);
+        try
+          if lReg.Instance = nil then
+          begin
+            lService := TRttiUtils.CreateObject(lType, AParams);
+            Supports(lService, lTypeInfo.TypeData.GUID, lReg.Instance)
+          end;
+        finally
+          TMonitor.Exit(Self)
+        end;
+      end;
+      Supports(lReg.Instance, lTypeInfo.TypeData.GUID, Result);
+    end;
+    else
+      raise EMVCContainerError.Create('Unsupported RegistrationType');
+  end;
+end;
+
+end.

unittests/general/Several/BOs.pas

@@ -676,6 +676,34 @@ type
     property BackEndName: String read FBackEndName write SetBackEndName;
   end;
 
+
+
+  // TEST INJECTOR
+  IMyInterface1 = interface
+    ['{AA4EFC41-F34F-4B50-AC3B-5627D4C48CE2}']
+    function MyMethod1: String;
+  end;
+
+  IMyInterface2 = interface
+    ['{3FE46150-81CA-4ACD-BA8D-B94D1492B1E6}']
+    function MyMethod2: String;
+  end;
+
+  IMyInterface3 = interface
+    ['{7A4ECD36-3B81-4C87-85CE-1C3AFBD7718F}']
+    function MyMethod3: String;
+  end;
+
+  TMyService = class(TInterfacedObject, IMyInterface1, IMyInterface2)
+    function MyMethod1: String;
+    function MyMethod2: String;
+  end;
+
+  TMyService2 = class(TInterfacedObject, IMyInterface3)
+    function MyMethod3: String;
+  end;
+
+
 function GetMyObject: TMyObject;
 function GetMyObjectWithTValue: TMyObjectWithTValue;
 function GetMyObjectWithStream: TMyStreamObject;
@@ -1454,6 +1482,25 @@ begin
   FBackEndName := Value;
 end;
 
+{ TMyService }
+
+function TMyService.MyMethod1: String;
+begin
+  Result := 'TMyService.MyMethod1';
+end;
+
+function TMyService.MyMethod2: String;
+begin
+  Result := 'TMyService.MyMethod2';
+end;
+
+{ TMyService2 }
+
+function TMyService2.MyMethod3: String;
+begin
+  Result := 'TMyService2.MyMethod3';
+end;
+
 initialization
 
 ActiveRecordMappingRegistry.AddEntity('customers', TCustomer);

unittests/general/Several/FrameworkTestsU.pas

@@ -288,6 +288,15 @@ type
     procedure TestInLineComments;
   end;
 
+  [TestFixture]
+  TTestInjector = class(TObject)
+  public
+    [Test]
+    procedure TestTransient;
+    [Test]
+    procedure TestUnknownService;
+  end;
+
 
 implementation
 
@@ -312,7 +321,7 @@ uses
   TestServerControllerU, System.Classes,
   MVCFramework.DuckTyping, System.IOUtils, MVCFramework.SystemJSONUtils,
   IdGlobal, System.TypInfo, System.Types, Winapi.Windows, MVCFramework.DotEnv,
-  MVCFramework.DotEnv.Parser;
+  MVCFramework.DotEnv.Parser, MVCFramework.Injector;
 
 var
   JWT_SECRET_KEY_TEST: string = 'myk3y';
@@ -2396,6 +2405,51 @@ begin
   end;
 end;
 
+{ TTestInjector }
+
+procedure TTestInjector.TestTransient;
+begin
+  var lCont := TMVCServiceContainer.Create;
+  try
+    lCont.RegisterType<TMyService>(IMyInterface1);
+    lCont.RegisterType<TMyService>(IMyInterface2, '', rtSingleton);
+    var l0 := lCont.Resolve<IMyInterface1>;
+    var l1 := lCont.Resolve<IMyInterface1>;
+    Assert.AreNotEqual(l0, l1);
+    var l2 := lCont.Resolve<IMyInterface2>;
+    var l3 := lCont.Resolve<IMyInterface2>;
+    Assert.AreEqual(l2, l3);
+  finally
+    lCont.Free;
+  end;
+end;
+
+procedure TTestInjector.TestUnknownService;
+begin
+  var lCont := TMVCServiceContainer.Create;
+  try
+    Assert.WillRaise(
+      procedure
+      begin
+        lCont.RegisterType<TMyService2>(IMyInterface2);
+      end, TMVCServiceContainer.EMVCUnknownService);
+
+    Assert.WillRaise(
+      procedure
+      begin
+        lCont.RegisterType<TTestJWT>(IMyInterface2);
+      end, TMVCServiceContainer.EMVCUnknownService);
+
+    Assert.WillRaise(
+      procedure
+      begin
+        lCont.RegisterType<TMyService2>(IMVCSerializer);
+      end, TMVCServiceContainer.EMVCUnknownService);
+  finally
+    lCont.Free;
+  end;
+end;
+
 initialization
 
 TDUnitX.RegisterTestFixture(TTestRouting);
@@ -2407,6 +2461,7 @@ TDUnitX.RegisterTestFixture(TTestCryptUtils);
 TDUnitX.RegisterTestFixture(TTestLRUCache);
 TDUnitX.RegisterTestFixture(TTestDotEnv);
 TDUnitX.RegisterTestFixture(TTestDotEnvParser);
+TDUnitX.RegisterTestFixture(TTestInjector);
 
 finalization