From beb059a0e318a28d22cc7d96f8142ffceb346ef7 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Fri, 8 Mar 2019 09:33:41 +0100 Subject: [PATCH] Improved support for HATEOAS in renders --- README.md | 10 ++ samples/renders/CustomTypesSerializersU.pas | 15 ++- samples/renders/RenderSampleControllerU.pas | 47 ++++++- sources/MVCFramework.Commons.pas | 7 +- sources/MVCFramework.Serializer.Commons.pas | 42 ++++--- sources/MVCFramework.Serializer.Intf.pas | 12 +- ...Serializer.JsonDataObjects.CustomTypes.pas | 108 +++++----------- ...VCFramework.Serializer.JsonDataObjects.pas | 115 +++++++++++++++--- sources/MVCFramework.pas | 36 ++++-- .../general/Several/DMVCFrameworkTests.dpr | 16 +-- .../general/Several/DMVCFrameworkTests.dproj | 26 ++-- unittests/general/Several/LiveServerTestU.pas | 30 ++++- .../TestServer/TestServerControllerU.pas | 16 ++- 13 files changed, 326 insertions(+), 154 deletions(-) diff --git a/README.md b/README.md index de2fd3aeb..c0bf01a5d 100644 --- a/README.md +++ b/README.md @@ -66,6 +66,16 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma ### DelphiMVCFramework 3.1.1-beryllium (currently in `RC` phase) - New! Added SQLGenerator and RQL compiler for PostgreSQL (in addition to MySQL, MariaDB, Firebird and Interbase) +- Improved! Greatly improved support for [HATEOAS](https://en.wikipedia.org/wiki/HATEOAS) in renders. Check `TRenderSampleController.GetPeople_AsObjectList_HATEOS` in `renders.dproj` sample) +```delphi + //Now is really easy to add "_links" property automatically for each collection element while rendering + Render(People, True, + procedure(const Person: TPerson; const Dict: TMVCStringDictionary) + begin + Dict['x-ref'] := '/api/people/' + Person.ID; + Dict['x-child-ref'] := '/api/people/' + Person.ID + '/child'; + end); +``` - Better packages organization (check `packages` folder) - New! `TMVCActiveRecord.Count` method (e.g. `TMVCActiveRecord.Count(TCustomer)` returns the number of records for the entity mapped by the class `TCustomer`) - Change! `TMVCACtiveRecord.GetByPK` raises an exception if the record is not found diff --git a/samples/renders/CustomTypesSerializersU.pas b/samples/renders/CustomTypesSerializersU.pas index 41a7c67b9..5401c6032 100644 --- a/samples/renders/CustomTypesSerializersU.pas +++ b/samples/renders/CustomTypesSerializersU.pas @@ -30,7 +30,7 @@ interface uses MVCFramework.Serializer.Intf, - System.Rtti; + System.Rtti, MVCFramework.Serializer.Commons; type // Custom serializer for TUserRoles type @@ -43,7 +43,8 @@ TUserRolesSerializer = class(TInterfacedObject, IMVCTypeSerializer) procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string; const ASerializerObject: TObject; const AAttributes: System.TArray); procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; - const AAttributes: System.TArray); + const AAttributes: System.TArray; + const ASerializationAction: TMVCSerializationAction = nil); procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string; const ASerializerObject: TObject; const AAttributes: System.TArray); procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject; @@ -60,7 +61,8 @@ TNullableAliasSerializer = class(TInterfacedObject, IMVCTypeSerializer) procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string; const ASerializerObject: TObject; const AAttributes: System.TArray); procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; - const AAttributes: System.TArray); + const AAttributes: System.TArray; + const ASerializationAction: TMVCSerializationAction); procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string; const ASerializerObject: TObject; const AAttributes: System.TArray); procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject; @@ -71,7 +73,7 @@ implementation uses JsonDataObjects, CustomTypesU, MVCFramework.Serializer.JsonDataObjects, - System.SysUtils, MVCFramework.Serializer.Commons; + System.SysUtils; { TUserPasswordSerializer } @@ -145,13 +147,14 @@ procedure TNullableAliasSerializer.SerializeAttribute(const AElementValue: TValu end; procedure TNullableAliasSerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; - const AAttributes: System.TArray); + const AAttributes: System.TArray; + const ASerializationAction: TMVCSerializationAction); begin raise EMVCSerializationException.CreateFmt('%s cannot be used as root object', [ClassName]); end; procedure TUserRolesSerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; - const AAttributes: System.TArray); + const AAttributes: System.TArray; const ASerializationAction: TMVCSerializationAction = nil); begin raise EMVCSerializationException.CreateFmt('%s cannot be used as root object', [ClassName]); end; diff --git a/samples/renders/RenderSampleControllerU.pas b/samples/renders/RenderSampleControllerU.pas index 25a9a9b5e..d7cd605f4 100644 --- a/samples/renders/RenderSampleControllerU.pas +++ b/samples/renders/RenderSampleControllerU.pas @@ -66,6 +66,11 @@ TRenderSampleController = class(TMVCController) [MVCProduces('application/json')] procedure GetPeople_AsObjectList; + [MVCHTTPMethod([httpGET])] + [MVCPath('/people/hateos')] + [MVCProduces('application/json')] + procedure GetPeople_AsObjectList_HATEOS; + [MVCHTTPMethod([httpGET])] [MVCPath('/people/withtiming')] [MVCProduces('application/json')] @@ -253,8 +258,8 @@ procedure TRenderSampleController.GetDataSetWithMetadata; try lDM.qryCustomers.Open; lHolder := TDataSetHolder.Create(lDM.qryCustomers); - lHolder.Metadata.AddProperty('page', '1'); - lHolder.Metadata.AddProperty('count', lDM.qryCustomers.RecordCount.ToString); + lHolder.Metadata.Add('page', '1'); + lHolder.Metadata.Add('count', lDM.qryCustomers.RecordCount.ToString); Render(lHolder); finally lDM.Free; @@ -419,6 +424,44 @@ procedure TRenderSampleController.GetPeople_AsObjectList; Render(People); end; +procedure TRenderSampleController.GetPeople_AsObjectList_HATEOS; +var + p: TPerson; + People: TObjectList; +begin + People := TObjectList.Create(True); + +{$REGION 'Fake data'} + p := TPerson.Create; + p.FirstName := 'Daniele'; + p.LastName := 'Teti'; + p.DOB := EncodeDate(1979, 11, 4); + p.Married := True; + People.Add(p); + + p := TPerson.Create; + p.FirstName := 'John'; + p.LastName := 'Doe'; + p.DOB := EncodeDate(1879, 10, 2); + p.Married := False; + People.Add(p); + + p := TPerson.Create; + p.FirstName := 'Jane'; + p.LastName := 'Doe'; + p.DOB := EncodeDate(1883, 1, 5); + p.Married := True; + People.Add(p); + +{$ENDREGION} + Render(People, True, + procedure(const APerson: TPerson; const Dict: TMVCStringDictionary) + begin + Dict['ref'] := '/api/people/' + APerson.LastName; + Dict['x-ref'] := '/api/people/' + APerson.LastName; + end); +end; + procedure TRenderSampleController.GetPersonJSON; var p: TJSONObject; diff --git a/sources/MVCFramework.Commons.pas b/sources/MVCFramework.Commons.pas index 95e695c81..4d1c61826 100644 --- a/sources/MVCFramework.Commons.pas +++ b/sources/MVCFramework.Commons.pas @@ -133,6 +133,7 @@ TMVCConfigKey = record FallbackResource = 'fallback_resource'; MaxEntitiesRecordCount = 'max_entities_record_count'; MaxRequestSize = 'max_request_size'; // bytes + HATEOSPropertyName = 'hateos'; end; // http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html @@ -354,7 +355,7 @@ TMVCStringDictionary = class constructor Create; virtual; destructor Destroy; override; procedure Clear; - function AddProperty(const Name, Value: string): TMVCStringDictionary; + function Add(const Name, Value: string): TMVCStringDictionary; function TryGetValue(const Name: string; out Value: string): Boolean; overload; function TryGetValue(const Name: string; out Value: Integer): Boolean; overload; function Count: Integer; @@ -732,7 +733,7 @@ procedure TMVCConfig.SaveToFile(const AFileName: string); procedure TMVCConfig.SetValue(const AIndex, AValue: string); begin - FConfig.AddProperty(AIndex, AValue); + FConfig.Add(AIndex, AValue); end; function TMVCConfig.ToString: string; @@ -749,7 +750,7 @@ function TMVCConfig.ToString: string; { TMVCStringDictionary } -function TMVCStringDictionary.AddProperty(const Name, Value: string): TMVCStringDictionary; +function TMVCStringDictionary.Add(const Name, Value: string): TMVCStringDictionary; begin FDict.AddOrSetValue(name, Value); Result := Self; diff --git a/sources/MVCFramework.Serializer.Commons.pas b/sources/MVCFramework.Serializer.Commons.pas index dae4b229e..2e2127401 100644 --- a/sources/MVCFramework.Serializer.Commons.pas +++ b/sources/MVCFramework.Serializer.Commons.pas @@ -59,7 +59,8 @@ interface TMVCIgnoredList = array of string; - TMVCSerializationAction = TProc; + TMVCSerializationAction = reference to procedure(const AObject: T; const ADictionary: TMVCStringDictionary); + TMVCSerializationAction = reference to procedure(const AObject: TObject; const ADictionary: TMVCStringDictionary); EMVCSerializationException = class(EMVCException) end; @@ -173,11 +174,13 @@ TMVCSerializerHelper = record class function GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; overload; static; class function HasAttribute(const AMember: TRttiNamedObject): boolean; overload; static; - class function HasAttribute(const AMember: TRttiNamedObject; out AAttribute: T): boolean; overload; static; + class function HasAttribute(const AMember: TRttiNamedObject; out AAttribute: T): boolean; + overload; static; - class function AttributeExists(const AAttributes: TArray; out AAttribute: T): boolean; + class function AttributeExists(const AAttributes: TArray; out AAttribute: T) + : boolean; overload; static; + class function AttributeExists(const AAttributes: TArray): boolean; overload; static; - class function AttributeExists(const AAttributes: TArray): boolean; overload; static; class procedure EncodeStream(AInput, AOutput: TStream); static; class procedure DecodeStream(AInput, AOutput: TStream); static; @@ -185,7 +188,8 @@ TMVCSerializerHelper = record class function EncodeString(const AInput: string): string; static; class function DecodeString(const AInput: string): string; static; - class procedure DeSerializeStringStream(AStream: TStream; const ASerializedString: string; const AEncoding: string); static; + class procedure DeSerializeStringStream(AStream: TStream; const ASerializedString: string; + const AEncoding: string); static; class procedure DeSerializeBase64StringStream(AStream: TStream; const ABase64SerializedString: string); static; class function GetTypeKindAsString(const ATypeKind: TTypeKind): string; static; @@ -197,6 +201,8 @@ TMVCSerializerHelper = record class function IsAPropertyToSkip(const aPropName: string): boolean; static; end; + TMVCLinksCallback = reference to procedure(const Links: TMVCStringDictionary); + function DateTimeToISOTimeStamp(const ADateTime: TDateTime): string; function DateToISODate(const ADate: TDateTime): string; function TimeToISOTime(const ATime: TTime): string; @@ -242,7 +248,8 @@ function ISOTimeStampToDateTime(const ADateTime: string): TDateTime; begin lDateTime := ADateTime; if lDateTime.Length < 19 then - raise Exception.CreateFmt('Invalid parameter "%s". Hint: DateTime parameters must be formatted in ISO8601 (e.g. 2010-10-12T10:12:23)', + raise Exception.CreateFmt + ('Invalid parameter "%s". Hint: DateTime parameters must be formatted in ISO8601 (e.g. 2010-10-12T10:12:23)', [ADateTime]); if lDateTime.Chars[10] = ' ' then @@ -266,8 +273,8 @@ function ISOTimeToTime(const ATime: string): TTime; { TMVCSerializerHelper } -class procedure TMVCSerializerHelper.DeSerializeBase64StringStream( - AStream: TStream; const ABase64SerializedString: string); +class procedure TMVCSerializerHelper.DeSerializeBase64StringStream(AStream: TStream; + const ABase64SerializedString: string); var SS: TStringStream; begin @@ -281,7 +288,8 @@ class procedure TMVCSerializerHelper.DeSerializeBase64StringStream( end; end; -class procedure TMVCSerializerHelper.DeSerializeStringStream(AStream: TStream; const ASerializedString: string; const AEncoding: string); +class procedure TMVCSerializerHelper.DeSerializeStringStream(AStream: TStream; const ASerializedString: string; + const AEncoding: string); var Encoding: TEncoding; SS: TStringStream; @@ -326,7 +334,8 @@ class function TMVCSerializerHelper.GetKeyName(const AField: TRttiField; const A end; end; -class function TMVCSerializerHelper.AttributeExists(const AAttributes: TArray; out AAttribute: T): boolean; +class function TMVCSerializerHelper.AttributeExists(const AAttributes: TArray; + out AAttribute: T): boolean; var Att: TCustomAttribute; begin @@ -340,8 +349,7 @@ class function TMVCSerializerHelper.AttributeExists(const AAttributes: TArray Result := (AAttribute <> nil); end; -class function TMVCSerializerHelper.AttributeExists( - const AAttributes: TArray): boolean; +class function TMVCSerializerHelper.AttributeExists(const AAttributes: TArray): boolean; var Att: TCustomAttribute; begin @@ -384,7 +392,8 @@ class function TMVCSerializerHelper.CreateObject(const AQualifiedClassName: stri if Assigned(ObjectType) then Result := CreateObject(ObjectType) else - raise Exception.CreateFmt('Cannot find Rtti for %s. Hint: Is the specified classtype linked in the module?', [AQualifiedClassName]); + raise Exception.CreateFmt('Cannot find Rtti for %s. Hint: Is the specified classtype linked in the module?', + [AQualifiedClassName]); finally Context.Free; end; @@ -400,7 +409,6 @@ class procedure TMVCSerializerHelper.DecodeStream(AInput, AOutput: TStream); Soap.EncdDecd.DecodeStream(AInput, AOutput); {$ENDIF} - end; class function TMVCSerializerHelper.DecodeString(const AInput: string): string; @@ -413,7 +421,6 @@ class function TMVCSerializerHelper.DecodeString(const AInput: string): string; Result := Soap.EncdDecd.DecodeString(AInput); {$ENDIF} - end; class procedure TMVCSerializerHelper.EncodeStream(AInput, AOutput: TStream); @@ -426,7 +433,6 @@ class procedure TMVCSerializerHelper.EncodeStream(AInput, AOutput: TStream); Soap.EncdDecd.EncodeStream(AInput, AOutput); {$ENDIF} - end; class function TMVCSerializerHelper.EncodeString(const AInput: string): string; @@ -439,7 +445,6 @@ class function TMVCSerializerHelper.EncodeString(const AInput: string): string; Result := Soap.EncdDecd.EncodeString(AInput); {$ENDIF} - end; class function TMVCSerializerHelper.GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; @@ -507,8 +512,7 @@ class function TMVCSerializerHelper.HasAttribute(const AMember: TRttiNamedObj end; end; -class function TMVCSerializerHelper.IsAPropertyToSkip( - const aPropName: string): boolean; +class function TMVCSerializerHelper.IsAPropertyToSkip(const aPropName: string): boolean; begin Result := (aPropName = 'RefCount') or (aPropName = 'Disposed'); end; diff --git a/sources/MVCFramework.Serializer.Intf.pas b/sources/MVCFramework.Serializer.Intf.pas index 1ba9d099e..b16d10e60 100644 --- a/sources/MVCFramework.Serializer.Intf.pas +++ b/sources/MVCFramework.Serializer.Intf.pas @@ -49,7 +49,8 @@ interface procedure SerializeRoot( const AObject: TObject; out ASerializerObject: TObject; - const AAttributes: TArray + const AAttributes: TArray; + const ASerializationAction: TMVCSerializationAction = nil ); procedure DeserializeAttribute( @@ -80,19 +81,22 @@ interface function SerializeCollection( const AList: TObject; const AType: TMVCSerializationType = stDefault; - const AIgnoredAttributes: TMVCIgnoredList = [] + const AIgnoredAttributes: TMVCIgnoredList = []; + const ASerializationAction: TMVCSerializationAction = nil ): string; function SerializeDataSet( const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; - const ANameCase: TMVCNameCase = ncAsIs + const ANameCase: TMVCNameCase = ncAsIs; + const ASerializationAction: TMVCSerializationAction = nil ): string; function SerializeDataSetRecord( const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; - const ANameCase: TMVCNameCase = ncAsIs + const ANameCase: TMVCNameCase = ncAsIs; + const ASerializationAction: TMVCSerializationAction = nil ): string; procedure DeserializeObject( diff --git a/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas b/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas index 9ad45e793..724bbe384 100644 --- a/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas +++ b/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas @@ -43,27 +43,15 @@ TMVCStreamSerializerJsonDataObject = class(TInterfacedObject, IMVCTypeSerializ protected // procedure Serialize(const AElementValue: TValue; var ASerializerObject: TObject; // const AAttributes: TArray); - procedure SerializeAttribute( - const AElementValue: TValue; - const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray - ); - procedure SerializeRoot( - const AObject: TObject; - out ASerializerObject: TObject; - const AAttributes: TArray - ); + procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string; + const ASerializerObject: TObject; const AAttributes: TArray); + procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; + const AAttributes: TArray; const ASerializationAction: TMVCSerializationAction = nil); - procedure DeserializeAttribute( - var AElementValue: TValue; - const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray - ); + procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string; + const ASerializerObject: TObject; const AAttributes: TArray); - procedure DeserializeRoot( - const ASerializerObject: TObject; const AObject: TObject; + procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject; const AAttributes: TArray); public @@ -72,29 +60,15 @@ TMVCStreamSerializerJsonDataObject = class(TInterfacedObject, IMVCTypeSerializ TMVCStringDictionarySerializer = class(TInterfacedObject, IMVCTypeSerializer) public - procedure SerializeAttribute( - const AElementValue: TValue; - const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray - ); - procedure SerializeRoot( - const AObject: TObject; - out ASerializerObject: TObject; - const AAttributes: TArray - ); - procedure DeserializeAttribute( - var AElementValue: TValue; - const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray - ); - - procedure DeserializeRoot( - const ASerializerObject: TObject; - const AObject: TObject; - const AAttributes: TArray - ); + procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string; + const ASerializerObject: TObject; const AAttributes: TArray); + procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; + const AAttributes: TArray; const ASerializationAction: TMVCSerializationAction = nil); + procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string; + const ASerializerObject: TObject; const AAttributes: TArray); + + procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject; + const AAttributes: TArray); end; implementation @@ -106,12 +80,8 @@ implementation System.Generics.Collections, JsonDataObjects; -procedure TMVCStreamSerializerJsonDataObject.DeserializeAttribute( - var AElementValue: TValue; - const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray - ); +procedure TMVCStreamSerializerJsonDataObject.DeserializeAttribute(var AElementValue: TValue; + const APropertyName: string; const ASerializerObject: TObject; const AAttributes: TArray); var lStream: TStream; SS: TStringStream; @@ -142,8 +112,7 @@ procedure TMVCStreamSerializerJsonDataObject.DeserializeAttribute( end; end; -procedure TMVCStreamSerializerJsonDataObject.DeserializeRoot( - const ASerializerObject: TObject; const AObject: TObject; +procedure TMVCStreamSerializerJsonDataObject.DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject; const AAttributes: TArray); var lValue: TValue; @@ -152,10 +121,8 @@ procedure TMVCStreamSerializerJsonDataObject.DeserializeRoot( DeserializeAttribute(lValue, 'data', ASerializerObject, AAttributes); end; -procedure TMVCStreamSerializerJsonDataObject.SerializeAttribute( - const AElementValue: TValue; const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray); +procedure TMVCStreamSerializerJsonDataObject.SerializeAttribute(const AElementValue: TValue; + const APropertyName: string; const ASerializerObject: TObject; const AAttributes: TArray); var Stream: TStream; SS: TStringStream; @@ -185,8 +152,8 @@ procedure TMVCStreamSerializerJsonDataObject.SerializeAttribute( end; end; -procedure TMVCStreamSerializerJsonDataObject.SerializeRoot(const AObject: TObject; - out ASerializerObject: TObject; const AAttributes: TArray); +procedure TMVCStreamSerializerJsonDataObject.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; + const AAttributes: TArray; const ASerializationAction: TMVCSerializationAction = nil); var lSerializerObject: TJsonObject; begin @@ -201,12 +168,8 @@ procedure TMVCStreamSerializerJsonDataObject.SerializeRoot(const AObject: TObjec { TMVCStringDictionarySerializer } -procedure TMVCStringDictionarySerializer.DeserializeAttribute( - var AElementValue: TValue; - const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray - ); +procedure TMVCStringDictionarySerializer.DeserializeAttribute(var AElementValue: TValue; const APropertyName: string; + const ASerializerObject: TObject; const AAttributes: TArray); var lStringDict: TMVCStringDictionary; lJSON: TJDOJsonObject; @@ -216,15 +179,12 @@ procedure TMVCStringDictionarySerializer.DeserializeAttribute( lJSON := ASerializerObject as TJDOJsonObject; for i := 0 to lJSON.O[APropertyName].Count - 1 do begin - lStringDict.AddProperty(lJSON.Names[i], lJSON.S[lJSON.Names[i]]) + lStringDict.Add(lJSON.Names[i], lJSON.S[lJSON.Names[i]]) end; end; -procedure TMVCStringDictionarySerializer.DeserializeRoot( - const ASerializerObject: TObject; - const AObject: TObject; - const AAttributes: TArray - ); +procedure TMVCStringDictionarySerializer.DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject; + const AAttributes: TArray); var lStringDict: TMVCStringDictionary; lJSON: TJDOJsonObject; @@ -234,14 +194,12 @@ procedure TMVCStringDictionarySerializer.DeserializeRoot( lJSON := ASerializerObject as TJDOJsonObject; for i := 0 to lJSON.Count - 1 do begin - lStringDict.AddProperty(lJSON.Names[i], lJSON.S[lJSON.Names[i]]) + lStringDict.Add(lJSON.Names[i], lJSON.S[lJSON.Names[i]]) end; end; -procedure TMVCStringDictionarySerializer.SerializeAttribute( - const AElementValue: TValue; const APropertyName: string; - const ASerializerObject: TObject; - const AAttributes: TArray); +procedure TMVCStringDictionarySerializer.SerializeAttribute(const AElementValue: TValue; const APropertyName: string; + const ASerializerObject: TObject; const AAttributes: TArray); var lStringDict: TMVCStringDictionary; lPair: TPair; @@ -261,8 +219,8 @@ procedure TMVCStringDictionarySerializer.SerializeAttribute( end; end; -procedure TMVCStringDictionarySerializer.SerializeRoot(const AObject: TObject; - out ASerializerObject: TObject; const AAttributes: TArray); +procedure TMVCStringDictionarySerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject; + const AAttributes: TArray; const ASerializationAction: TMVCSerializationAction = nil); var lStringDict: TMVCStringDictionary; lPair: TPair; diff --git a/sources/MVCFramework.Serializer.JsonDataObjects.pas b/sources/MVCFramework.Serializer.JsonDataObjects.pas index ec73efcb5..43bcc2611 100644 --- a/sources/MVCFramework.Serializer.JsonDataObjects.pas +++ b/sources/MVCFramework.Serializer.JsonDataObjects.pas @@ -44,15 +44,22 @@ interface MVCFramework.Serializer.Commons, MVCFramework.DuckTyping, System.JSON, - JsonDataObjects; + JsonDataObjects, MVCFramework.Commons; type TMVCJsonDataObjectsSerializer = class(TMVCAbstractSerializer, IMVCSerializer) + private + fStringDictionarySerializer: IMVCTypeSerializer; public procedure ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); + procedure InternalObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; + const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; + const ASerializationAction: TMVCSerializationAction; const Dict: TMVCStringDictionary; + const Serializer: IMVCTypeSerializer); procedure ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray; - const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); + const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; + const ASerializationAction: TMVCSerializationAction = nil); procedure AttributeToJsonDataValue(const AJsonObject: TJDOJsonObject; const AName: string; const AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); @@ -80,13 +87,14 @@ TMVCJsonDataObjectsSerializer = class(TMVCAbstractSerializer, IMVCSerializer) const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): TJDOJsonObject; function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault; - const AIgnoredAttributes: TMVCIgnoredList = []): string; + const AIgnoredAttributes: TMVCIgnoredList = []; + const ASerializationAction: TMVCSerializationAction = nil): string; function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; - const ANameCase: TMVCNameCase = ncAsIs): string; + const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCSerializationAction = nil): string; function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; - const ANameCase: TMVCNameCase = ncAsIs): string; + const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCSerializationAction = nil): string; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []); @@ -115,7 +123,6 @@ implementation uses MVCFramework.Serializer.JsonDataObjects.CustomTypes, - MVCFramework.Commons, MVCFramework.Logger, System.SysUtils; @@ -131,6 +138,7 @@ procedure TMVCJsonDataObjectsSerializer.AfterConstruction; GetTypeSerializers.Add(TypeInfo(TStringStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TFileStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TMemoryStream), lStreamSerializer); + fStringDictionarySerializer := TMVCStringDictionarySerializer.Create; GetTypeSerializers.Add(TypeInfo(TMVCStringDictionary), TMVCStringDictionarySerializer.Create); end; @@ -228,8 +236,12 @@ procedure TMVCJsonDataObjectsSerializer.AttributeToJsonDataValue(const AJsonObje begin ChildJsonArray := AJsonObject.A[AName]; for Obj in ChildList do + begin if Assigned(Obj) then + begin ObjectToJsonObject(Obj, ChildJsonArray.AddObject, GetSerializationType(Obj, AType), AIgnored); + end; + end; end else begin @@ -810,26 +822,53 @@ procedure TMVCJsonDataObjectsSerializer.JsonObjectToObject(const AJsonObject: TJ end; procedure TMVCJsonDataObjectsSerializer.ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray; - const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); + const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; + const ASerializationAction: TMVCSerializationAction); var I: Integer; + lDict: TMVCStringDictionary; + lSer: IMVCTypeSerializer; begin if not Assigned(AList) then raise EMVCSerializationException.Create('List not assigned'); - for I := 0 to Pred(AList.Count) do + if Assigned(ASerializationAction) then begin - ObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes); + lDict := TMVCStringDictionary.Create; + try + for I := 0 to Pred(AList.Count) do + begin + InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, + ASerializationAction, lDict, lSer); + end; + finally + lDict.Free; + end; + end + else + begin + for I := 0 to Pred(AList.Count) do + begin + InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, nil, nil, nil); + end; end; end; procedure TMVCJsonDataObjectsSerializer.ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); +begin + InternalObjectToJsonObject(AObject, AJsonObject, AType, AIgnoredAttributes, nil, nil, nil); +end; + +procedure TMVCJsonDataObjectsSerializer.InternalObjectToJsonObject(const AObject: TObject; + const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; + const ASerializationAction: TMVCSerializationAction; const Dict: TMVCStringDictionary; + const Serializer: IMVCTypeSerializer); var ObjType: TRttiType; Prop: TRttiProperty; Fld: TRttiField; begin - {TODO -oDanieleT -cGeneral : Find a way to automatically add HATEOS} + { TODO -oDanieleT -cGeneral : Find a way to automatically add HATEOS } ObjType := GetRttiContext.GetType(AObject.ClassType); case AType of stDefault, stProperties: @@ -857,6 +896,13 @@ procedure TMVCJsonDataObjectsSerializer.ObjectToJsonObject(const AObject: TObjec AType, AIgnoredAttributes, Fld.GetAttributes); end; end; + + if Assigned(ASerializationAction) then + begin + Dict.Clear; + ASerializationAction(AObject, Dict); + Serializer.SerializeAttribute(Dict, '_links', AJsonObject, []); + end; end; class function TMVCJsonDataObjectsSerializer.Parse(const AString: string): T; @@ -877,11 +923,13 @@ class function TMVCJsonDataObjectsSerializer.ParseObject(const AString: string): end; function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType; - const AIgnoredAttributes: TMVCIgnoredList): string; + const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var JsonArray: TJDOJsonArray; ObjList: IMVCList; Obj: TObject; + lLinks: TMVCStringDictionary; + lSer: IMVCTypeSerializer; begin Result := EmptyStr; @@ -896,9 +944,28 @@ function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: TObject; begin JsonArray := TJDOJsonArray.Create; try - for Obj in ObjList do + if Assigned(ASerializationAction) then begin - if Assigned(Obj) then + if not GetTypeSerializers.TryGetValue(TypeInfo(TMVCStringDictionary), lSer) then + begin + raise EMVCSerializationException.Create + ('Cannot serialize _links without TMVCStringDictionary custom serializer'); + end; + + lLinks := TMVCStringDictionary.Create; + try + for Obj in ObjList do + begin + InternalObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes, + ASerializationAction, lLinks, lSer); + end; + finally + lLinks.Free; + end; + end + else + begin + for Obj in ObjList do begin ObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes); end; @@ -911,7 +978,7 @@ function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: TObject; end; function TMVCJsonDataObjectsSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; - const ANameCase: TMVCNameCase): string; + const ANameCase: TMVCNameCase; const ASerializationAction: TMVCSerializationAction): string; var JsonArray: TJDOJsonArray; BookMark: TBookmark; @@ -942,7 +1009,8 @@ function TMVCJsonDataObjectsSerializer.SerializeDataSet(const ADataSet: TDataSet end; function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(const ADataSet: TDataSet; - const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase): string; + const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; + const ASerializationAction: TMVCSerializationAction): string; var JsonObject: TJDOJsonObject; begin @@ -965,6 +1033,7 @@ function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: TObject; c var JsonObject: TJDOJsonObject; ObjType: TRttiType; + lDict: TMVCStringDictionary; begin Result := EmptyStr; @@ -995,7 +1064,21 @@ function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: TObject; c JsonObject := TJDOJsonObject.Create; try - ObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), AIgnoredAttributes); + if Assigned(ASerializationAction) then + begin + lDict := TMVCStringDictionary.Create; + try + InternalObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), AIgnoredAttributes, + ASerializationAction, lDict, fStringDictionarySerializer); + finally + lDict.Free; + end; + end + else + begin + InternalObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), AIgnoredAttributes, nil, + nil, nil); + end; Result := JsonObject.ToJSON(True); finally JsonObject.Free; diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index 0eda0e577..ebfce5a8c 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -456,10 +456,12 @@ TMVCRenderer = class(TMVCBase) procedure Render(const AObject: TObject); overload; procedure Render(const AObject: TObject; const AOwns: Boolean); overload; procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType); overload; - procedure Render(const ACollection: TObjectList); overload; - procedure Render(const ACollection: TObjectList; const AOwns: Boolean); overload; + procedure Render(const ACollection: TObjectList; + const ASerializationAction: TMVCSerializationAction = nil); overload; procedure Render(const ACollection: TObjectList; const AOwns: Boolean; - const AType: TMVCSerializationType); overload; + const ASerializationAction: TMVCSerializationAction = nil); overload; + procedure Render(const ACollection: TObjectList; const AOwns: Boolean; + const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction = nil); overload; procedure Render(const ACollection: IMVCList); overload; procedure Render(const ACollection: IMVCList; const AType: TMVCSerializationType); overload; procedure Render(const ADataSet: TDataSet); overload; @@ -1609,6 +1611,7 @@ procedure TMVCEngine.ConfigDefaultValues; Config[TMVCConfigKey.IndexDocument] := 'index.html'; Config[TMVCConfigKey.MaxEntitiesRecordCount] := '20'; Config[TMVCConfigKey.MaxRequestSize] := IntToStr(TMVCConstants.DEFAULT_MAX_REQUEST_SIZE); + Config[TMVCConfigKey.HATEOSPropertyName] := '_links'; FMediaTypes.Add('.html', TMVCMediaType.TEXT_HTML); FMediaTypes.Add('.htm', TMVCMediaType.TEXT_HTML); @@ -2602,9 +2605,10 @@ procedure TMVCRenderer.Render(const AContent: string); end; end; -procedure TMVCRenderer.Render(const ACollection: TObjectList; const AOwns: Boolean); +procedure TMVCRenderer.Render(const ACollection: TObjectList; const AOwns: Boolean; +const ASerializationAction: TMVCSerializationAction); begin - Self.Render(ACollection, AOwns, stDefault); + Self.Render(ACollection, AOwns, stDefault, ASerializationAction); end; procedure TMVCRenderer.ResponseStatus(const AStatusCode: Integer; const AReasonString: string); @@ -2752,12 +2756,25 @@ procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; co end; procedure TMVCRenderer.Render(const ACollection: TObjectList; const AOwns: Boolean; -const AType: TMVCSerializationType); +const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction); +var + lSerializationAction: TMVCSerializationAction; begin if Assigned(ACollection) then begin try - Render(Serializer(GetContentType).SerializeCollection(ACollection, AType)); + if Assigned(ASerializationAction) then + begin + lSerializationAction := procedure(const AObject: TObject; const Dict: TMVCStringDictionary) + begin + ASerializationAction(T(AObject), Dict); + end; + end + else + begin + lSerializationAction := nil; + end; + Render(Serializer(GetContentType).SerializeCollection(ACollection, AType, [], lSerializationAction)); finally if AOwns then ACollection.Free; @@ -2791,9 +2808,10 @@ function TMVCController.GetRenderedView(const AViewNames: TArray): strin end; end; -procedure TMVCRenderer.Render(const ACollection: TObjectList); +procedure TMVCRenderer.Render(const ACollection: TObjectList; +const ASerializationAction: TMVCSerializationAction); begin - Self.Render(ACollection, True); + Self.Render(ACollection, True, ASerializationAction); end; procedure TMVCRenderer.RenderResponseStream; diff --git a/unittests/general/Several/DMVCFrameworkTests.dpr b/unittests/general/Several/DMVCFrameworkTests.dpr index e4148793e..7de111c80 100644 --- a/unittests/general/Several/DMVCFrameworkTests.dpr +++ b/unittests/general/Several/DMVCFrameworkTests.dpr @@ -7,13 +7,13 @@ program DMVCFrameworkTests; uses System.SysUtils, -{$IFDEF GUI_TESTRUNNER} + {$IFDEF GUI_TESTRUNNER} Vcl.Forms, DUnitX.Loggers.GUI.Vcl, -{$ENDIF} -{$IFDEF CONSOLE_TESTRUNNER} + {$ENDIF } + {$IFDEF CONSOLE_TESTRUNNER} DUnitX.Loggers.Console, -{$ENDIF} + {$ENDIF } DUnitX.Loggers.Xml.NUnit, DUnitX.TestFramework, FrameworkTestsU in 'FrameworkTestsU.pas', @@ -22,10 +22,9 @@ uses BOs in 'BOs.pas', TestServerControllerU in '..\TestServer\TestServerControllerU.pas', RESTAdapterTestsU in 'RESTAdapterTestsU.pas', - MVCFramework.Tests.WebModule2 - in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule} , + MVCFramework.Tests.WebModule2 in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule}, MVCFramework.Tests.StandaloneServer in '..\StandaloneServer\MVCFramework.Tests.StandaloneServer.pas', - MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule} , + MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule}, MVCFramework.Tests.RESTClient in '..\RESTClient\MVCFramework.Tests.RESTClient.pas', MVCFramework.Tests.AppController in '..\RESTClient\MVCFramework.Tests.AppController.pas', BusinessObjectsU in '..\..\..\samples\commons\BusinessObjectsU.pas', @@ -35,7 +34,8 @@ uses JSONRPCTestsU in 'JSONRPCTestsU.pas', MVCFramework.JSONRPC in '..\..\..\sources\MVCFramework.JSONRPC.pas', RandomUtilsU in '..\..\..\samples\commons\RandomUtilsU.pas', - MVCFramework.Serializer.JsonDataObjects in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas'; + MVCFramework.Serializer.JsonDataObjects in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas', + JsonDataObjects in '..\..\..\sources\JsonDataObjects.pas'; {$R *.RES} {$IFDEF CONSOLE_TESTRUNNER} diff --git a/unittests/general/Several/DMVCFrameworkTests.dproj b/unittests/general/Several/DMVCFrameworkTests.dproj index 502c2aa92..fcf7e4c75 100644 --- a/unittests/general/Several/DMVCFrameworkTests.dproj +++ b/unittests/general/Several/DMVCFrameworkTests.dproj @@ -144,7 +144,6 @@ _CONSOLE_TESTRUNNER;GUI_TESTRUNNER;$(DCC_Define) - GUI_TESTRUNNER;$(DCC_Define) 1033 true @@ -188,9 +187,10 @@ - - Cfg_5 - Cfg_4 + + + Cfg_2 + Base Base @@ -199,9 +199,9 @@ Cfg_4 Cfg_1 - - Cfg_2 - Base + + Cfg_5 + Cfg_4 Cfg_1 @@ -294,12 +294,24 @@ true + + + DMVCFrameworkTests.exe + true + + DMVCFrameworkTests.rsm true + + + DMVCFrameworkTests.rsm + true + + 1 diff --git a/unittests/general/Several/LiveServerTestU.pas b/unittests/general/Several/LiveServerTestU.pas index 76a1eb6cd..d365be0c8 100644 --- a/unittests/general/Several/LiveServerTestU.pas +++ b/unittests/general/Several/LiveServerTestU.pas @@ -106,6 +106,8 @@ TServerTest = class(TBaseServerTest) [Test] procedure TestRenderWrappedList; [Test] + procedure TestRenderActionInCollections; + [Test] procedure TestRenderWrappedListWithCompression; [Test] procedure TestRenderStreamAndFreeWithOwnerFalse; @@ -685,6 +687,26 @@ procedure TServerTest.TestEncodingRenderJSONValue; } end; +procedure TServerTest.TestRenderActionInCollections; +var + lRes: IRESTResponse; + lJArr: TJDOJsonArray; + I: Integer; +begin + lRes := RESTClient.doGET('/people/renderaction', []); + lJArr := TJsonBaseObject.Parse(lRes.BodyAsString) as TJDOJsonArray; + try + for I := 0 to lJArr.Count - 1 do + begin + Assert.isFalse(lJArr[I].O['_links'].IsNull, '_links doesn''t exists'); + Assert.isFalse(lJArr[I].O['_links']['x-ref-lastname'].IsNull, '_links.x-ref-lastname doesn''t exists'); + Assert.isFalse(lJArr[I].O['_links']['x-ref-firstname'].IsNull, '_links.x-ref-firstname doesn''t exists'); + end; + finally + lJArr.Free; + end; +end; + procedure TServerTest.TestRenderStreamAndFreeWithOwnerFalse; var lRes: IRESTResponse; @@ -726,7 +748,7 @@ procedure TServerTest.TestRenderWrappedList; procedure TServerTest.TestRenderWrappedListWithCompression; var lRes: IRESTResponse; - lJSONArr: TJDOJSONArray; + lJSONArr: TJDOJsonArray; I: Integer; lCompType: string; j: Integer; @@ -1377,7 +1399,7 @@ procedure TJSONRPCServerTest.TestRequestWithParams_I_I_ret_A; var lReq: IJSONRPCRequest; lRPCResp: IJSONRPCResponse; - lArr: TJDOJSONArray; + lArr: TJDOJsonArray; I: Integer; x: Integer; begin @@ -1388,7 +1410,7 @@ procedure TJSONRPCServerTest.TestRequestWithParams_I_I_ret_A; lReq.RequestID := 1234; lRPCResp := FExecutor.ExecuteRequest(lReq); - lArr := TJDOJSONArray(lRPCResp.Result.AsObject); + lArr := TJDOJsonArray(lRPCResp.Result.AsObject); x := 1; for I := 0 to lArr.Count - 1 do begin @@ -1397,7 +1419,7 @@ procedure TJSONRPCServerTest.TestRequestWithParams_I_I_ret_A; end; lRPCResp := FExecutor2.ExecuteRequest(lReq); - lArr := TJDOJSONArray(lRPCResp.Result.AsObject); + lArr := TJDOJsonArray(lRPCResp.Result.AsObject); x := 1; for I := 0 to lArr.Count - 1 do begin diff --git a/unittests/general/TestServer/TestServerControllerU.pas b/unittests/general/TestServer/TestServerControllerU.pas index 24b358b96..f0d040ef1 100644 --- a/unittests/general/TestServer/TestServerControllerU.pas +++ b/unittests/general/TestServer/TestServerControllerU.pas @@ -103,6 +103,10 @@ TTestServerController = class(TMVCController) [MVCProduces('application/json', 'utf-8')] procedure TestConsumeJSON; + [MVCPath('/people/renderaction')] + [MVCHTTPMethod([httpGET])] + procedure TestGetPersonsHateos; + [MVCPath('/people/($id)')] [MVCHTTPMethod([httpGET])] procedure TestGetPersonByID; @@ -434,6 +438,16 @@ procedure TTestServerController.TestGetPersons; end; +procedure TTestServerController.TestGetPersonsHateos; +begin + Render(TPerson.GetList, True, + procedure(const Person: TPerson; const Links: TMVCStringDictionary) + begin + Links['x-ref-firstname'] := '/api/people/' + Person.FirstName; + Links['x-ref-lastname'] := '/api/people/' + Person.LastName; + end); +end; + procedure TTestServerController.TestGetWrappedPeople; var LWrappedList: IWrappedList; @@ -525,7 +539,7 @@ procedure TTestServerController.TestStringDictionary; end; procedure TTestServerController.TestTypedActionAllTypes(ParString: string; ParInteger: Integer; ParInt64: Int64; - ParSingle: Single; ParDouble: Double; ParExtended: Extended); +ParSingle: Single; ParDouble: Double; ParExtended: Extended); var lJObj: TJSONObject; begin