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

ServiceContainerDecorator (WIP)

Browse Source
This commit is contained in:
Daniele Teti 2024-03-28 16:31:44 +01:00
parent 9035aed2e7
commit 1920249eb9
4 changed files with 83 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
samples/services_injection/services_injection.dpr
View File

@ -63,9 +63,6 @@ begin
LogI('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
dotEnvConfigure(
function: IMVCDotEnv
begin
@ -75,14 +72,12 @@ begin
begin
LogD('dotEnv: ' + LogItem);
end)
.Build(); //uses the executable folder to look for .env* files
.Build();
end);
DefaultServiceContainer.RegisterType(TPeopleService, IPeopleService);
DefaultServiceContainer.RegisterType(TConnectionService, IConnectionService);
DefaultServiceContainer.Build();
WebRequestHandlerProc.MaxConnections := dotEnv.Env('dmvc.handler.max_connections', 1024);
DefaultMVCServiceContainer.RegisterType(TPeopleService, IPeopleService);
DefaultMVCServiceContainer.RegisterType(TConnectionService, IConnectionService);
DefaultMVCServiceContainer.Build();
if dotEnv.Env('dmvc.profiler.enabled', false) then
begin
@ -90,6 +85,10 @@ begin
Profiler.WarningThreshold := dotEnv.Env('dmvc.profiler.warning_threshold', 2000);
end;
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
WebRequestHandlerProc.MaxConnections := dotEnv.Env('dmvc.handler.max_connections', 1024);
RunServer(dotEnv.Env('dmvc.server.port', 8080));
except
on E: Exception do

6
sources/MVCFramework.Commons.pas
View File

@ -43,7 +43,7 @@ uses
System.Generics.Collections,
MVCFramework.DuckTyping,
JsonDataObjects,
MVCFramework.DotEnv;
MVCFramework.DotEnv, MVCFramework.Container;
{$I dmvcframeworkbuildconsts.inc}
@ -767,7 +767,6 @@ type
function dotEnv: IMVCDotEnv; overload;
procedure dotEnvConfigure(const dotEnvDelegate: TFunc<IMVCDotEnv>);
implementation
uses
@ -777,7 +776,7 @@ uses
MVCFramework.Serializer.JsonDataObjects,
MVCFramework.Serializer.Commons,
MVCFramework.Utils,
System.RegularExpressions, MVCFramework.Container;
System.RegularExpressions;
var
GlobalAppName, GlobalAppPath, GlobalAppExe: string;
@ -1767,6 +1766,7 @@ begin
Result := ReasonStringByHTTPStatusCode(HTTPStatusCode);
end;
procedure dotEnvConfigure(const dotEnvDelegate: TFunc<IMVCDotEnv>);
begin
if GdotEnv <> nil then

77
sources/MVCFramework.Container.pas
View File

@ -8,14 +8,20 @@ uses
type
TClassOfInterfacedObject = class of TInterfacedObject;
TRegistrationType = (rtTransient, rtSingleton {, rtSingletonPerThread});
TRegistrationType = (rtTransient, rtSingleton, rtSingletonPerRequest);
IMVCServiceContainer = interface
['{1BB3F4A8-DDA1-4526-981C-A0BF877CFFD5}']
function RegisterType(const aImplementation: TClassOfInterfacedObject; const aInterface: TGUID; const aName : string = ''; const aRegType: TRegistrationType = rtTransient): IMVCServiceContainer; overload;
function Resolve(const aTypeInfo: PTypeInfo; const aName: string = ''): IInterface;
function Re vsolve(const aTypeInfo: PTypeInfo; const aName: string = ''): IInterface;
procedure Build();
end;
IMVCServiceContainerEx = interface
['{2C920EC2-001F-40BE-9911-43A65077CADD}']
function ResolveEx(const aTypeInfo: PTypeInfo; const aName: string; out ServiceKey: String; out RegType: TRegistrationType): IInterface; overload;
end;
MVCInjectAttribute = class(TCustomAttribute)
private
fServiceName: String;
@ -30,7 +36,7 @@ type
EMVCContainerErrorUnknownConstructor = class(EMVCContainerError) end;
function DefaultServiceContainer: IMVCServiceContainer;
function DefaultMVCServiceContainer: IMVCServiceContainer;
implementation
@ -52,7 +58,7 @@ type
function CreateServiceWithDependencies(const ServiceClass: TClassOfInterfacedObject;
const ConstructorMethod: TRttiMethod): TInterfacedObject;
protected
function GetKey(const aGUID: TGUID; const aName: String): String;
class function GetKey(const aGUID: TGUID; const aName: String): String;
constructor Create; virtual;
destructor Destroy; override;
class var fInstance: IMVCServiceContainer;
@ -64,9 +70,15 @@ type
function RegisterType(const aImplementation: TClassOfInterfacedObject; const aInterface: TGUID; const aName : string = ''; const aRegType: TRegistrationType = rtTransient): IMVCServiceContainer; overload;
function Resolve<TIntf: IInterface>(const aName: string = ''): TIntf; overload;
function Resolve(const aTypeInfo: PTypeInfo; const aName: string = ''): IInterface; overload;
function ResolveEx(const aTypeInfo: PTypeInfo; const aName: string; out ServiceKey: String; out RegType: TRegistrationType): IInterface; overload;
procedure Build();
end;
TMVCServiceContainerAdapter = class(TInterfacedObject, IMVCServiceContainerEx)
protected
function ResolveEx(const aTypeInfo: PTypeInfo; const aName: string; out ServiceKey: string; out RegType: TRegistrationType): IInterface;
end;
{ TMVCServiceContainer }
function TMVCServiceContainer.CreateServiceWithDependencies(const ServiceClass: TClassOfInterfacedObject;
@ -124,7 +136,7 @@ begin
fInstance := nil;
end;
function TMVCServiceContainer.GetKey(const aGUID: TGUID; const aName: String): String;
class function TMVCServiceContainer.GetKey(const aGUID: TGUID; const aName: String): String;
begin
Result := aGUID.ToString + '_' + aName;
end;
@ -219,6 +231,59 @@ begin
Result := Resolve(TypeInfo(TIntf), aName);
end;
function TMVCServiceContainer.ResolveEx(const aTypeInfo: PTypeInfo; const aName: string;
out ServiceKey: String; out RegType: TRegistrationType): IInterface;
var
lReg: TRegistration;
lTypeInfo: PTypeInfo;
lType: TRttiType;
lService: TObject;
lServiceKey: string;
begin
if not fBuilt then
begin
raise EMVCContainerError.Create('Container has not been built');
end;
lTypeInfo := aTypeInfo;
lServiceKey := GetKey(lTypeInfo.TypeData.GUID, aName);
if not fRegistry.TryGetValue(lServiceKey, lReg) then
begin
raise EMVCContainerErrorUnknownService.CreateFmt('Unknown service "%s" with name "%s"', [lTypeInfo.Name, aName])
end;
lType := lReg.RttiType;
RegType := lReg.RegistrationType;
ServiceKey := lServiceKey;
case lReg.RegistrationType of
rtTransient, rtSingletonPerRequest:
begin
lService := CreateServiceWithDependencies(lReg.Clazz, TRttiUtils.GetFirstDeclaredConstructor(lType));
Supports(lService, lTypeInfo.TypeData.GUID, Result);
{rtSingletonPerRequest is destroyed by the adapter owned by Context}
end;
rtSingleton:
begin
if lReg.Instance = nil then
begin
TMonitor.Enter(Self);
try
if lReg.Instance = nil then
begin
lService := CreateServiceWithDependencies(lReg.Clazz, TRttiUtils.GetFirstDeclaredConstructor(lType));
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;
procedure TMVCServiceContainer.Build;
begin
fBuilt := True;
@ -229,7 +294,7 @@ begin
fInstance := TMVCServiceContainer.Create;
end;
function DefaultServiceContainer: IMVCServiceContainer;
function DefaultMVCServiceContainer: IMVCServiceContainer;
begin
Result := TMVCServiceContainer.fInstance;
end;

2
sources/MVCFramework.pas
View File

@ -2494,7 +2494,7 @@ begin
FSerializers := TDictionary<string, IMVCSerializer>.Create;
FMiddlewares := TList<IMVCMiddleware>.Create;
FControllers := TObjectList<TMVCControllerDelegate>.Create(True);
fServiceContainer := DefaultServiceContainer;
fServiceContainer := DefaultMVCServiceContainer;
FApplicationSession := nil;
FSavedOnBeforeDispatch := nil;
WebRequestHandler.CacheConnections := True;