ServiceContainerDecorator (WIP)

samples/services_injection/services_injection.dpr

@@ -63,9 +63,6 @@ begin
 
   LogI('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
   try
-    if WebRequestHandler <> nil then
-      WebRequestHandler.WebModuleClass := WebModuleClass;
-
     dotEnvConfigure(
       function: IMVCDotEnv
       begin
@@ -75,21 +72,23 @@ 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
       Profiler.ProfileLogger := Log;
       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

sources/MVCFramework.Commons.pas

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

sources/MVCFramework.Container.pas

@@ -8,14 +8,20 @@ interface
 
 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 @@   EMVCContainerErrorInterfaceNotSupported = class(EMVCContainerError) end;
   EMVCContainerErrorUnknownConstructor = class(EMVCContainerError) end;
 
 
-  function DefaultServiceContainer: IMVCServiceContainer;
+  function DefaultMVCServiceContainer: IMVCServiceContainer;
 
 implementation
 
@@ -52,7 +58,7 @@   TMVCServiceContainer = class(TInterfacedObject, IMVCServiceContainer)
     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 @@   TMVCServiceContainer = class(TInterfacedObject, IMVCServiceContainer)
     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 @@ destructor TMVCServiceContainer.Destroy;
   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 @@ function TMVCServiceContainer.Resolve<TIntf>(const aName: string): TIntf;
   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 @@ procedure TMVCServiceContainer.Build;
   fInstance := TMVCServiceContainer.Create;
 end;
 
-function DefaultServiceContainer: IMVCServiceContainer;
+function DefaultMVCServiceContainer: IMVCServiceContainer;
 begin
   Result := TMVCServiceContainer.fInstance;
 end;

sources/MVCFramework.pas

@@ -2494,7 +2494,7 @@ constructor TMVCEngine.Create(const AWebModule: TWebModule; const AConfigAction:
   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;