From 5cdcdf8c92249d692e4eef69f6f9276093e62016 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Mon, 2 Sep 2024 17:48:01 +0200 Subject: [PATCH] Added delegates to service container service registration --- sources/MVCFramework.Container.pas | 92 ++++++++++++++++++--- unittests/general/Several/InjectorTestU.pas | 89 ++++++++++++++++++++ 2 files changed, 170 insertions(+), 11 deletions(-) diff --git a/sources/MVCFramework.Container.pas b/sources/MVCFramework.Container.pas index 743fd025..f192daa6 100644 --- a/sources/MVCFramework.Container.pas +++ b/sources/MVCFramework.Container.pas @@ -14,6 +14,8 @@ type TClassOfInterfacedObject = class of TInterfacedObject; + TInterfacedObjectFactory = reference to function: TInterfacedObject; + IMVCServiceContainerResolver = interface ['{2C920EC2-001F-40BE-9911-43A65077CADD}'] function Resolve(const aTypeInfo: PTypeInfo; const aName: string = ''): IInterface; overload; @@ -22,6 +24,7 @@ type IMVCServiceContainer = interface ['{1BB3F4A8-DDA1-4526-981C-A0BF877CFFD5}'] function RegisterType(const aImplementation: TClassOfInterfacedObject; const aInterface: TGUID; const aRegType: TRegistrationType = TRegistrationType.Transient; const aName : string = ''): IMVCServiceContainer; overload; + function RegisterType(const aDelegate: TInterfacedObjectFactory; const aInterface: TGUID; const aRegType: TRegistrationType = TRegistrationType.Transient; const aName : string = ''): IMVCServiceContainer; overload; procedure Build(); end; @@ -54,6 +57,7 @@ type Clazz: TClassOfInterfacedObject; RttiType: TRttiType; Instance: IInterface; + Delegate: TInterfacedObjectFactory; RegistrationType: TRegistrationType; end; @@ -69,8 +73,10 @@ type class function GetKey(const aGUID: TGUID; const aName: String): String; constructor Create; virtual; destructor Destroy; override; + procedure CheckBuilt; public function RegisterType(const aImplementation: TClassOfInterfacedObject; const aInterface: TGUID; const aRegType: TRegistrationType = TRegistrationType.Transient; const aName : string = ''): IMVCServiceContainer; overload; + function RegisterType(const aDelegate: TInterfacedObjectFactory; const aInterface: TGUID; const aRegType: TRegistrationType = TRegistrationType.Transient; const aName : string = ''): IMVCServiceContainer; overload; function Resolve(const ServiceContainerResolver: IMVCServiceContainerResolver; const aTypeInfo: PTypeInfo; const aName: string = ''): IInterface; overload; function ResolveEx(const ServiceContainerResolver: IMVCServiceContainerResolver; const aTypeInfo: PTypeInfo; const aName: string; out ServiceKey: String; out RegType: TRegistrationType): IInterface; overload; procedure Build(); @@ -136,6 +142,14 @@ begin end; +procedure TMVCServiceContainer.CheckBuilt; +begin + if fBuilt then + begin + raise EMVCContainerError.Create('Cannot register new service if the container has been already built'); + end; +end; + constructor TMVCServiceContainer.Create; begin inherited; @@ -160,15 +174,12 @@ var lReg: TRegistration; lKey: string; begin - if fBuilt then - begin - raise EMVCContainerError.Create('Cannot register new service if the container has been already built'); - end; - + CheckBuilt; if Supports(aImplementation, aInterface) then begin lReg := TRegistration.Create; lReg.Clazz := aImplementation; + lReg.Delegate := nil; lReg.RttiType := TRttiUtils.GlContext.GetType(lReg.Clazz); lReg.RegistrationType := aRegType; lKey := GetKey(aInterface, aName); @@ -196,6 +207,38 @@ begin Result := Self; end; +function TMVCServiceContainer.RegisterType( + const aDelegate: TInterfacedObjectFactory; const aInterface: TGUID; + const aRegType: TRegistrationType; const aName: string): IMVCServiceContainer; +var + lReg: TRegistration; + lKey: string; +begin + CheckBuilt; + lReg := TRegistration.Create; + lReg.Clazz := nil; + lReg.Delegate := aDelegate; + lReg.RttiType := nil; //TRttiUtils.GlContext.GetType(lReg.Clazz); + lReg.RegistrationType := aRegType; + lKey := GetKey(aInterface, aName); + {$IF Defined(RIOORBETTER)} + if not fRegistry.TryAdd(lKey, lReg) then + begin + raise EMVCContainerError.CreateFmt('Cannot register duplicated service "%s"',[lKey]); + end; + {$ELSE} + if not fRegistry.ContainsKey(lKey) then + begin + fRegistry.Add(lKey, lReg) + end + else + begin + raise EMVCContainerError.CreateFmt('Cannot register duplicated service "%s"',[lKey]); + end; + {$ENDIF} + Result := Self; +end; + function TMVCServiceContainer.Resolve(const ServiceContainerResolver: IMVCServiceContainerResolver; const aTypeInfo: PTypeInfo; const aName: string): IInterface; var lReg: TRegistration; @@ -262,15 +305,26 @@ begin begin raise EMVCContainerErrorUnknownService.CreateFmt('Unknown service "%s" with name "%s"', [lTypeInfo.Name, aName]) end; - lType := lReg.RttiType; + lType := lReg.RttiType; RegType := lReg.RegistrationType; ServiceKey := lServiceKey; case lReg.RegistrationType of TRegistrationType.Transient, TRegistrationType.SingletonPerRequest: begin - lService := CreateServiceWithDependencies(ServiceContainerResolver, lReg.Clazz, TRttiUtils.GetFirstDeclaredConstructor(lType)); - Supports(lService, lTypeInfo.TypeData.GUID, Result); + if lReg.Delegate = nil then + begin + lService := CreateServiceWithDependencies(ServiceContainerResolver, lReg.Clazz, TRttiUtils.GetFirstDeclaredConstructor(lType)); + end + else + begin + lService := lReg.Delegate(); + end; + if not Supports(lService, lTypeInfo.TypeData.GUID, Result) then + begin + raise EMVCContainerErrorUnknownService. + CreateFmt('"%s" doesn''t supports requested interface', [TInterfacedObject(lReg.Instance).QualifiedClassName]); + end; {rtSingletonPerRequest is destroyed by the adapter owned by Context} end; @@ -282,8 +336,19 @@ begin try if lReg.Instance = nil then begin - lService := CreateServiceWithDependencies(ServiceContainerResolver, lReg.Clazz, TRttiUtils.GetFirstDeclaredConstructor(lType)); - Supports(lService, lTypeInfo.TypeData.GUID, lReg.Instance) + if lReg.Delegate = nil then + begin + lService := CreateServiceWithDependencies(ServiceContainerResolver, lReg.Clazz, TRttiUtils.GetFirstDeclaredConstructor(lType)); + end + else + begin + lService := lReg.Delegate(); + end; + if not Supports(lService, lTypeInfo.TypeData.GUID, lReg.Instance) then + begin + raise EMVCContainerErrorUnknownService. + CreateFmt('"%s" doesn''t supports requested interface', [TInterfacedObject(lReg.Instance).QualifiedClassName]); + end; end; finally TMonitor.Exit(Self) @@ -301,6 +366,11 @@ begin fBuilt := True; end; +function DefaultMVCServiceResolver: IMVCServiceContainerResolver; +begin + Result := DefaultMVCServiceContainer as IMVCServiceContainerResolver; +end; + function DefaultMVCServiceContainer: IMVCServiceContainer; begin if gDefaultMVCServiceContainer = nil then @@ -362,7 +432,7 @@ end; function NewServiceContainerResolver: IMVCServiceContainerResolver; begin - Result := TMVCServiceContainerAdapter.Create(DefaultMVCServiceContainer); + Result := TMVCServiceContainerAdapter.Create(DefaultMVCServiceContainer); end; function NewServiceContainerResolver(Container: IMVCServiceContainer) : IMVCServiceContainerResolver; diff --git a/unittests/general/Several/InjectorTestU.pas b/unittests/general/Several/InjectorTestU.pas index 492c163d..e11e65e2 100644 --- a/unittests/general/Several/InjectorTestU.pas +++ b/unittests/general/Several/InjectorTestU.pas @@ -45,10 +45,16 @@ type [Test] procedure TestTransient; [Test] + procedure TestTransientWithDelegate; + [Test] procedure TestSingleton; [Test] + procedure TestSingletonWithDelegate; + [Test] procedure TestSingletonPerRequest; [Test] + procedure TestSingletonPerRequestWithDelegate; + [Test] procedure TestCascadeConstructorInjection; end; @@ -191,6 +197,68 @@ begin end; +procedure TTestContainer.TestSingletonPerRequestWithDelegate; +begin + var lCont := NewMVCServiceContainer + .RegisterType(function : TInterfacedObject + begin + Result := TServiceA.Create + end, IServiceA, TRegistrationType.SingletonPerRequest) + .RegisterType(function : TInterfacedObject + begin + Result := TServiceA.Create + end, IServiceA, TRegistrationType.SingletonPerRequest, 'Svc1'); + lCont.Build; + + // 1° "request" + var lResolver := NewServiceContainerResolver(lCont); + var l0 := lResolver.Resolve(TypeInfo(IServiceA)); + var l1 := lResolver.Resolve(TypeInfo(IServiceA)); + Assert.AreEqual(l0, l1); + var l2 := lResolver.Resolve(TypeInfo(IServiceA), 'Svc1'); + var l3 := lResolver.Resolve(TypeInfo(IServiceA), 'Svc1'); + Assert.AreEqual(l2, l3); + + // 2° "request" + lResolver := NewServiceContainerResolver(lCont); + var l00 := lResolver.Resolve(TypeInfo(IServiceA)); + var l10 := lResolver.Resolve(TypeInfo(IServiceA)); + Assert.AreEqual(l00, l10); + Assert.AreNotEqual(l0, l00); + Assert.AreNotEqual(l1, l10); +end; + +procedure TTestContainer.TestSingletonWithDelegate; +begin + var lCont := NewMVCServiceContainer; + lCont.RegisterType(function : TInterfacedObject + begin + Result := TServiceA.Create + end, IServiceA, TRegistrationType.Singleton); + lCont.RegisterType(function : TInterfacedObject + begin + Result := TServiceA.Create + end, IServiceA, TRegistrationType.Singleton, 'Svc1'); + lCont.Build; + + // 1° Request + var lResolver := NewServiceContainerResolver(lCont); + var l0 := lResolver.Resolve(TypeInfo(IServiceA)); + var l1 := lResolver.Resolve(TypeInfo(IServiceA)); + Assert.AreEqual(l0, l1); + var l2 := lResolver.Resolve(TypeInfo(IServiceA), 'Svc1'); + var l3 := lResolver.Resolve(TypeInfo(IServiceA), 'Svc1'); + Assert.AreEqual(l2, l3); + + // 2° Request + lResolver := NewServiceContainerResolver(lCont); + var l10 := lResolver.Resolve(TypeInfo(IServiceA)); + var l11 := lResolver.Resolve(TypeInfo(IServiceA)); + Assert.AreEqual(l10, l11); + Assert.AreEqual(l0, l10); + Assert.AreEqual(l1, l11); +end; + procedure TTestContainer.TestTransient; begin var lCont := NewMVCServiceContainer; @@ -206,6 +274,27 @@ begin Assert.AreNotEqual(l2, l3); end; +procedure TTestContainer.TestTransientWithDelegate; +begin + var lCont := NewMVCServiceContainer; + lCont.RegisterType(function : TInterfacedObject + begin + Result := TServiceA.Create + end, IServiceA); + lCont.RegisterType(function : TInterfacedObject + begin + Result := TServiceA.Create + end, IServiceA, TRegistrationType.Transient, 'Svc1'); + lCont.Build; + var lResolver := NewServiceContainerResolver(lCont); + var l0 := lResolver.Resolve(TypeInfo(IServiceA)); + var l1 := lResolver.Resolve(TypeInfo(IServiceA)); + Assert.AreNotEqual(l0, l1); + var l2 := lResolver.Resolve(TypeInfo(IServiceA), 'Svc1'); + var l3 := lResolver.Resolve(TypeInfo(IServiceA), 'Svc1'); + Assert.AreNotEqual(l2, l3); +end; + procedure TTestContainer.TestUnknownService; begin var lCont := NewMVCServiceContainer;