From 4cc5b6560c7bcd0e862ed2f73a590727c7fac96f Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Thu, 9 Feb 2017 19:33:59 +0100 Subject: [PATCH] CustomTypesSerialiers --- sources/MVCFramework.Commons.pas | 28 +- sources/MVCFramework.DuckTyping.pas | 11 +- sources/MVCFramework.Serializer.Commons.pas | 136 +++- sources/MVCFramework.Serializer.Intf.pas | 21 +- sources/MVCFramework.Serializer.JSON.pas | 612 +++++++++++------- sources/MVCFramework.TypesAliases.pas | 24 + sources/MVCFramework.pas | 10 +- sources/ObjectsMappers.pas | 67 +- unittests/Several/BOs.pas | 78 +++ unittests/Several/DMVCFrameworkTests.dpr | 3 +- unittests/Several/DMVCFrameworkTests.dproj | 23 +- unittests/Several/FrameworkTestsU.pas | 108 +++- .../Several/SerializationFrameworkTestsU.pas | 79 ++- unittests/TestServer/TestServer.dproj | 22 +- 14 files changed, 863 insertions(+), 359 deletions(-) diff --git a/sources/MVCFramework.Commons.pas b/sources/MVCFramework.Commons.pas index ade693c5..db14c8c2 100644 --- a/sources/MVCFramework.Commons.pas +++ b/sources/MVCFramework.Commons.pas @@ -30,13 +30,8 @@ interface uses - System.SysUtils, Generics.Collections -{$IFDEF SYSTEMJSON} // XE6 - , System.JSON -{$ELSE} - , Data.DBXJSON -{$ENDIF} - , System.Generics.Collections, MVCFramework.Session, LoggerPro, + System.SysUtils, Generics.Collections, MVCFramework.TypesAliases, + System.Generics.Collections, MVCFramework.Session, LoggerPro, System.SyncObjs; {$I dmvcframeworkbuildconsts.inc} @@ -47,6 +42,16 @@ type httpOPTIONS, httpPATCH, httpTRACE); TMVCHTTPMethods = set of TMVCHTTPMethodType; + TMVCPair = class + private + FKey: TKey; + FValue: TVal; + public + constructor Create(const Key: TKey; const Value: TVal); + property Key: TKey read FKey; + property Value: TVal read FValue; + end; + TMVCMimeType = class sealed public const APPLICATION_JSON = 'application/json'; @@ -648,6 +653,15 @@ begin end; end; +{ TMVCPair } + +constructor TMVCPair.Create(const Key: TKey; const Value: TVal); +begin + inherited Create; + FKey := Key; + FValue := Value; +end; + initialization Lock := TObject.Create; diff --git a/sources/MVCFramework.DuckTyping.pas b/sources/MVCFramework.DuckTyping.pas index 7c77df8d..1c891ec0 100644 --- a/sources/MVCFramework.DuckTyping.pas +++ b/sources/MVCFramework.DuckTyping.pas @@ -83,7 +83,8 @@ type private FOwnsObject: boolean; protected - class var CTX: TRTTIContext; + class var + CTX: TRTTIContext; FObjectAsDuck: TObject; FAddMethod: TRttiMethod; FClearMethod: TRttiMethod; @@ -272,6 +273,9 @@ end; class function TDuckTypedList.Wrap(const AObjectAsDuck: TObject): IMVCList; var lRttiType: TRttiType; +{$IF CompilerVersion >= 23} + lRTTIIndexedProperty: TRTTIIndexedProperty; +{$IFEND} begin lRttiType := CTX.GetType(AObjectAsDuck.ClassInfo); FAddMethod := lRttiType.GetMethod('Add'); @@ -283,7 +287,10 @@ begin FGetItemMethod := nil; {$IF CompilerVersion >= 23} - FGetItemMethod := lRttiType.GetIndexedProperty('Items').ReadMethod; + lRTTIIndexedProperty := lRttiType.GetIndexedProperty('Items'); + if lRTTIIndexedProperty = nil then + Exit(nil); + FGetItemMethod := lRTTIIndexedProperty.ReadMethod; {$IFEND} if not Assigned(FGetItemMethod) then FGetItemMethod := lRttiType.GetMethod('GetItem'); diff --git a/sources/MVCFramework.Serializer.Commons.pas b/sources/MVCFramework.Serializer.Commons.pas index 92b26a2c..c4ec8538 100644 --- a/sources/MVCFramework.Serializer.Commons.pas +++ b/sources/MVCFramework.Serializer.Commons.pas @@ -1,10 +1,34 @@ +// *************************************************************************** +// +// Delphi MVC Framework +// +// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team +// +// https://github.com/danieleteti/delphimvcframework +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + unit MVCFramework.Serializer.Commons; interface uses System.Rtti, System.Classes, System.SysUtils, System.Generics.Collections, MVCFramework.Serializer.Intf, - System.TypInfo; + System.TypInfo, MVCFramework.MultiMap, MVCFramework.Commons; type TSerializerHelpers = class sealed @@ -37,13 +61,18 @@ type end; - TMVCSerUnSerRegistry = class sealed + TMVCSerializersRegistry = class sealed strict private - class var SStorage: TDictionary; + class var SSerializers: TDictionary; + class var SCustomTypeSerializers: IMVCObjectMultiMap>; public - class function GetSerUnSer(aContentType: String): IMVCSerUnSer; - class procedure RegisterSerializer(aContentType: string; aMVCSerUnSer: IMVCSerUnSer); + class function GetSerializer(aContentType: String): IMVCSerializer; + class procedure RegisterSerializer(aContentType: string; aMVCSerUnSer: IMVCSerializer); class procedure UnRegisterSerializer(aContentType: string); + class procedure RegisterTypeSerializer(aContentType: string; aTypeInfo: PTypeInfo; + aMVCTypeSerializer: IMVCTypeSerializer); + class procedure UnRegisterTypeSerializer(aContentType: string; aTypeInfo: PTypeInfo); + class function GetTypeSerializer(aContentType: String; aTypeInfo: PTypeInfo): IMVCTypeSerializer; class constructor Create; class destructor Destroy; end; @@ -56,6 +85,20 @@ type function TValueTypeInfo: PTypeInfo; end; + MVCSerializeAsString = class(TCustomAttribute) + strict private + FEncoding: string; + procedure SetEncoding(const Value: string); + + const + DefaultEncoding = 'utf8'; + private + function GetEncoding: string; + public + constructor Create(aEncoding: string = DefaultEncoding); + property Encoding: string read GetEncoding write SetEncoding; + end; + implementation uses @@ -218,6 +261,8 @@ var begin Result := false; attrs := ARTTIMember.GetAttributes; + if Length(attrs) = 0 then + Exit(false); for attr in attrs do if attr is T then Exit(True); @@ -248,32 +293,69 @@ end; { TMVCSerUnSerRegistry } -class constructor TMVCSerUnSerRegistry.Create; +class constructor TMVCSerializersRegistry.Create; begin - SStorage := TDictionary.Create; + SSerializers := TDictionary.Create; + SCustomTypeSerializers := TMVCObjectMultiMap < TMVCPair < PTypeInfo, IMVCTypeSerializer >>.Create; end; -class destructor TMVCSerUnSerRegistry.Destroy; +class destructor TMVCSerializersRegistry.Destroy; begin - SStorage.Free; + SSerializers.Free; end; -class function TMVCSerUnSerRegistry.GetSerUnSer( - aContentType: String): IMVCSerUnSer; +class function TMVCSerializersRegistry.GetSerializer( + aContentType: String): IMVCSerializer; begin - if not SStorage.TryGetValue(aContentType, Result) then + if not SSerializers.TryGetValue(aContentType, Result) then raise EMVCSerializationException.CreateFmt('Cannot find a suitable serializer for %s', [aContentType]); end; -class procedure TMVCSerUnSerRegistry.RegisterSerializer(aContentType: string; - aMVCSerUnSer: IMVCSerUnSer); +class function TMVCSerializersRegistry.GetTypeSerializer(aContentType: String; + aTypeInfo: PTypeInfo): IMVCTypeSerializer; +var + lList: TList>; + I: Integer; begin - TMVCSerUnSerRegistry.SStorage.Add(aContentType, aMVCSerUnSer); + Result := nil; + lList := SCustomTypeSerializers.GetItems(aContentType); + if lList = nil then + Exit; + for I := 0 to lList.Count - 1 do + begin + if lList[I].Key = aTypeInfo then + begin + Result := lList[I].Value; + Break; + end; + end; end; -class procedure TMVCSerUnSerRegistry.UnRegisterSerializer(aContentType: string); +class procedure TMVCSerializersRegistry.RegisterSerializer(aContentType: string; + aMVCSerUnSer: IMVCSerializer); begin - TMVCSerUnSerRegistry.SStorage.Remove(aContentType); + TMVCSerializersRegistry.SSerializers.Add(aContentType, aMVCSerUnSer); +end; + +class procedure TMVCSerializersRegistry.RegisterTypeSerializer( + aContentType: string; aTypeInfo: PTypeInfo; + aMVCTypeSerializer: IMVCTypeSerializer); +begin + SCustomTypeSerializers.Add(aContentType, + TMVCPair.Create(aTypeInfo, aMVCTypeSerializer)); +end; + +class procedure TMVCSerializersRegistry.UnRegisterSerializer(aContentType: string); +begin + TMVCSerializersRegistry.SSerializers.Remove(aContentType); +end; + +class procedure TMVCSerializersRegistry.UnRegisterTypeSerializer( + aContentType: string; aTypeInfo: PTypeInfo); +begin + raise Exception.Create('Not implemented'); + // SCustomTypeSerializers.Add(aContentType, + // TMVCPair.Create(aTypeInfo, aMVCTypeSerializer)); end; { TValueAsType } @@ -289,4 +371,24 @@ begin Result := FTValueTypeInfo; end; +{ MVCSerializeAsString } + +constructor MVCSerializeAsString.Create(aEncoding: string); +begin + inherited Create; + FEncoding := aEncoding; +end; + +function MVCSerializeAsString.GetEncoding: string; +begin + if FEncoding.IsEmpty then + FEncoding := DefaultEncoding; + Result := FEncoding; +end; + +procedure MVCSerializeAsString.SetEncoding(const Value: string); +begin + FEncoding := Value; +end; + end. diff --git a/sources/MVCFramework.Serializer.Intf.pas b/sources/MVCFramework.Serializer.Intf.pas index 7e1636c1..a011e931 100644 --- a/sources/MVCFramework.Serializer.Intf.pas +++ b/sources/MVCFramework.Serializer.Intf.pas @@ -3,7 +3,7 @@ unit MVCFramework.Serializer.Intf; interface uses - Data.DB, MVCFramework.DuckTyping; + Data.DB, MVCFramework.DuckTyping, System.Rtti; const DMVC_CLASSNAME = '$dmvc_classname'; @@ -11,13 +11,13 @@ const type TMVCSerializationType = (Properties, Fields); - IMVCSerUnSerListener = interface + IMVCSerializerListener = interface ['{5976F9DA-1B89-4F8C-B333-C3612071DEE0}'] procedure BeforeSerialize(const AObject: TObject); procedure AfterDeserialize(const AObject: TObject); end; - IMVCSerUnSer = interface + IMVCSerializer = interface ['{1ECA942A-E3C4-45DD-9D23-C00363B5E334}'] function SerializeObject(AObject: TObject; AIgnoredProperties: array of string): String; function SerializeObjectStrict(AObject: TObject): String; @@ -25,9 +25,24 @@ type function SerializeCollection(AList: TObject; AIgnoredProperties: array of string): String; function SerializeCollectionStrict(AList: TObject): String; procedure DeserializeObject(ASerializedObject: String; AObject: TObject); + procedure DeserializeObjectStrict(ASerializedObject: String; AObject: TObject); procedure DeserializeCollection(ASerializedObjectList: string; AList: IMVCList; AClazz: TClass); end; + IMVCTypeSerializer = interface + ['{806EC547-D1CB-4DA9-92D3-A8A7C0BD4009}'] + procedure SerializeInstance( + const ElementType: TRTTIType; + const ElementAttributes: TArray; + const InputValue: TValue; + out OutputObject: TObject); + procedure DeserializeInstance( + const ElementType: TRTTIType; + const ElementAttributes: TArray; + const InputObject: TObject; + out OutputValue: TValue); + end; + implementation end. diff --git a/sources/MVCFramework.Serializer.JSON.pas b/sources/MVCFramework.Serializer.JSON.pas index 38f4ab2e..f29c5ac9 100644 --- a/sources/MVCFramework.Serializer.JSON.pas +++ b/sources/MVCFramework.Serializer.JSON.pas @@ -1,3 +1,27 @@ +// *************************************************************************** +// +// Delphi MVC Framework +// +// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team +// +// https://github.com/danieleteti/delphimvcframework +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + unit MVCFramework.Serializer.JSON; interface @@ -10,12 +34,11 @@ uses MVCFramework.Serializer.Intf , System.Rtti , System.SysUtils , System.Classes - , MVCFramework.Serializer.Commons , MVCFramework.TypesAliases, MVCFramework.DuckTyping, System.TypInfo ; type - TMVCJSONSerUnSer = class(TInterfacedObject, IMVCSerUnSer) + TMVCJSONSerUnSer = class(TInterfacedObject, IMVCSerializer) private class var CTX: TRTTIContext; { following methods are used internally by the serializer/unserializer to handle with the ser/unser logic } @@ -30,8 +53,12 @@ type : TJSONValue; function SerializeEnumerationField(AObject: TObject; ARttiField: TRttiField): TJSONValue; - function DeserializeTValue(AJValue: TJSONValue; AAttributes: TArray): TValue; - function DeserializeTValueWithDynamicType(AJValue: TJSONValue): TValue; + function DeserializeFloat(ARTTIType: TRTTIType; AJSONValue: TJSONValue): TValue; + function DeserializeEnumeration(ARTTIType: TRTTIType; AJSONValue: TJSONValue; AItemName: String): TValue; + function DeserializeRecord(ARTTIType: TRTTIType; AJSONValue: TJSONValue; + AAttributes: TArray; AItemName: String): TValue; + function DeserializeTValue(AJValue: TJSONValue; AAttributes: TArray; AItemName: String): TValue; + function DeserializeTValueWithDynamicType(AJValue: TJSONValue; AItemName: String): TValue; procedure DeSerializeStringStream(aStream: TStream; const aSerializedString: string; aEncoding: string); procedure DeSerializeBase64StringStream(aStream: TStream; @@ -45,10 +72,11 @@ type function JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject; function SerializeRTTIElement(ElementType: TRTTIType; - ElementAttributes: TArray; Value: TValue): TJSONValue; + ElementAttributes: TArray; Value: TValue; out OutputValue: TJSONValue): boolean; procedure InternalJSONObjectToObject(AJSONObject: TJSONObject; AObject: TObject); function SerializeTValueAsFixedNullableType(AValue: TValue; AValueTypeInfo: PTypeInfo): TJSONValue; + procedure InternalDeserializeObject(ASerializedObject: string; AObject: TObject; AStrict: boolean); protected { IMVCSerializer } function SerializeObject(AObject: TObject; @@ -61,13 +89,15 @@ type function SerializeCollectionStrict(AList: TObject): String; { IMVCDeserializer } procedure DeserializeObject(ASerializedObject: string; AObject: TObject); + procedure DeserializeObjectStrict(ASerializedObject: String; AObject: TObject); procedure DeserializeCollection(ASerializedObjectList: string; AList: IMVCList; AClazz: TClass); end; implementation uses - ObjectsMappers, MVCFramework.Patches, MVCFramework.RTTIUtils; + ObjectsMappers, MVCFramework.Patches, MVCFramework.RTTIUtils, + MVCFramework.Serializer.Commons, Winapi.Windows; { TMVCJSONSerializer } @@ -77,8 +107,8 @@ begin end; -function TMVCJSONSerUnSer.DeserializeTValue(AJValue: TJSONValue; - AAttributes: TArray): TValue; +function TMVCJSONSerUnSer.DeserializeTValue(AJValue: TJSONValue; AAttributes: TArray; + AItemName: String): TValue; var lAttr: TValueAsType; begin @@ -102,17 +132,17 @@ begin raise EMVCDeserializationException.Create('Booleans and enumerations are not supported'); end; else - raise EMVCDeserializationException.Create('Type non supported for TValue'); + raise EMVCDeserializationException.CreateFmt('Type non supported for TValue at item: ', [AItemName]); end; end else begin - Result := DeserializeTValueWithDynamicType(AJValue); + Result := DeserializeTValueWithDynamicType(AJValue, AItemName); end; end; function TMVCJSONSerUnSer.DeserializeTValueWithDynamicType( - AJValue: TJSONValue): TValue; + AJValue: TJSONValue; AItemName: String): TValue; var lJTValueValue: TJSONValue; lTypeKind: TTypeKind; @@ -143,7 +173,7 @@ begin Result := (lJTValueValue as TJSONNumber).AsInt64; end; else - raise EMVCDeserializationException.CreateFmt('Type non supported for TValue %s', [lStrType]); + raise EMVCDeserializationException.CreateFmt('Type non supported for TValue %s at: ', [lStrType, AItemName]); end; end; @@ -157,11 +187,44 @@ begin Result := pair; end; +procedure TMVCJSONSerUnSer.InternalDeserializeObject(ASerializedObject: string; + AObject: TObject; AStrict: boolean); +var + lJSON: TJSONValue; +begin + lJSON := TJSONObject.ParseJSONValue(ASerializedObject); + try + if lJSON <> nil then + begin + if lJSON is TJSONObject then + begin + if AStrict then + begin + // InternalJSONObjectToObjectFields(TJSONObject(lJSON), AObject) + end + else + InternalJSONObjectToObject(TJSONObject(lJSON), AObject) + end + else + begin + raise EMVCDeserializationException.CreateFmt('Serialized string is a %s, expected JSON Object', + [lJSON.ClassName]); + end; + end + else + begin + raise EMVCDeserializationException.Create('Serialized string is not a valid JSON'); + end; + finally + lJSON.Free; + end; +end; + procedure TMVCJSONSerUnSer.InternalJSONObjectToObject(AJSONObject: TJSONObject; AObject: TObject); var lRttiType: TRTTIType; - lRttiProperties: TArray; - lRttiProp: TRttiProperty; + lProperties: TArray; + lProperty: TRttiProperty; f: string; jvalue: TJSONValue; v: TValue; @@ -177,194 +240,154 @@ var ListMethod: TRttiMethod; ListItem: TValue; ListParam: TRttiParameter; + lPropName: string; + lTypeSerializer: IMVCTypeSerializer; + lOutputValue: TValue; begin { TODO -oDaniele -cGeneral : Refactor this method } if not Assigned(AJSONObject) then raise EMapperException.Create('JSON Object cannot be nil'); lRttiType := CTX.GetType(AObject.ClassInfo); - lRttiProperties := lRttiType.GetProperties; - for lRttiProp in lRttiProperties do + lProperties := lRttiType.GetProperties; + for lProperty in lProperties do begin - if ((not lRttiProp.IsWritable) and (lRttiProp.PropertyType.TypeKind <> tkClass)) - or (TSerializerHelpers.HasAttribute(lRttiProp)) then + if ((not lProperty.IsWritable) and (lProperty.PropertyType.TypeKind <> tkClass)) + or (TSerializerHelpers.HasAttribute(lProperty)) then Continue; - f := TSerializerHelpers.GetKeyName(lRttiProp, lRttiType); + lPropName := lProperty.Name; + f := TSerializerHelpers.GetKeyName(lProperty, lRttiType); if Assigned(AJSONObject.Get(f)) then jvalue := AJSONObject.Get(f).JsonValue else Continue; - case lRttiProp.PropertyType.TypeKind of - tkEnumeration: - begin - if lRttiProp.PropertyType.QualifiedName = 'System.Boolean' then - begin - if jvalue is TJSONTrue then - lRttiProp.SetValue(TObject(AObject), True) - else if jvalue is TJSONFalse then - lRttiProp.SetValue(TObject(AObject), false) - else - raise EMapperException.Create('Invalid value for property ' + - lRttiProp.Name); - end - else // it is an enumerated value but it's not a boolean. - begin - TValue.Make((jvalue as TJSONNumber).AsInt, - lRttiProp.PropertyType.Handle, v); - lRttiProp.SetValue(TObject(AObject), v); - end; - end; - tkInteger, tkInt64: - lRttiProp.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0)); - tkFloat: - begin - if lRttiProp.PropertyType.QualifiedName = 'System.TDate' then - begin - if jvalue is TJSONNull then - lRttiProp.SetValue(TObject(AObject), 0) - else - lRttiProp.SetValue(TObject(AObject), - ISOStrToDateTime(jvalue.Value + ' 00:00:00')) - end - else if lRttiProp.PropertyType.QualifiedName = 'System.TDateTime' then - begin - if jvalue is TJSONNull then - lRttiProp.SetValue(TObject(AObject), 0) - else - lRttiProp.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value)) - end - else if lRttiProp.PropertyType.QualifiedName = 'System.TTime' then - begin - if not(jvalue is TJSONNull) then - if jvalue is TJSONString then - lRttiProp.SetValue(TObject(AObject), ISOStrToTime(jvalue.Value)) - else - raise EMapperException.CreateFmt - ('Cannot deserialize [%s], expected [%s] got [%s]', - [lRttiProp.Name, 'TJSONString', jvalue.ClassName]); - end - else { if _field.PropertyType.QualifiedName = 'System.Currency' then } - begin - if not(jvalue is TJSONNull) then - if jvalue is TJSONNumber then - lRttiProp.SetValue(TObject(AObject), TJSONNumber(jvalue).AsDouble) - else - raise EMapperException.CreateFmt - ('Cannot deserialize [%s], expected [%s] got [%s]', - [lRttiProp.Name, 'TJSONNumber', jvalue.ClassName]); - end; - end; - tkString, tkLString, tkWString, tkUString: - begin - lRttiProp.SetValue(TObject(AObject), jvalue.Value); - end; - tkRecord: - begin - if lRttiProp.PropertyType.QualifiedName = 'System.Rtti.TValue' then - begin - lRttiProp.SetValue(TObject(AObject), DeserializeTValue(jvalue, lRttiProp.GetAttributes)); - end - else if lRttiProp.PropertyType.QualifiedName = 'System.SysUtils.TTimeStamp' - then - begin - n := jvalue as TJSONNumber; - lRttiProp.SetValue(TObject(AObject), - TValue.From(MSecsToTimeStamp(n.AsInt64))); - end; - end; - tkClass: // try to restore child properties... but only if the collection is not nil!!! - begin - o := lRttiProp.GetValue(TObject(AObject)).AsObject; - if Assigned(o) then - begin - if jvalue is TJSONNull then - begin - FreeAndNil(o); - lRttiProp.SetValue(AObject, nil); - end - else if o is TStream then - begin - if jvalue is TJSONString then - begin - SerStreamASString := TJSONString(jvalue).Value; - end - else - raise EMapperException.Create('Expected JSONString in ' + - AJSONObject.Get(f).JsonString.Value); - if TSerializerHelpers.HasAttribute(lRttiProp, _attrser) then + lTypeSerializer := TMVCSerializersRegistry.GetTypeSerializer('application/json', lProperty.PropertyType.Handle); + if lTypeSerializer <> nil then + begin + lTypeSerializer.DeserializeInstance( + lProperty.PropertyType, lProperty.GetAttributes, TObject(jvalue), lOutputValue); + lProperty.SetValue(TObject(AObject), lOutputValue); + end + else + begin + case lProperty.PropertyType.TypeKind of + tkEnumeration: + begin + lProperty.SetValue(TObject(AObject), + DeserializeEnumeration(lProperty.PropertyType, jvalue, lPropName)); + end; + tkInteger, tkInt64: + lProperty.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0)); + tkFloat: + begin + lProperty.SetValue(TObject(AObject), + DeserializeFloat(lProperty.PropertyType, jvalue)); + end; + tkString, tkLString, tkWString, tkUString: + begin + lProperty.SetValue(TObject(AObject), jvalue.Value); + end; + tkRecord: + begin + lProperty.SetValue(TObject(AObject), + DeserializeRecord(lProperty.PropertyType, jvalue, lProperty.GetAttributes, lPropName)); + end; + tkClass: // try to restore child properties... but only if the collection is not nil!!! + begin + o := lProperty.GetValue(TObject(AObject)).AsObject; + if Assigned(o) then + begin + if jvalue is TJSONNull then begin - TSerializerHelpers.DeSerializeStringStream(TStream(o), SerStreamASString, - _attrser.Encoding); + { TODO -oDaniele -cGeneral : How to handle this case at best? } + // FreeAndNil(o); + // lRttiProp.SetValue(AObject, nil); end - else + else if o is TStream then begin - TSerializerHelpers.DeSerializeBase64StringStream(TStream(o), SerStreamASString); - end; - end - else if TDuckTypedList.CanBeWrappedAsList(o) then - begin // restore collection - if jvalue is TJSONArray then - begin - Arr := TJSONArray(jvalue); - // look for the MapperItemsClassType on the property itself or on the property type - if Mapper.HasAttribute(lRttiProp, attr) or - Mapper.HasAttribute(lRttiProp.PropertyType, - attr) then + if jvalue is TJSONString then begin - cref := attr.Value; - list := WrapAsList(o); - for I := 0 to Arr.Count - 1 do - begin - list.Add(Mapper.JSONObjectToObject(cref, - Arr.Items[I] as TJSONObject)); - end; + SerStreamASString := TJSONString(jvalue).Value; end - else // Ezequiel J. Müller convert regular list + else + raise EMapperException.Create('Expected JSONString in ' + + AJSONObject.Get(f).JsonString.Value); + + if TSerializerHelpers.HasAttribute(lProperty, _attrser) then begin - ListMethod := CTX.GetType(o.ClassInfo).GetMethod('Add'); - if (ListMethod <> nil) then - begin - for I := 0 to Arr.Count - 1 do - begin - ListItem := TValue.Empty; - - for ListParam in ListMethod.GetParameters do - case ListParam.ParamType.TypeKind of - tkInteger, tkInt64: - ListItem := StrToIntDef(Arr.Items[I].Value, 0); - tkFloat: - ListItem := TJSONNumber(Arr.Items[I].Value).AsDouble; - tkString, tkLString, tkWString, tkUString: - ListItem := Arr.Items[I].Value; - end; - - if not ListItem.IsEmpty then - ListMethod.Invoke(o, [ListItem]); - end; - end; + TSerializerHelpers.DeSerializeStringStream(TStream(o), SerStreamASString, + _attrser.Encoding); + end + else + begin + TSerializerHelpers.DeSerializeBase64StringStream(TStream(o), SerStreamASString); end; end - else - raise EMapperException.Create('Cannot restore ' + f + - ' because the related json property is not an array'); - end - else // try to deserialize into the property... but the json MUST be an object - begin - if jvalue is TJSONObject then - begin - InternalJSONObjectToObject(TJSONObject(jvalue), o); + else if TDuckTypedList.CanBeWrappedAsList(o) then + begin // restore collection + if jvalue is TJSONArray then + begin + Arr := TJSONArray(jvalue); + // look for the MapperItemsClassType on the property itself or on the property type + if Mapper.HasAttribute(lProperty, attr) or + Mapper.HasAttribute(lProperty.PropertyType, + attr) then + begin + cref := attr.Value; + list := WrapAsList(o); + for I := 0 to Arr.Count - 1 do + begin + list.Add(Mapper.JSONObjectToObject(cref, + Arr.Items[I] as TJSONObject)); + end; + end + else // Ezequiel J. Müller convert regular list + begin + ListMethod := CTX.GetType(o.ClassInfo).GetMethod('Add'); + if (ListMethod <> nil) then + begin + for I := 0 to Arr.Count - 1 do + begin + ListItem := TValue.Empty; + + for ListParam in ListMethod.GetParameters do + case ListParam.ParamType.TypeKind of + tkInteger, tkInt64: + ListItem := StrToIntDef(Arr.Items[I].Value, 0); + tkFloat: + ListItem := TJSONNumber(Arr.Items[I].Value).AsDouble; + tkString, tkLString, tkWString, tkUString: + ListItem := Arr.Items[I].Value; + end; + + if not ListItem.IsEmpty then + ListMethod.Invoke(o, [ListItem]); + end; + end; + end; + end + else + raise EMapperException.Create('Cannot restore ' + f + + ' because the related json property is not an array'); end - else if jvalue is TJSONNull then + else // try to deserialize into the property... but the json MUST be an object begin - FreeAndNil(o); - lRttiProp.SetValue(AObject, nil); - end - else - raise EMapperException.Create('Cannot deserialize property ' + - lRttiProp.Name); + if jvalue is TJSONObject then + begin + InternalJSONObjectToObject(TJSONObject(jvalue), o); + end + else if jvalue is TJSONNull then + begin + FreeAndNil(o); + lProperty.SetValue(AObject, nil); + end + else + raise EMapperException.Create('Cannot deserialize property ' + + lProperty.Name); + end; end; end; - end; + end; // case end; end; end; @@ -405,6 +428,9 @@ var SS: TStringStream; _attrser: MapperSerializeAsString; SerEnc: TEncoding; + lTypeSerializer: IMVCTypeSerializer; + lJSONValue: TJSONValue; + lSerializedJValue: TJSONValue; begin ThereAreIgnoredProperties := Length(AIgnoredProperties) > 0; JSONObject := TJSONObject.Create; @@ -414,6 +440,7 @@ begin begin // f := LowerCase(_property.Name); f := TSerializerHelpers.GetKeyName(lProperty, lType); + outputdebugstring(pchar(f)); // Delete(f, 1, 1); if ThereAreIgnoredProperties then begin @@ -430,8 +457,21 @@ begin if TSerializerHelpers.HasAttribute(lProperty) then Continue; - JSONObject.AddPair(f, SerializeRTTIElement(lProperty.PropertyType, lProperty.GetAttributes, - lProperty.GetValue(AObject))); + lTypeSerializer := TMVCSerializersRegistry.GetTypeSerializer('application/json', lProperty.PropertyType.Handle); + if lTypeSerializer <> nil then + begin + lJSONValue := nil; + lTypeSerializer.SerializeInstance( + lProperty.PropertyType, lProperty.GetAttributes, lProperty.GetValue(AObject), TObject(lJSONValue)); + JSONObject.AddPair(f, lJSONValue); + end + else + begin + { if serializable then serialize, otherwise ignore it } + if SerializeRTTIElement(lProperty.PropertyType, lProperty.GetAttributes, + lProperty.GetValue(AObject), lSerializedJValue) then + JSONObject.AddPair(f, lSerializedJValue); + end; end; Result := JSONObject; @@ -450,6 +490,7 @@ var DoNotSerializeThis: boolean; I: Integer; JObj: TJSONObject; + lSerializedJValue: TJSONValue; begin JSONObject := TJSONObject.Create; try @@ -460,7 +501,8 @@ begin for _field in _fields do begin f := TSerializerHelpers.GetKeyName(_field, _type); - JSONObject.AddPair(f, SerializeRTTIElement(_field.FieldType, _field.GetAttributes, _field.GetValue(AObject))); + if SerializeRTTIElement(_field.FieldType, _field.GetAttributes, _field.GetValue(AObject), lSerializedJValue) then + JSONObject.AddPair(f, lSerializedJValue); // case _field.FieldType.TypeKind of // tkInteger, tkInt64: @@ -557,7 +599,7 @@ begin end; function TMVCJSONSerUnSer.SerializeRTTIElement(ElementType: TRTTIType; - ElementAttributes: TArray; Value: TValue): TJSONValue; + ElementAttributes: TArray; Value: TValue; out OutputValue: TJSONValue): boolean; var ts: TTimeStamp; o: TObject; @@ -574,29 +616,35 @@ var buff: TBytes; lStreamAsString: string; begin + OutputValue := nil; + Result := false; case ElementType.TypeKind of tkInteger, tkInt64: - Result := TJSONNumber.Create(Value.AsInteger); + begin + OutputValue := TJSONNumber.Create(Value.AsInteger); + end; tkFloat: begin - Result := SerializeFloatProperty(ElementType, Value); + OutputValue := SerializeFloatProperty(ElementType, Value); end; tkString, tkLString, tkWString, tkUString: - Result := TJSONString.Create(Value.AsString); + begin + OutputValue := TJSONString.Create(Value.AsString); + end; tkEnumeration: begin - Result := SerializeEnumerationProperty(ElementType, Value); + OutputValue := SerializeEnumerationProperty(ElementType, Value); end; tkRecord: begin if ElementType.QualifiedName = 'System.Rtti.TValue' then begin - Result := SerializeTValue(ElementType, Value, ElementAttributes); + OutputValue := SerializeTValue(ElementType, Value, ElementAttributes); end else if ElementType.QualifiedName = 'System.SysUtils.TTimeStamp' then begin ts := Value.AsType; - Result := TJSONNumber.Create(TimeStampToMsecs(ts)); + OutputValue := TJSONNumber.Create(TimeStampToMsecs(ts)); end; end; tkClass: @@ -607,57 +655,58 @@ begin list := TDuckTypedList.Wrap(o); if Assigned(list) then begin - Result := TJSONArray.Create; + OutputValue := TJSONArray.Create; for Obj in list do if Assigned(Obj) then // nil element into the list are not serialized - TJSONArray(Result).AddElement(ObjectToJSONObject(Obj, [])); - end - else if o is TStream then - begin - if TSerializerHelpers.AttributeExists(ElementAttributes, _attrser) then - begin - // serialize the stream as a normal string... - TStream(o).Position := 0; - lEncodingName := _attrser.Encoding; - SerEnc := TEncoding.GetEncoding(lEncodingName); - try - SetLength(buff, TStream(o).Size); - TStream(o).Read(buff, TStream(o).Size); - lStreamAsString := SerEnc.GetString(buff); - SetLength(buff, 0); - Result := TJSONString.Create(UTF8Encode(lStreamAsString)); - finally - SerEnc.Free; - end; - end - else - begin - // serialize the stream as Base64 encoded string... - TStream(o).Position := 0; - SS := TStringStream.Create; - try - TSerializerHelpers.EncodeStream(TStream(o), SS); - Result := TJSONString.Create(SS.DataString); - finally - SS.Free; - end; - end; + TJSONArray(OutputValue).AddElement(ObjectToJSONObject(Obj, [])); end + // else if o is TStream then + // begin + // if TSerializerHelpers.AttributeExists(ElementAttributes, _attrser) then + // begin + // // serialize the stream as a normal string... + // TStream(o).Position := 0; + // lEncodingName := _attrser.Encoding; + // SerEnc := TEncoding.GetEncoding(lEncodingName); + // try + // SetLength(buff, TStream(o).Size); + // TStream(o).Read(buff, TStream(o).Size); + // lStreamAsString := SerEnc.GetString(buff); + // SetLength(buff, 0); + // Result := TJSONString.Create(UTF8Encode(lStreamAsString)); + // finally + // SerEnc.Free; + // end; + // end + // else + // begin + // // serialize the stream as Base64 encoded string... + // TStream(o).Position := 0; + // SS := TStringStream.Create; + // try + // TSerializerHelpers.EncodeStream(TStream(o), SS); + // Result := TJSONString.Create(SS.DataString); + // finally + // SS.Free; + // end; + // end; + // end else begin - Result := ObjectToJSONObject(Value.AsObject, []); + OutputValue := ObjectToJSONObject(Value.AsObject, []); end; end else begin if TSerializerHelpers.HasAttribute(ElementType) then - Result := TJSONString.Create('') + OutputValue := TJSONString.Create('') else - Result := TJSONNull.Create; + OutputValue := TJSONNull.Create; end; end; // tkClass end; + Result := OutputValue <> nil; end; function TMVCJSONSerUnSer.SerializeTValueAsFixedNullableType(AValue: TValue; AValueTypeInfo: PTypeInfo): TJSONValue; @@ -710,7 +759,8 @@ begin else begin lTValueDataRTTIType := CTX.GetType(lValue.TypeInfo); - lJSONValue := SerializeRTTIElement(lTValueDataRTTIType, [], lValue); + if not SerializeRTTIElement(lTValueDataRTTIType, [], lValue, lJSONValue) then + raise EMVCSerializationException.Create('Cannot serialize TValue'); TJSONObject(Result).AddPair('type', TSerializerHelpers.GetTypeKindAsString(lValue.TypeInfo.Kind)); end; TJSONObject(Result).AddPair('value', lJSONValue); @@ -919,6 +969,65 @@ begin end; end; +function TMVCJSONSerUnSer.DeserializeEnumeration(ARTTIType: TRTTIType; AJSONValue: TJSONValue; + AItemName: String): TValue; +var + lOutputValue: TValue; +begin + if ARTTIType.QualifiedName = 'System.Boolean' then + begin + if AJSONValue is TJSONTrue then + Result := True + else if AJSONValue is TJSONFalse then + Result := false + else + raise EMapperException.CreateFmt('Invalid value for property %s', [AItemName]); + end + else // it is an enumerated value but it's not a boolean. + begin + TValue.Make((AJSONValue as TJSONNumber).AsInt, ARTTIType.Handle, lOutputValue); + Result := lOutputValue; + end; +end; + +function TMVCJSONSerUnSer.DeserializeFloat(ARTTIType: TRTTIType; AJSONValue: TJSONValue): TValue; +begin + if ARTTIType.QualifiedName = 'System.TDate' then + begin + if AJSONValue is TJSONNull then + Result := 0 + else + Result := ISOStrToDateTime(AJSONValue.Value + ' 00:00:00'); + end + else if ARTTIType.QualifiedName = 'System.TDateTime' then + begin + if AJSONValue is TJSONNull then + Result := 0 + else + Result := ISOStrToDateTime(AJSONValue.Value); + end + else if ARTTIType.QualifiedName = 'System.TTime' then + begin + if not(AJSONValue is TJSONNull) then + if AJSONValue is TJSONString then + Result := ISOStrToTime(AJSONValue.Value) + else + raise EMVCDeserializationException.CreateFmt + ('Cannot deserialize [%s], expected [%s] got [%s]', + [ARTTIType.QualifiedName, 'TJSONString', AJSONValue.ClassName]); + end + else { if _field.PropertyType.QualifiedName = 'System.Currency' then } + begin + if not(AJSONValue is TJSONNull) then + if AJSONValue is TJSONNumber then + Result := TJSONNumber(AJSONValue).AsDouble + else + raise EMVCDeserializationException.CreateFmt + ('Cannot deserialize [%s], expected [%s] got [%s]', + [ARTTIType.QualifiedName, 'TJSONNumber', AJSONValue.ClassName]); + end; +end; + procedure TMVCJSONSerUnSer.DeSerializeBase64StringStream(aStream: TStream; const aBase64SerializedString: string); begin @@ -926,38 +1035,41 @@ begin end; procedure TMVCJSONSerUnSer.DeserializeObject(ASerializedObject: string; AObject: TObject); -var - lJSON: TJSONValue; begin - lJSON := TJSONObject.ParseJSONValue(ASerializedObject); - try - if lJSON <> nil then - begin - if lJSON is TJSONObject then - begin - InternalJSONObjectToObject(TJSONObject(lJSON), AObject) - end - else - begin - raise EMVCDeserializationException.CreateFmt('Serialized string is a %s, expected JSON Object', - [lJSON.ClassName]); - end; - end - else - begin - raise EMVCDeserializationException.Create('Serialized string is not a valid JSON'); - end; - finally - lJSON.Free; - end; + InternalDeserializeObject(ASerializedObject, AObject, false); +end; + +procedure TMVCJSONSerUnSer.DeserializeObjectStrict(ASerializedObject: String; + AObject: TObject); +begin + InternalDeserializeObject(ASerializedObject, AObject, True); +end; + +function TMVCJSONSerUnSer.DeserializeRecord(ARTTIType: TRTTIType; AJSONValue: TJSONValue; + AAttributes: TArray; AItemName: String): TValue; +var + lJNumber: TJSONNumber; +begin + if ARTTIType.QualifiedName = 'System.Rtti.TValue' then + begin + Result := DeserializeTValue(AJSONValue, AAttributes, AItemName); + end + else if ARTTIType.QualifiedName = 'System.SysUtils.TTimeStamp' + then + begin + lJNumber := AJSONValue as TJSONNumber; + Result := TValue.From(MSecsToTimeStamp(lJNumber.AsInt64)); + end + else + raise EMVCDeserializationException.CreateFmt('Type %s not supported for %s', [ARTTIType.QualifiedName, AItemName]); end; initialization -TMVCSerUnSerRegistry.RegisterSerializer('application/json', TMVCJSONSerUnSer.Create); +TMVCSerializersRegistry.RegisterSerializer('application/json', TMVCJSONSerUnSer.Create); finalization -TMVCSerUnSerRegistry.UnRegisterSerializer('application/json'); +TMVCSerializersRegistry.UnRegisterSerializer('application/json'); end. diff --git a/sources/MVCFramework.TypesAliases.pas b/sources/MVCFramework.TypesAliases.pas index 63299b1c..205bac18 100644 --- a/sources/MVCFramework.TypesAliases.pas +++ b/sources/MVCFramework.TypesAliases.pas @@ -1,3 +1,27 @@ +// *************************************************************************** +// +// Delphi MVC Framework +// +// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team +// +// https://github.com/danieleteti/delphimvcframework +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + unit MVCFramework.TypesAliases; interface diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index 671b5733..55d41b88 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -345,7 +345,7 @@ type FContext: TWebContext; FResponseStream: TStringBuilder; FContentCharset: string; - FRenderer: IMVCSerUnSer; + FRenderer: IMVCSerializer; procedure SetContext(const Value: TWebContext); procedure SetWebSession(const Value: TWebSession); procedure SetContentType(const Value: string); @@ -353,7 +353,7 @@ type function GetWebSession: TWebSession; function GetContentCharset: string; procedure SetContentCharset(const Value: string); - function GetRenderer: IMVCSerUnSer; + function GetRenderer: IMVCSerializer; protected const CLIENTID_KEY = '__clientid'; protected @@ -451,7 +451,7 @@ type property Config: TMVCConfig read GetMVCConfig; property StatusCode: UInt16 read GetStatusCode write SetStatusCode; - property Renderer: IMVCSerUnSer read GetRenderer; + property Renderer: IMVCSerializer read GetRenderer; public // property ViewCache: TViewCache read FViewCache write SetViewCache; procedure PushJSONToView(const AModelName: string; AModel: TJSONValue); @@ -1982,12 +1982,12 @@ begin end; end; -function TMVCController.GetRenderer: IMVCSerUnSer; +function TMVCController.GetRenderer: IMVCSerializer; begin { TODO -oDaniele -cPluggableMapper : Check if the available renderer is compatible with the controller current content-type } if FRenderer = nil then begin - FRenderer := TMVCSerUnSerRegistry.GetSerUnSer(ContentType); + FRenderer := TMVCSerializersRegistry.GetSerializer(ContentType); end; Result := FRenderer; end; diff --git a/sources/ObjectsMappers.pas b/sources/ObjectsMappers.pas index b6e2aeed..8fa46112 100644 --- a/sources/ObjectsMappers.pas +++ b/sources/ObjectsMappers.pas @@ -49,7 +49,7 @@ uses {$ELSE} , Data.DBXJSON {$IFEND} - , MVCFramework.Patches + , MVCFramework.Patches, MVCFramework.Serializer.Commons ; type @@ -350,19 +350,20 @@ type end; - MapperSerializeAsString = class(TCustomAttribute) - strict private - FEncoding: string; - procedure SetEncoding(const Value: string); - - const - DefaultEncoding = 'utf8'; - private - function GetEncoding: string; - public - constructor Create(aEncoding: string = DefaultEncoding); - property Encoding: string read GetEncoding write SetEncoding; - end; + MapperSerializeAsString = MVCSerializeAsString; + // MapperSerializeAsString = class(TCustomAttribute) + // strict private + // FEncoding: string; + // procedure SetEncoding(const Value: string); + // + // const + // DefaultEncoding = 'utf8'; + // private + // function GetEncoding: string; + // public + // constructor Create(aEncoding: string = DefaultEncoding); + // property Encoding: string read GetEncoding write SetEncoding; + // end; MapperJSONNaming = class(TCustomAttribute) private @@ -3240,24 +3241,24 @@ begin LoadFromJSONObjectString(AJSONObjectString, TArray.Create()); end; -{ MapperSerializeAsString } - -constructor MapperSerializeAsString.Create(aEncoding: string); -begin - inherited Create; - FEncoding := aEncoding; -end; - -function MapperSerializeAsString.GetEncoding: string; -begin - if FEncoding.IsEmpty then - FEncoding := DefaultEncoding; - Result := FEncoding; -end; - -procedure MapperSerializeAsString.SetEncoding(const Value: string); -begin - FEncoding := Value; -end; +// { MapperSerializeAsString } +// +// constructor MapperSerializeAsString.Create(aEncoding: string); +// begin +// inherited Create; +// FEncoding := aEncoding; +// end; +// +// function MapperSerializeAsString.GetEncoding: string; +// begin +// if FEncoding.IsEmpty then +// FEncoding := DefaultEncoding; +// Result := FEncoding; +// end; +// +// procedure MapperSerializeAsString.SetEncoding(const Value: string); +// begin +// FEncoding := Value; +// end; end. diff --git a/unittests/Several/BOs.pas b/unittests/Several/BOs.pas index a59df150..9893fbe9 100644 --- a/unittests/Several/BOs.pas +++ b/unittests/Several/BOs.pas @@ -124,15 +124,18 @@ type FProp1: string; FChildObjectList: TMyChildObjectList; FChildObject: TMyChildObject; + FPropStringList: TStringList; procedure SetChildObject(const Value: TMyChildObject); procedure SetChildObjectList(const Value: TMyChildObjectList); procedure SetProp1(const Value: string); + procedure SetPropStringList(const Value: TStringList); public constructor Create; destructor Destroy; override; function Equals(Obj: TObject): boolean; override; property Prop1: string read FProp1 write SetProp1; + property PropStringList: TStringList read FPropStringList write SetPropStringList; property ChildObject: TMyChildObject read FChildObject write SetChildObject; property ChildObjectList: TMyChildObjectList read FChildObjectList write SetChildObjectList; @@ -190,6 +193,22 @@ type constructor Create(ID: Integer; Description: string); overload; end; + IMyInterface = interface + ['{B36E786B-5871-4211-88AD-365B453DC408}'] + function GetID: Integer; + function GetDescription: String; + end; + + TMyIntfObject = class(TInterfacedObject, IMyInterface) + private + FID: Integer; + FValue: string; + public + constructor Create(const ID: Integer; const Value: String); + function GetDescription: string; + function GetID: Integer; + end; + TResponseWrapper = class private FTotalItems: Integer; @@ -203,6 +222,16 @@ type destructor Destroy; override; end; + TObjectWithCustomType = class + private + FPropStringList: TStringList; + procedure SetPropStringList(const Value: TStringList); + public + constructor Create; virtual; + destructor Destroy; override; + property PropStringList: TStringList read FPropStringList write SetPropStringList; + end; + function GetMyObject: TMyObject; function GetMyObjectWithTValue: TMyObjectWithTValue; function GetMyObjectWithStream: TMyStreamObject; @@ -242,6 +271,11 @@ var begin Result := TMyComplexObject.Create; Result.Prop1 := 'property1'; + Result.PropStringList := TStringList.Create; + Result.PropStringList.Add('item 1'); + Result.PropStringList.Add('item 2'); + Result.PropStringList.Add('item 3'); + Result.PropStringList.Add('item 4'); Result.ChildObject.MyChildProperty1 := 'MySingleChildProperty1'; co := TMyChildObject.Create; co.MyChildProperty1 := 'MyChildProperty1'; @@ -392,6 +426,7 @@ destructor TMyComplexObject.Destroy; begin FChildObjectList.Free; FChildObject.Free; + FPropStringList.Free; inherited; end; @@ -441,6 +476,11 @@ begin FProp1 := Value; end; +procedure TMyComplexObject.SetPropStringList(const Value: TStringList); +begin + FPropStringList := Value; +end; + { TMyChildObject } constructor TMyChildObject.Create; @@ -642,4 +682,42 @@ begin FValueAsString := Value; end; +{ TMyIntfObject } + +constructor TMyIntfObject.Create(const ID: Integer; const Value: String); +begin + inherited Create; + FID := ID; + FValue := Value; +end; + +function TMyIntfObject.GetDescription: string; +begin + Result := FValue; +end; + +function TMyIntfObject.GetID: Integer; +begin + Result := FID; +end; + +{ TObjectWithCustomType } + +constructor TObjectWithCustomType.Create; +begin + inherited; + FPropStringList := TStringList.Create; +end; + +destructor TObjectWithCustomType.Destroy; +begin + FPropStringList.Free; + inherited; +end; + +procedure TObjectWithCustomType.SetPropStringList(const Value: TStringList); +begin + FPropStringList.Assign(Value); +end; + end. diff --git a/unittests/Several/DMVCFrameworkTests.dpr b/unittests/Several/DMVCFrameworkTests.dpr index aa5fb4f5..4cd95ca3 100644 --- a/unittests/Several/DMVCFrameworkTests.dpr +++ b/unittests/Several/DMVCFrameworkTests.dpr @@ -35,7 +35,8 @@ uses ObjectsMappers in '..\..\sources\ObjectsMappers.pas', MVCFramework.Serializer.Commons in '..\..\sources\MVCFramework.Serializer.Commons.pas', MVCFramework.TypesAliases in '..\..\sources\MVCFramework.TypesAliases.pas', - MVCFramework.Commons in '..\..\sources\MVCFramework.Commons.pas'; + MVCFramework.Commons in '..\..\sources\MVCFramework.Commons.pas', + MVCFramework.Serializer.JSON.CustomTypes in '..\..\sources\MVCFramework.Serializer.JSON.CustomTypes.pas'; {$R *.RES} diff --git a/unittests/Several/DMVCFrameworkTests.dproj b/unittests/Several/DMVCFrameworkTests.dproj index 4322a291..f1b23773 100644 --- a/unittests/Several/DMVCFrameworkTests.dproj +++ b/unittests/Several/DMVCFrameworkTests.dproj @@ -150,6 +150,7 @@ + Base @@ -254,7 +255,16 @@ true - + + + 0 + .dll;.bpl + + + 1 + .dylib + + Contents\Resources @@ -596,16 +606,7 @@ 1 - - - 0 - .dll;.bpl - - - 1 - .dylib - - + diff --git a/unittests/Several/FrameworkTestsU.pas b/unittests/Several/FrameworkTestsU.pas index 4e5177f9..521659ea 100644 --- a/unittests/Several/FrameworkTestsU.pas +++ b/unittests/Several/FrameworkTestsU.pas @@ -32,7 +32,7 @@ uses System.Generics.Collections, BOs, MVCFramework, Data.DB, System.SysUtils, MVCFramework.JWT, - MVCFramework.Serializer.Intf; + MVCFramework.Serializer.Intf, MVCFramework.MultiMap; type TTestMappers = class(TTestCase) @@ -112,14 +112,14 @@ type check 'SerializationFrameworkTestU.pas' } TMVCSerUnSerTestCase = class abstract(TTestCase) private - FSerUnSer: IMVCSerUnSer; + FSerializer: IMVCSerializer; protected - procedure SetSerUnSer(const SerUnSer: IMVCSerUnSer); + procedure SetSerializer(const ASerializer: IMVCSerializer); procedure SetUp; override; function GetObjectsList: TObjectList; function GetObjectsWithStreamsList: TObjectList; function GetObjectsWithTValueList: TObjectList; - property SerUnSer: IMVCSerUnSer read FSerUnSer; + property Serializer: IMVCSerializer read FSerializer; published procedure TestSerUnSerObject; virtual; abstract; procedure TestSerUnSerObjectList; virtual; abstract; @@ -127,6 +127,19 @@ type procedure TestSerUnSerObjectListWithStream; virtual; abstract; procedure TestSerUnSerObjectWithTValue; virtual; abstract; procedure TestSerUnSerObjectListWithTValue; virtual; abstract; + procedure TestSerUnSerObjectStrict; virtual; abstract; + procedure TestSerUnSerObjectBuiltInCustomTypes; virtual; abstract; + end; + + TTestMultiMap = class(TTestCase) + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestObjectMultiMapAdd; + procedure TestObjectMultiMapRemove; + procedure TestInterfaceMultiMapAdd; + procedure TestInterfaceMultiMapRemove; end; implementation @@ -1500,9 +1513,9 @@ begin end; end; -procedure TMVCSerUnSerTestCase.SetSerUnSer(const SerUnSer: IMVCSerUnSer); +procedure TMVCSerUnSerTestCase.SetSerializer(const ASerializer: IMVCSerializer); begin - FSerUnSer := SerUnSer; + FSerializer := ASerializer; end; procedure TMVCSerUnSerTestCase.SetUp; @@ -1510,11 +1523,94 @@ begin raise Exception.Create('You should override this to use a specific MVCSerUnSer'); end; +{ TTestMultiMap } + +procedure TTestMultiMap.SetUp; +begin + inherited; + +end; + +procedure TTestMultiMap.TearDown; +begin + inherited; + +end; + +procedure TTestMultiMap.TestInterfaceMultiMapAdd; +var + lMultiMap: IMVCInterfaceMultiMap; +begin + lMultiMap := TMVCInterfaceMultiMap.Create; + CheckEquals(0, Length(lMultiMap.Keys)); + lMultiMap.Clear; + CheckFalse(lMultiMap.Contains('key1')); + lMultiMap.Add('key1', TMyIntfObject.Create(1, 'value1')); + CheckTrue(lMultiMap.Contains('key1')); + CheckEquals(1, lMultiMap.GetItems('key1').Count); + lMultiMap.Add('key1', TMyIntfObject.Create(2, 'value2')); + CheckEquals(2, lMultiMap.GetItems('key1').Count); + CheckEquals('value1', lMultiMap.GetItems('key1')[0].GetDescription); + CheckEquals('value2', lMultiMap.GetItems('key1')[1].GetDescription); + lMultiMap.Add('key2', TMyIntfObject.Create(1, 'value3')); + CheckEquals(2, lMultiMap.GetItems('key1').Count); + CheckEquals(1, lMultiMap.GetItems('key2').Count); +end; + +procedure TTestMultiMap.TestInterfaceMultiMapRemove; +var + lMultiMap: IMVCInterfaceMultiMap; +begin + lMultiMap := TMVCInterfaceMultiMap.Create; + lMultiMap.Remove('not valid'); + lMultiMap.Add('key1', TMyIntfObject.Create(1, 'value1')); + lMultiMap.Add('key1', TMyIntfObject.Create(2, 'value2')); + CheckEquals(2, lMultiMap.GetItems('key1').Count); + CheckTrue(lMultiMap.Contains('key1')); + lMultiMap.Remove('key1'); + CheckFalse(lMultiMap.Contains('key1')); +end; + +procedure TTestMultiMap.TestObjectMultiMapAdd; +var + lMultiMap: IMVCObjectMultiMap; +begin + lMultiMap := TMVCObjectMultiMap.Create; + CheckEquals(0, Length(lMultiMap.Keys)); + lMultiMap.Clear; + CheckFalse(lMultiMap.Contains('key1')); + lMultiMap.Add('key1', TMyClass.Create(1, 'value1')); + CheckTrue(lMultiMap.Contains('key1')); + CheckEquals(1, lMultiMap.GetItems('key1').Count); + lMultiMap.Add('key1', TMyClass.Create(2, 'value2')); + CheckEquals(2, lMultiMap.GetItems('key1').Count); + CheckEquals('value1', lMultiMap.GetItems('key1')[0].Description); + CheckEquals('value2', lMultiMap.GetItems('key1')[1].Description); + lMultiMap.Add('key2', TMyClass.Create(1, 'value3')); + CheckEquals(2, lMultiMap.GetItems('key1').Count); + CheckEquals(1, lMultiMap.GetItems('key2').Count); +end; + +procedure TTestMultiMap.TestObjectMultiMapRemove; +var + lMultiMap: IMVCObjectMultiMap; +begin + lMultiMap := TMVCObjectMultiMap.Create; + lMultiMap.Remove('not valid'); + lMultiMap.Add('key1', TMyClass.Create(1, 'value1')); + lMultiMap.Add('key1', TMyClass.Create(2, 'value2')); + CheckEquals(2, lMultiMap.GetItems('key1').Count); + CheckTrue(lMultiMap.Contains('key1')); + lMultiMap.Remove('key1'); + CheckFalse(lMultiMap.Contains('key1')); +end; + initialization RegisterTest(TTestRouting.suite); RegisterTest(TTestMappers.suite); RegisterTest(TTestJWT.suite); +RegisterTest(TTestMultiMap.suite); finalization diff --git a/unittests/Several/SerializationFrameworkTestsU.pas b/unittests/Several/SerializationFrameworkTestsU.pas index e81083ef..13b8b3a7 100644 --- a/unittests/Several/SerializationFrameworkTestsU.pas +++ b/unittests/Several/SerializationFrameworkTestsU.pas @@ -45,6 +45,8 @@ type procedure TestSerUnSerObjectListWithStream; override; procedure TestSerUnSerObjectWithTValue; override; procedure TestSerUnSerObjectListWithTValue; override; + procedure TestSerUnSerObjectStrict; override; + procedure TestSerUnSerObjectBuiltInCustomTypes; override; end; implementation @@ -55,11 +57,20 @@ implementation uses BOs, MVCFramework.Serializer.JSON, MVCFramework.DuckTyping, System.Classes, Winapi.Windows; +function GetMyObjectWithCustomType: TObjectWithCustomType; +begin + Result := TObjectWithCustomType.Create; + Result.PropStringList.Add('item 1'); + Result.PropStringList.Add('item 2'); + Result.PropStringList.Add('item 3'); + Result.PropStringList.Add('item 4'); +end; + { TTestJSONSerializer } procedure TTestJSONSerializer.SetUp; begin - SetSerUnSer(TMVCJSONSerUnSer.Create); + SetSerializer(TMVCJSONSerUnSer.Create); end; procedure TTestJSONSerializer.TestSerUnSerObject; @@ -70,10 +81,31 @@ var begin Obj := GetMyObject; try - JSON := SerUnSer.SerializeObject(Obj, []); + JSON := Serializer.SerializeObject(Obj, []); Obj2 := TMyObject.Create; try - SerUnSer.DeserializeObject(JSON, Obj2); + Serializer.DeserializeObject(JSON, Obj2); + CheckTrue(Obj.Equals(Obj2)); + finally + Obj2.Free; + end; + finally + Obj.Free; + end; +end; + +procedure TTestJSONSerializer.TestSerUnSerObjectBuiltInCustomTypes; +var + Obj: TObjectWithCustomType; + JSON: string; + Obj2: TObjectWithCustomType; +begin + Obj := GetMyObjectWithCustomType; + try + JSON := Serializer.SerializeObject(Obj, []); + Obj2 := TObjectWithCustomType.Create; + try + Serializer.DeserializeObject(JSON, Obj2); CheckTrue(Obj.Equals(Obj2)); finally Obj2.Free; @@ -91,10 +123,10 @@ var begin ObjList := GetObjectsList; try - lJSON := SerUnSer.SerializeCollection(ObjList, []); + lJSON := Serializer.SerializeCollection(ObjList, []); Obj2List := TObjectList.Create(True); try - SerUnSer.DeserializeCollection(lJSON, WrapAsList(Obj2List), TMyObject); + Serializer.DeserializeCollection(lJSON, WrapAsList(Obj2List), TMyObject); CheckEquals(ObjList.Count, Obj2List.Count); for I := 0 to 9 do begin @@ -116,10 +148,10 @@ var begin ObjList := GetObjectsWithStreamsList; try - lJSON := SerUnSer.SerializeCollection(ObjList, []); + lJSON := Serializer.SerializeCollection(ObjList, []); Obj2List := TObjectList.Create(True); try - SerUnSer.DeserializeCollection(lJSON, WrapAsList(Obj2List), TMyStreamObject); + Serializer.DeserializeCollection(lJSON, WrapAsList(Obj2List), TMyStreamObject); CheckEquals(ObjList.Count, Obj2List.Count); for I := 0 to 9 do begin @@ -141,10 +173,10 @@ var begin ObjList := GetObjectsWithTValueList; try - lJSON := SerUnSer.SerializeCollection(ObjList, []); + lJSON := Serializer.SerializeCollection(ObjList, []); Obj2List := TObjectList.Create(True); try - SerUnSer.DeserializeCollection(lJSON, WrapAsList(Obj2List), TMyObjectWithTValue); + Serializer.DeserializeCollection(lJSON, WrapAsList(Obj2List), TMyObjectWithTValue); CheckEquals(ObjList.Count, Obj2List.Count); for I := 0 to 9 do begin @@ -158,6 +190,27 @@ begin end; end; +procedure TTestJSONSerializer.TestSerUnSerObjectStrict; +var + Obj: TMyObject; + JSON: string; + Obj2: TMyObject; +begin + Obj := GetMyObject; + try + JSON := Serializer.SerializeObjectStrict(Obj); + Obj2 := TMyObject.Create; + try + Serializer.DeserializeObjectStrict(JSON, Obj2); + CheckTrue(Obj.Equals(Obj2)); + finally + Obj2.Free; + end; + finally + Obj.Free; + end; +end; + procedure TTestJSONSerializer.TestSerUnSerObjectWithStream; var Obj: TMyStreamObject; @@ -169,10 +222,10 @@ begin Obj := GetMyObjectWithStream; try // ACT - JSON := SerUnSer.SerializeObject(Obj, []); + JSON := Serializer.SerializeObject(Obj, []); Obj2 := TMyStreamObject.Create; try - SerUnSer.DeserializeObject(JSON, Obj2); + Serializer.DeserializeObject(JSON, Obj2); // ASSERT CheckEquals('This is an UTF16 String', TStringStream(Obj2.PropStream).DataString); CheckEquals('This is an UTF8 String', TStringStream(Obj2.Prop8Stream).DataString); @@ -194,10 +247,10 @@ var begin lObj := GetMyObjectWithTValue; try - JSON := SerUnSer.SerializeObject(lObj, []); + JSON := Serializer.SerializeObject(lObj, []); Obj2 := TMyObjectWithTValue.Create; try - SerUnSer.DeserializeObject(JSON, Obj2); + Serializer.DeserializeObject(JSON, Obj2); CheckTrue(lObj.Equals(Obj2)); finally Obj2.Free; diff --git a/unittests/TestServer/TestServer.dproj b/unittests/TestServer/TestServer.dproj index 13e4bf17..d00853c3 100644 --- a/unittests/TestServer/TestServer.dproj +++ b/unittests/TestServer/TestServer.dproj @@ -218,16 +218,7 @@ true - - - 0 - .dll;.bpl - - - 1 - .dylib - - + Contents\Resources @@ -567,7 +558,16 @@ 1 - + + + 0 + .dll;.bpl + + + 1 + .dylib + +