Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Added delegates to service container service registration

Browse Source
This commit is contained in:
Daniele Teti 2024-09-02 17:48:01 +02:00
parent 5b17a44962
commit 5cdcdf8c92
2 changed files with 170 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
sources/MVCFramework.Container.pas
View File

@ -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;

89
unittests/general/Several/InjectorTestU.pas
View File

@ -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;