From 862f31a1ce38d4495cef47c5b0dac5e78102373e Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Wed, 8 Feb 2017 11:42:05 +0100 Subject: [PATCH] Added 'Renderer' in TMVCController --- sources/MVCFramework.Patches.pas | 7 +++ sources/MVCFramework.Serializer.Commons.pas | 43 ++++++++++++++++++- sources/MVCFramework.Serializer.JSON.pas | 18 +++++--- sources/MVCFramework.pas | 24 +++++++---- .../Several/SerializationFrameworkTestsU.pas | 4 +- unittests/TestServer/TestServer.dpr | 7 ++- unittests/TestServer/TestServer.dproj | 25 ++++++----- 7 files changed, 98 insertions(+), 30 deletions(-) diff --git a/sources/MVCFramework.Patches.pas b/sources/MVCFramework.Patches.pas index 8128b07e..2ddf46af 100644 --- a/sources/MVCFramework.Patches.pas +++ b/sources/MVCFramework.Patches.pas @@ -45,8 +45,10 @@ uses type TJSONValueHelper = class helper for TJSONValue public + function GetItem(const Index: Integer): TJSONValue; function ToJSON: String; function Count: Integer; + property Items[const Index: Integer]: TJSONValue read GetItem; end; {$ENDIF} @@ -62,6 +64,11 @@ begin Result := Size; end; +function TJSONValueHelper.GetItem(const Index: Integer): TJSONValue; +begin + Result := Get(Index); +end; + function TJSONValueHelper.ToJSON: String; begin Result := Self.ToString; diff --git a/sources/MVCFramework.Serializer.Commons.pas b/sources/MVCFramework.Serializer.Commons.pas index 0e5cb6de..4f13cef4 100644 --- a/sources/MVCFramework.Serializer.Commons.pas +++ b/sources/MVCFramework.Serializer.Commons.pas @@ -3,7 +3,7 @@ unit MVCFramework.Serializer.Commons; interface uses - System.Rtti, System.Classes, System.SysUtils; + System.Rtti, System.Classes, System.SysUtils, System.Generics.Collections, MVCFramework.Serializer.Intf; type TSerializerHelpers = class sealed @@ -33,6 +33,17 @@ type end; + TMVCSerUnSerRegistry = class sealed + strict private + class var SStorage: TDictionary; + public + class function GetSerUnSer(aContentType: String): IMVCSerUnSer; + class procedure RegisterSerializer(aContentType: string; aMVCSerUnSer: IMVCSerUnSer); + class procedure UnRegisterSerializer(aContentType: string); + class constructor Create; + class destructor Destroy; + end; + implementation uses @@ -193,4 +204,34 @@ begin end; end; +{ TMVCSerUnSerRegistry } + +class constructor TMVCSerUnSerRegistry.Create; +begin + SStorage := TDictionary.Create; +end; + +class destructor TMVCSerUnSerRegistry.Destroy; +begin + SStorage.Free; +end; + +class function TMVCSerUnSerRegistry.GetSerUnSer( + aContentType: String): IMVCSerUnSer; +begin + if not SStorage.TryGetValue(aContentType, Result) then + raise EMVCSerializationException.CreateFmt('Cannot find a suitable serializer for %s', [aContentType]); +end; + +class procedure TMVCSerUnSerRegistry.RegisterSerializer(aContentType: string; + aMVCSerUnSer: IMVCSerUnSer); +begin + TMVCSerUnSerRegistry.SStorage.Add(aContentType, aMVCSerUnSer); +end; + +class procedure TMVCSerUnSerRegistry.UnRegisterSerializer(aContentType: string); +begin + TMVCSerUnSerRegistry.SStorage.Remove(aContentType); +end; + end. diff --git a/sources/MVCFramework.Serializer.JSON.pas b/sources/MVCFramework.Serializer.JSON.pas index 400d2c4e..b335329e 100644 --- a/sources/MVCFramework.Serializer.JSON.pas +++ b/sources/MVCFramework.Serializer.JSON.pas @@ -233,7 +233,7 @@ begin for I := 0 to Arr.Count - 1 do begin list.Add(Mapper.JSONObjectToObject(cref, - Arr.Get(I) as TJSONObject)); + Arr.Items[I] as TJSONObject)); end; end else // Ezequiel J. Müller convert regular list @@ -248,11 +248,11 @@ begin for ListParam in ListMethod.GetParameters do case ListParam.ParamType.TypeKind of tkInteger, tkInt64: - ListItem := StrToIntDef(Arr.Get(I).Value, 0); + ListItem := StrToIntDef(Arr.Items[I].Value, 0); tkFloat: - ListItem := TJSONNumber(Arr.Get(I).Value).AsDouble; + ListItem := TJSONNumber(Arr.Items[I].Value).AsDouble; tkString, tkLString, tkWString, tkUString: - ListItem := Arr.Get(I).Value; + ListItem := Arr.Items[I].Value; end; if not ListItem.IsEmpty then @@ -597,7 +597,7 @@ begin lJArr := TJSONArray(lJValue); for I := 0 to lJArr.Count - 1 do begin - AList.Add(JSONObjectToObject(AClazz, lJArr.Get(I) as TJSONObject)); + AList.Add(JSONObjectToObject(AClazz, lJArr.Items[I] as TJSONObject)); end; finally lJValue.Free; @@ -637,4 +637,12 @@ begin end; end; +initialization + +TMVCSerUnSerRegistry.RegisterSerializer('application/json', TMVCJSONSerUnSer.Create); + +finalization + +TMVCSerUnSerRegistry.UnRegisterSerializer('application/json'); + end. diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index 4325ff4b..32614223 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -65,7 +65,7 @@ uses , ReqMulti {Delphi XE4 (all update) and XE5 (with no update) dont contains this unit. Look for the bug in QC} , LoggerPro , MVCFramework.DuckTyping - , MVCFramework.Patches; + , MVCFramework.Patches, MVCFramework.Serializer.Intf; type TDMVCSerializationType = TSerializationType; @@ -348,6 +348,7 @@ type FContext: TWebContext; FResponseStream: TStringBuilder; FContentCharset: string; + FRenderer: IMVCSerUnSer; procedure SetContext(const Value: TWebContext); procedure SetWebSession(const Value: TWebSession); procedure SetContentType(const Value: string); @@ -355,11 +356,7 @@ type function GetWebSession: TWebSession; function GetContentCharset: string; procedure SetContentCharset(const Value: string); - // procedure Render(ACollection: TObjectList; AInstanceOwner: boolean; - // AJSONObjectActionProc: TJSONObjectActionProc; ASerializationType: TSerializationType); overload; - // procedure Render(ACollection: TObjectList; AInstanceOwner: boolean; - // AJSONObjectActionProc: TJSONObjectActionProc; ASerializationType: TSerializationType); - + function GetRenderer: IMVCSerUnSer; protected const CLIENTID_KEY = '__clientid'; protected @@ -463,7 +460,7 @@ type property Config: TMVCConfig read GetMVCConfig; property StatusCode: UInt16 read GetStatusCode write SetStatusCode; - + property Renderer: IMVCSerUnSer read GetRenderer; public // property ViewCache: TViewCache read FViewCache write SetViewCache; procedure PushJSONToView(const AModelName: string; AModel: TJSONValue); @@ -650,7 +647,7 @@ uses IdHTTPWebBrokerBridge, MVCFramework.MessagingController, Web.WebReq, - MVCFramework.SysControllers; + MVCFramework.SysControllers, MVCFramework.Serializer.Commons; const ALLOWED_TYPED_ACTION_PARAMETERS_TYPES = @@ -1268,7 +1265,7 @@ begin IsExpired := true; if List.TryGetValue(ASessionID, Result) then begin - // spinettaro sessiontimeout -- if a session cookie has been choosed the inactivity time is 60 minutes + // spinettaro sessiontimeout -- if a session cookie has been choosed the inactivity time is 60 minutes if ASessionTimeout = 0 then IsExpired := MinutesBetween(Now, Result.LastAccess) > DEFAULT_SESSION_INACTIVITY else @@ -1994,6 +1991,15 @@ begin end; end; +function TMVCController.GetRenderer: IMVCSerUnSer; +begin + if FRenderer = nil then + begin + FRenderer := TMVCSerUnSerRegistry.GetSerUnSer(ContentType); + end; + Result := FRenderer; +end; + function TMVCController.GetWebSession: TWebSession; begin Result := FContext.Session; diff --git a/unittests/Several/SerializationFrameworkTestsU.pas b/unittests/Several/SerializationFrameworkTestsU.pas index 4f30cdd6..554a8dcd 100644 --- a/unittests/Several/SerializationFrameworkTestsU.pas +++ b/unittests/Several/SerializationFrameworkTestsU.pas @@ -37,7 +37,7 @@ uses type TTestJSONSerializer = class(TMVCSerUnSerTestCase) protected - procedure Setup; override; + procedure SetUp; override; published procedure TestSerUnSerObject; override; procedure TestSerUnSerObjectList; override; @@ -52,7 +52,7 @@ uses BOs, MVCFramework.Serializer.JSON, MVCFramework.DuckTyping; { TTestJSONSerializer } -procedure TTestJSONSerializer.Setup; +procedure TTestJSONSerializer.SetUp; begin SetSerUnSer(TMVCJSONSerUnSer.Create); end; diff --git a/unittests/TestServer/TestServer.dpr b/unittests/TestServer/TestServer.dpr index 22a6562f..791f7335 100644 --- a/unittests/TestServer/TestServer.dpr +++ b/unittests/TestServer/TestServer.dpr @@ -9,7 +9,7 @@ uses IdHTTPWebBrokerBridge, Web.WebReq, Web.WebBroker, - WebModuleUnit in 'WebModuleUnit.pas' {bas: TWebModule} , + WebModuleUnit in 'WebModuleUnit.pas' {bas: TWebModule}, TestServerControllerU in 'TestServerControllerU.pas', BusinessObjectsU in '..\..\samples\commons\BusinessObjectsU.pas', TestServerControllerExceptionU in 'TestServerControllerExceptionU.pas', @@ -36,7 +36,10 @@ uses TestServerControllerPrivateU in 'TestServerControllerPrivateU.pas', AuthHandlersU in 'AuthHandlersU.pas', MVCFramework.Patches in '..\..\sources\MVCFramework.Patches.pas', - ObjectsMappers in '..\..\sources\ObjectsMappers.pas'; + ObjectsMappers in '..\..\sources\ObjectsMappers.pas', + MVCFramework.Serializer.Commons in '..\..\sources\MVCFramework.Serializer.Commons.pas', + MVCFramework.Serializer.Intf in '..\..\sources\MVCFramework.Serializer.Intf.pas', + MVCFramework.Serializer.JSON in '..\..\sources\MVCFramework.Serializer.JSON.pas'; {$R *.res} diff --git a/unittests/TestServer/TestServer.dproj b/unittests/TestServer/TestServer.dproj index 3b8231c8..d00853c3 100644 --- a/unittests/TestServer/TestServer.dproj +++ b/unittests/TestServer/TestServer.dproj @@ -132,6 +132,9 @@ + + + @@ -215,16 +218,7 @@ true - - - 0 - .dll;.bpl - - - 1 - .dylib - - + Contents\Resources @@ -564,7 +558,16 @@ 1 - + + + 0 + .dll;.bpl + + + 1 + .dylib + +