Improved support for HATEOAS in renders

This commit is contained in:
Daniele Teti 2019-03-08 09:33:41 +01:00
parent 98d4b353f4
commit beb059a0e3
13 changed files with 326 additions and 154 deletions

View File

@ -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<TPerson>(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<T>` raises an exception if the record is not found

View File

@ -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 @@ type
procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
const AAttributes: System.TArray<System.TCustomAttribute>);
const AAttributes: System.TArray<System.TCustomAttribute>;
const ASerializationAction: TMVCSerializationAction = nil);
procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
@ -60,7 +61,8 @@ type
procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
const AAttributes: System.TArray<System.TCustomAttribute>);
const AAttributes: System.TArray<System.TCustomAttribute>;
const ASerializationAction: TMVCSerializationAction);
procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
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 @@ begin
end;
procedure TNullableAliasSerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
const AAttributes: System.TArray<System.TCustomAttribute>);
const AAttributes: System.TArray<System.TCustomAttribute>;
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<System.TCustomAttribute>);
const AAttributes: System.TArray<System.TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
begin
raise EMVCSerializationException.CreateFmt('%s cannot be used as root object', [ClassName]);
end;

View File

@ -66,6 +66,11 @@ type
[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 @@ begin
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 @@ begin
Render<TPerson>(People);
end;
procedure TRenderSampleController.GetPeople_AsObjectList_HATEOS;
var
p: TPerson;
People: TObjectList<TPerson>;
begin
People := TObjectList<TPerson>.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<TPerson>(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;

View File

@ -133,6 +133,7 @@ type
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 @@ type
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 @@ end;
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 @@ end;
{ TMVCStringDictionary }
function TMVCStringDictionary.AddProperty(const Name, Value: string): TMVCStringDictionary;
function TMVCStringDictionary.Add(const Name, Value: string): TMVCStringDictionary;
begin
FDict.AddOrSetValue(name, Value);
Result := Self;

View File

@ -59,7 +59,8 @@ type
TMVCIgnoredList = array of string;
TMVCSerializationAction = TProc<TObject, TMVCStringDictionary>;
TMVCSerializationAction<T: class> = 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 @@ type
class function GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; overload; static;
class function HasAttribute<T: class>(const AMember: TRttiNamedObject): boolean; overload; static;
class function HasAttribute<T: class>(const AMember: TRttiNamedObject; out AAttribute: T): boolean; overload; static;
class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T): boolean;
class function HasAttribute<T: class>(const AMember: TRttiNamedObject; out AAttribute: T): boolean;
overload; static;
class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T)
: boolean; overload; static;
class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>): boolean;
overload; static;
class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>): boolean; overload; static;
class procedure EncodeStream(AInput, AOutput: TStream); static;
class procedure DecodeStream(AInput, AOutput: TStream); static;
@ -185,7 +188,8 @@ type
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 @@ type
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 @@ var
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 @@ end;
{ 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 @@ begin
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 @@ begin
end;
end;
class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T): boolean;
class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>;
out AAttribute: T): boolean;
var
Att: TCustomAttribute;
begin
@ -340,8 +349,7 @@ begin
Result := (AAttribute <> nil);
end;
class function TMVCSerializerHelper.AttributeExists<T>(
const AAttributes: TArray<TCustomAttribute>): boolean;
class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>): boolean;
var
Att: TCustomAttribute;
begin
@ -384,7 +392,8 @@ begin
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 @@ begin
Soap.EncdDecd.DecodeStream(AInput, AOutput);
{$ENDIF}
end;
class function TMVCSerializerHelper.DecodeString(const AInput: string): string;
@ -413,7 +421,6 @@ begin
Result := Soap.EncdDecd.DecodeString(AInput);
{$ENDIF}
end;
class procedure TMVCSerializerHelper.EncodeStream(AInput, AOutput: TStream);
@ -426,7 +433,6 @@ begin
Soap.EncdDecd.EncodeStream(AInput, AOutput);
{$ENDIF}
end;
class function TMVCSerializerHelper.EncodeString(const AInput: string): string;
@ -439,7 +445,6 @@ begin
Result := Soap.EncdDecd.EncodeString(AInput);
{$ENDIF}
end;
class function TMVCSerializerHelper.GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string;
@ -507,8 +512,7 @@ begin
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;

View File

@ -49,7 +49,8 @@ type
procedure SerializeRoot(
const AObject: TObject;
out ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
const AAttributes: TArray<TCustomAttribute>;
const ASerializationAction: TMVCSerializationAction = nil
);
procedure DeserializeAttribute(
@ -80,19 +81,22 @@ type
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(

View File

@ -43,27 +43,15 @@ type
protected
// procedure Serialize(const AElementValue: TValue; var ASerializerObject: TObject;
// const AAttributes: TArray<TCustomAttribute>);
procedure SerializeAttribute(
const AElementValue: TValue;
const APropertyName: string;
const ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure SerializeRoot(
const AObject: TObject;
out ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
procedure DeserializeAttribute(
var AElementValue: TValue;
const APropertyName: string;
const ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
procedure DeserializeRoot(
const ASerializerObject: TObject; const AObject: TObject;
procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
const AAttributes: TArray<TCustomAttribute>);
public
@ -72,29 +60,15 @@ type
TMVCStringDictionarySerializer = class(TInterfacedObject, IMVCTypeSerializer)
public
procedure SerializeAttribute(
const AElementValue: TValue;
const APropertyName: string;
const ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure SerializeRoot(
const AObject: TObject;
out ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure DeserializeAttribute(
var AElementValue: TValue;
const APropertyName: string;
const ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
procedure DeserializeRoot(
const ASerializerObject: TObject;
const AObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
const AAttributes: TArray<TCustomAttribute>);
end;
implementation
@ -106,12 +80,8 @@ uses
System.Generics.Collections,
JsonDataObjects;
procedure TMVCStreamSerializerJsonDataObject.DeserializeAttribute(
var AElementValue: TValue;
const APropertyName: string;
const ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure TMVCStreamSerializerJsonDataObject.DeserializeAttribute(var AElementValue: TValue;
const APropertyName: string; const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
var
lStream: TStream;
SS: TStringStream;
@ -142,8 +112,7 @@ begin
end;
end;
procedure TMVCStreamSerializerJsonDataObject.DeserializeRoot(
const ASerializerObject: TObject; const AObject: TObject;
procedure TMVCStreamSerializerJsonDataObject.DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
const AAttributes: TArray<TCustomAttribute>);
var
lValue: TValue;
@ -152,10 +121,8 @@ begin
DeserializeAttribute(lValue, 'data', ASerializerObject, AAttributes);
end;
procedure TMVCStreamSerializerJsonDataObject.SerializeAttribute(
const AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>);
procedure TMVCStreamSerializerJsonDataObject.SerializeAttribute(const AElementValue: TValue;
const APropertyName: string; const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
var
Stream: TStream;
SS: TStringStream;
@ -185,8 +152,8 @@ begin
end;
end;
procedure TMVCStreamSerializerJsonDataObject.SerializeRoot(const AObject: TObject;
out ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
procedure TMVCStreamSerializerJsonDataObject.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
var
lSerializerObject: TJsonObject;
begin
@ -201,12 +168,8 @@ end;
{ TMVCStringDictionarySerializer }
procedure TMVCStringDictionarySerializer.DeserializeAttribute(
var AElementValue: TValue;
const APropertyName: string;
const ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>
);
procedure TMVCStringDictionarySerializer.DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
var
lStringDict: TMVCStringDictionary;
lJSON: TJDOJsonObject;
@ -216,15 +179,12 @@ begin
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<TCustomAttribute>
);
procedure TMVCStringDictionarySerializer.DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
const AAttributes: TArray<TCustomAttribute>);
var
lStringDict: TMVCStringDictionary;
lJSON: TJDOJsonObject;
@ -234,14 +194,12 @@ begin
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<TCustomAttribute>);
procedure TMVCStringDictionarySerializer.SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
var
lStringDict: TMVCStringDictionary;
lPair: TPair<string, string>;
@ -261,8 +219,8 @@ begin
end;
end;
procedure TMVCStringDictionarySerializer.SerializeRoot(const AObject: TObject;
out ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
procedure TMVCStringDictionarySerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
var
lStringDict: TMVCStringDictionary;
lPair: TPair<string, string>;

View File

@ -44,15 +44,22 @@ uses
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<TCustomAttribute>);
@ -80,13 +87,14 @@ type
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 @@ begin
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 @@ begin
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 @@ begin
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 @@ begin
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<T>(const AString: string): T;
@ -877,11 +923,13 @@ begin
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 @@ begin
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 @@ begin
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 @@ begin
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 @@ begin
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;

View File

@ -456,10 +456,12 @@ type
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<T: class>(const ACollection: TObjectList<T>); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>;
const ASerializationAction: TMVCSerializationAction<T> = nil); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean;
const AType: TMVCSerializationType); overload;
const ASerializationAction: TMVCSerializationAction<T> = nil); overload;
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean;
const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction<T> = 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 @@ begin
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 @@ begin
end;
end;
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean);
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean;
const ASerializationAction: TMVCSerializationAction<T>);
begin
Self.Render<T>(ACollection, AOwns, stDefault);
Self.Render<T>(ACollection, AOwns, stDefault, ASerializationAction);
end;
procedure TMVCRenderer.ResponseStatus(const AStatusCode: Integer; const AReasonString: string);
@ -2752,12 +2756,25 @@ begin
end;
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean;
const AType: TMVCSerializationType);
const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction<T>);
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 @@ begin
end;
end;
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>);
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>;
const ASerializationAction: TMVCSerializationAction<T>);
begin
Self.Render<T>(ACollection, True);
Self.Render<T>(ACollection, True, ASerializationAction);
end;
procedure TMVCRenderer.RenderResponseStream;

View File

@ -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}

View File

@ -144,7 +144,6 @@
<DCC_Define>_CONSOLE_TESTRUNNER;GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_3_Win32)'!=''">
<DCC_Define>GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
@ -188,9 +187,10 @@
<DCCReference Include="..\..\..\sources\MVCFramework.JSONRPC.pas"/>
<DCCReference Include="..\..\..\samples\commons\RandomUtilsU.pas"/>
<DCCReference Include="..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas"/>
<BuildConfiguration Include="CI">
<Key>Cfg_5</Key>
<CfgParent>Cfg_4</CfgParent>
<DCCReference Include="..\..\..\sources\JsonDataObjects.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
@ -199,9 +199,9 @@
<Key>Cfg_4</Key>
<CfgParent>Cfg_1</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
<BuildConfiguration Include="CI">
<Key>Cfg_5</Key>
<CfgParent>Cfg_4</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
@ -294,12 +294,24 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\GUI\DMVCFrameworkTests.exe" Configuration="GUI" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>DMVCFrameworkTests.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\DMVCFrameworkTests.rsm" Configuration="Debug" Class="DebugSymbols">
<Platform Name="Win32">
<RemoteName>DMVCFrameworkTests.rsm</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\GUI\DMVCFrameworkTests.rsm" Configuration="GUI" Class="DebugSymbols">
<Platform Name="Win32">
<RemoteName>DMVCFrameworkTests.rsm</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">
<Operation>1</Operation>

View File

@ -106,6 +106,8 @@ type
[Test]
procedure TestRenderWrappedList;
[Test]
procedure TestRenderActionInCollections;
[Test]
procedure TestRenderWrappedListWithCompression;
[Test]
procedure TestRenderStreamAndFreeWithOwnerFalse;
@ -685,6 +687,26 @@ begin
}
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 @@ end;
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 @@ begin
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 @@ begin
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

View File

@ -103,6 +103,10 @@ type
[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 @@ begin
end;
procedure TTestServerController.TestGetPersonsHateos;
begin
Render<TPerson>(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 @@ begin
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