Skip to content

Commit

Permalink
Added delegates to service container service registration
Browse files Browse the repository at this point in the history
  • Loading branch information
@danieleteti
danieleteti committed Sep 2, 2024
1 parent 5b17a44 commit 5cdcdf8
Show file tree
Hide file tree
Showing 2 changed files with 170 additions and 11 deletions.
92 changes: 81 additions & 11 deletions sources/MVCFramework.Container.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@ interface

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;
Expand All @@ -22,6 +24,7 @@ TClassOfInterfacedObject = class of TInterfacedObject;
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;

Expand Down Expand Up @@ -54,6 +57,7 @@ TRegistration = class
Clazz: TClassOfInterfacedObject;
RttiType: TRttiType;
Instance: IInterface;
Delegate: TInterfacedObjectFactory;
RegistrationType: TRegistrationType;
end;

Expand All @@ -69,8 +73,10 @@ TMVCServiceContainer = class(TInterfacedObject, IMVCServiceContainer, IMVCServ
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();
Expand Down Expand Up @@ -136,6 +142,14 @@ function TMVCServiceContainer.CreateServiceWithDependencies(
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;
Expand All @@ -160,15 +174,12 @@ function TMVCServiceContainer.RegisterType(const aImplementation: TClassOfInterf
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);
Expand Down Expand Up @@ -196,6 +207,38 @@ function TMVCServiceContainer.RegisterType(const aImplementation: TClassOfInterf
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;
Expand Down Expand Up @@ -262,15 +305,26 @@ function TMVCServiceContainer.ResolveEx(const ServiceContainerResolver: IMVCServ
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;

Expand All @@ -282,8 +336,19 @@ function TMVCServiceContainer.ResolveEx(const ServiceContainerResolver: IMVCServ
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)
Expand All @@ -301,6 +366,11 @@ procedure TMVCServiceContainer.Build;
fBuilt := True;
end;

function DefaultMVCServiceResolver: IMVCServiceContainerResolver;
begin
Result := DefaultMVCServiceContainer as IMVCServiceContainerResolver;
end;

function DefaultMVCServiceContainer: IMVCServiceContainer;
begin
if gDefaultMVCServiceContainer = nil then
Expand Down Expand Up @@ -362,7 +432,7 @@ function TMVCServiceContainerAdapter.Resolve(const aTypeInfo: PTypeInfo; const a

function NewServiceContainerResolver: IMVCServiceContainerResolver;
begin
Result := TMVCServiceContainerAdapter.Create(DefaultMVCServiceContainer);
Result := TMVCServiceContainerAdapter.Create(DefaultMVCServiceContainer);
end;

function NewServiceContainerResolver(Container: IMVCServiceContainer) : IMVCServiceContainerResolver;
Expand Down
89 changes: 89 additions & 0 deletions unittests/general/Several/InjectorTestU.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,10 +45,16 @@ TTestContainer = class
[Test]
procedure TestTransient;
[Test]
procedure TestTransientWithDelegate;
[Test]
procedure TestSingleton;
[Test]
procedure TestSingletonWithDelegate;
[Test]
procedure TestSingletonPerRequest;
[Test]
procedure TestSingletonPerRequestWithDelegate;
[Test]
procedure TestCascadeConstructorInjection;
end;

Expand Down Expand Up @@ -191,6 +197,68 @@ procedure TTestContainer.TestSingletonPerRequest;
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;
Expand All @@ -206,6 +274,27 @@ procedure TTestContainer.TestTransient;
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;
Expand Down

0 comments on commit 5cdcdf8

Please sign in to comment.