// *************************************************************************** // // Delphi MVC Framework // // Copyright (c) 2010-2024 Daniele Teti and the DMVCFramework Team // // https://github.com/danieleteti/delphimvcframework // // Collaborators with this file: Ezequiel Juliano M�ller (ezequieljuliano@gmail.com) // // *************************************************************************** // // 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.JsonDataObjects; {$I dmvcframework.inc} {$WARN SYMBOL_DEPRECATED OFF} interface uses System.Classes, System.Rtti, System.TypInfo, System.Variants, System.Generics.Collections, Data.SqlTimSt, Data.FmtBcd, Data.DB, MVCFramework.Commons, MVCFramework.Serializer.Intf, MVCFramework.Serializer.Abstract, MVCFramework.DuckTyping, MVCFramework.Serializer.Commons, System.JSON, JsonDataObjects, System.SysUtils; type TMVCDataSetField = record FieldName: string; DataType: TFieldType; I: Integer; end; TMVCDataSetFields = TList; TJSONObjectHelper = class helper for TJsonObject public procedure LoadFromString(const Value: string; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); end; TMVCJsonDataObjectsSerializer = class(TMVCAbstractSerializer, IMVCSerializer, IMVCJSONSerializer) private fStringDictionarySerializer: IMVCTypeSerializer; function TryMapNullableFloat(var Value: TValue; const JSONDataObject: TJsonObject; const AttribName: string): Boolean; type TFieldMetaInfo = record NameAs: String; Ignored: Boolean; end; TSerializationMetaInfo = record FieldsMetaInfo: TArray; IgnoredFields: TMVCIgnoredList; NameCase: TMVCNameCase; class function CreateFieldsMetaInfo( const ADataSet: TDataSet; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList): TSerializationMetaInfo; static; end; public procedure ParseStringAsTValueUsingMetadata( const AStringValue: String; const DestinationTypeInfo: PTypeInfo; const ExceptionHintString: String; const AAttributes: TArray; var AValue: TValue); function JSONObjectToRecord(const JSONObject: TJsonObject): T; overload; function StrToRecord(const AJSONString: String): T; procedure JSONObjectToNestedRecordField(const JSONObject: TJsonObject; RecordFieldRTTIType: TRttiField; const TypeOffset: Integer; var Buffer: PByte); procedure JSONObjectToNestedRecordFieldStatic(const JSONObject: TJsonObject; RecordFieldRTTIType: TRttiField; const TypeOffset: Integer; var Buffer: PByte); procedure JSONObjectPropertyToTValueForRecord(AJSONObject: TJsonObject; const APropertyName: String; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; var AValue: TValue; const ACustomAttributes: TArray; const ARTTIField: TRttiField); function GetDataSetFields(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs): TMVCDataSetFields; 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 Links: IMVCLinks; const Serializer: IMVCTypeSerializer); procedure InternalRecordToJsonObject(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AJSONObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction; const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); procedure InternalTValueToJsonObject(const AValue: TValue; const AJSONObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction; const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); function ConvertObjectToJsonValue(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredFields: TMVCIgnoredList; const ADataSetSerializationCallback: TMVCDataSetFieldSerializationAction; const ASerializationAction: TMVCSerializationAction; out AJsonDataType: TJsonDataType): TJsonBaseObject; function ConvertRecordToJsonValue(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ADataSetSerializationCallback: TMVCDataSetFieldSerializationAction; const ASerializationAction: TMVCSerializationAction; out AJsonDataType: TJsonDataType): TJsonBaseObject; procedure AddTValueToJsonArray(const Value: TValue; const JSON: TJDOJsonArray); procedure ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction = nil); procedure TValueToJSONObjectProperty(const AJSONObject: TJDOJsonObject; const AName: string; const AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); function TryNullableToJSON(const AValue: TValue; const AJSONObject: TJDOJsonObject; const AName: string; const ACustomAttributes: TArray): Boolean; procedure JsonObjectToObject(const AJSONObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); procedure JSONObjectToRecord(const JSONObject: TJsonObject; RTTIType: TRttiRecordType; out Buffer: PByte); overload; procedure JSONObjectToRecordStatic(const JSONObject: TJsonObject; RTTIType: TRttiRecordType; var Buffer: PByte); procedure JSONObjectPropertyToTValue(AJSONObject: TJsonObject; const APropertyName: String; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; var ChildObject: TObject; var AValue: TValue; const ACustomAttributes: TArray); procedure JsonDataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember; const AJSONObject: TJDOJsonObject; const AName: string; var AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); procedure JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); procedure DataSetToJsonObject(const ADataSet: TDataSet; const AJSONObject: TJDOJsonObject; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields; const ASerializationCallback: TMVCDataSetFieldSerializationAction = nil); procedure DataSetRowToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields); procedure DataSetToJsonArray(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ASerializationCallback: TMVCDataSetFieldSerializationAction = nil); procedure DataSetToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList); procedure JsonObjectToDataSet(const AJSONObject: TJDOJsonObject; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); overload; procedure JsonObjectToDataSet(const AJSONObject: TJDOJsonObject; const ADataSet: TDataSet; const SerializationMetaInfo: TSerializationMetaInfo); overload; procedure JsonArrayToDataSet(const AJsonArray: TJDOJsonArray; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); function JsonArrayToArray(const AJsonArray: TJDOJsonArray): TValue; { IMVCSerializer } function SerializeObject(const AObject: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil): string; overload; function SerializeArrayOfRecord( var ATValueContainingAnArray: TValue; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil ): string; overload; procedure RecordToJsonObject(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AJSONObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); function SerializeObjectToJSON(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): TJDOJsonObject; function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string; function SerializeDataSetRecord(const DataSet: TDataSet; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase = ncAsIs; const SerializationAction: TMVCDatasetSerializationAction = nil): string; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ARootNode: string = ''); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []); overload; procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ARootNode: string = ''); overload; procedure DeserializeCollection(const ASerializedList: string; const AList: IInterface; const AClazz: TClass; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []); overload; procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs); procedure InternalSerializeDataSet(const ADataSet: TDataSet; const AJsonArray: TJsonArray; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction); procedure InternalSerializeDataSetRecord(const DataSet: TDataSet; const JSONObject: TJsonObject; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase; const SerializationAction: TMVCDatasetSerializationAction); procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs); class function ParseObject(const AString: string): TJDOJsonObject; class function ParseArray(const AString: string): TJDOJsonArray; class function Parse(const AString: string): T; public procedure AfterConstruction; override; end; TJDOLinks = class(TMVCLinks) public procedure FillJSONArray(const AJsonArray: TJsonArray); end; TJSONUtils = record private class function JSONObjectToRecord(const JSONObject: TJsonObject; const Serializer: TMVCJsonDataObjectsSerializer): T; overload; static; inline; public // records class function JSONObjectToRecord(const JSONObject: TJsonObject): T; overload; static; class function JSONArrayToArrayOfRecord(const JSONArray: TJsonArray): TArray; overload; static; // objects class function JsonObjectToObject(const JSONObject: TJsonObject): T; overload; static; class function JSONArrayToListOf(const JSONArray: TJsonArray): TObjectList; overload; static; end; procedure TValueToJSONObjectPropertyEx(const Value: TValue; const JSON: TJDOJsonObject; const KeyName: string); function StrToJSONObject(const AValue: string; ARaiseExceptionOnError: Boolean = False): TJDOJsonObject; inline; function StrToJSONArray(const AValue: string; ARaiseExceptionOnError: Boolean = False): TJDOJsonArray; inline; procedure JsonObjectToObject(const AJSONObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); overload; procedure JsonObjectToObject(const AJSONObject: TJDOJsonObject; const AObject: TObject); overload; procedure JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); const JDO_TYPE_DESC: array [TJsonDataType.jdtNone .. TJsonDataType.jdtObject] of string = ('None', 'String', 'Int', 'Long', 'ULong', 'Float', 'DateTime', 'UtcDateTime', 'Bool', 'Array', 'Object'); implementation uses MVCFramework.Serializer.JsonDataObjects.CustomTypes, MVCFramework.Logger, MVCFramework.DataSet.Utils, MVCFramework.Nullables; function SelectRootNodeOrWholeObject(const RootNode: string; const JSONObject: TJsonObject): TJsonObject; inline; begin if RootNode.IsEmpty then begin Result := JSONObject end else begin Result := JSONObject.O[RootNode]; end; end; { TMVCJsonDataObjectsSerializer } procedure TMVCJsonDataObjectsSerializer.AfterConstruction; var lStreamSerializer: IMVCTypeSerializer; lDataSetHolderSerializer: TMVCDataSetHolderSerializer; fObjectDictionarySerializer: TMVCObjectDictionarySerializer; begin inherited AfterConstruction; lDataSetHolderSerializer := TMVCDataSetHolderSerializer.Create; GetTypeSerializers.Add(TypeInfo(TDataSetHolder), lDataSetHolderSerializer); lStreamSerializer := TMVCStreamSerializerJsonDataObject.Create; GetTypeSerializers.Add(TypeInfo(TStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TStringStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TFileStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TMemoryStream), lStreamSerializer); fStringDictionarySerializer := TMVCStringDictionarySerializer.Create; GetTypeSerializers.Add(TypeInfo(TMVCStringDictionary), fStringDictionarySerializer); GetTypeSerializers.Add(TypeInfo(TGUID), TMVCGUIDSerializer.Create); fObjectDictionarySerializer := TMVCObjectDictionarySerializer.Create(self); GetTypeSerializers.Add(TypeInfo(TMVCObjectDictionary), fObjectDictionarySerializer); GetTypeSerializers.Add(TypeInfo(TMVCListOfString { TList } ), TMVCListOfStringSerializer.Create); GetTypeSerializers.Add(TypeInfo(TMVCListOfInteger { TList } ), TMVCListOfIntegerSerializer.Create); GetTypeSerializers.Add(TypeInfo(TMVCListOfBoolean { TList } ), TMVCListOfBooleanSerializer.Create); GetTypeSerializers.Add(TypeInfo(TMVCListOfDouble { TList } ), TMVCListOfDoubleSerializer.Create); end; procedure TMVCJsonDataObjectsSerializer.TValueToJSONObjectProperty(const AJSONObject: TJDOJsonObject; const AName: string; const AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); var ChildJsonObject: TJDOJsonObject; ChildValue: TValue; ChildObject, Obj: TObject; ValueTypeAtt: MVCValueAsTypeAttribute; CastValue, CastedValue: TValue; I: Integer; LEnumAsAttr: MVCEnumSerializationAttribute; LEnumSerType: TMVCEnumSerializationType; LEnumMappedValues: TList; LEnumName: string; lJSONValue: TJsonBaseObject; lJsonDataType: TJsonDataType; lTypeInfo: PTypeInfo; lBuffer: Pointer; lCurrentArrayItem: TValue; begin if SameText(AName, 'RefCount') then begin Exit; end; if AValue.IsEmpty then begin if AValue.IsArray then begin AJSONObject.A[AName] := TJDOJsonArray.Create; end else begin if MVCSerializeNulls then begin AJSONObject[AName] := Null; end; end; Exit; end; lTypeInfo := AValue.TypeInfo; // AValue.TypeInfo does not show the correct TypeInfo of the class instantiated for the object or interface ChildObject := nil; if AValue.Kind in [tkClass, tkInterface] then begin if not AValue.IsEmpty and (AValue.Kind = tkInterface) then ChildObject := TObject(AValue.AsInterface) else if AValue.Kind = tkClass then ChildObject := AValue.AsObject; if Assigned(ChildObject) then lTypeInfo := ChildObject.ClassInfo; end; if GetTypeSerializers.ContainsKey(lTypeInfo) then begin GetTypeSerializers.Items[lTypeInfo].SerializeAttribute(AValue, AName, AJSONObject, ACustomAttributes); Exit; end; case AValue.Kind of tkInteger: AJSONObject.I[AName] := AValue.AsInteger; tkInt64: AJSONObject.L[AName] := AValue.AsInt64; tkChar, tkString, tkWChar, tkLString, tkWString, tkUString: AJSONObject.S[AName] := AValue.AsString; tkFloat: begin if (AValue.TypeInfo = System.TypeInfo(TDate)) then begin if (AValue.AsExtended = 0) then AJSONObject[AName] := Null else AJSONObject.S[AName] := DateToISODate(AValue.AsExtended); end else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then begin if (AValue.AsExtended = 0) then AJSONObject[AName] := Null else AJSONObject.S[AName] := DateTimeToISOTimeStamp(AValue.AsExtended); end else if (AValue.TypeInfo = System.TypeInfo(TTime)) then begin if (AValue.AsExtended = 0) then AJSONObject[AName] := Null else AJSONObject.S[AName] := TimeToISOTime(AValue.AsExtended); end else AJSONObject.F[AName] := AValue.AsExtended; end; tkVariant: AJSONObject[AName] := AValue.AsVariant; tkEnumeration: begin if (AValue.TypeInfo = System.TypeInfo(Boolean)) then begin if AValue.AsBoolean then AJSONObject.B[AName] := True else AJSONObject.B[AName] := False end else begin LEnumSerType := estEnumName; LEnumMappedValues := nil; if TMVCSerializerHelper.AttributeExists(ACustomAttributes, LEnumAsAttr) then begin LEnumSerType := LEnumAsAttr.SerializationType; LEnumMappedValues := LEnumAsAttr.MappedValues; end; case LEnumSerType of estEnumName: begin LEnumName := GetEnumName(AValue.TypeInfo, AValue.AsOrdinal); AJSONObject.S[AName] := LEnumName; end; estEnumOrd: begin AJSONObject.I[AName] := AValue.AsOrdinal; end; estEnumMappedValues: begin if (LEnumMappedValues.Count - 1) < AValue.AsOrdinal then raise EMVCException.Create('Enumerator value is not mapped in MappedValues'); AJSONObject.S[AName] := LEnumMappedValues[AValue.AsOrdinal]; end; end; end; end; tkClass, tkInterface: begin if Assigned(ChildObject) then begin lJSONValue := ConvertObjectToJsonValue(ChildObject, GetSerializationType(ChildObject, AType), AIgnored, nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin AJSONObject.A[AName] := TJsonArray(lJSONValue); end; jdtObject: begin AJSONObject.O[AName] := TJsonObject(lJSONValue); end else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Data Type'); end; end; end else begin if TMVCSerializerHelper.AttributeExists(ACustomAttributes) then AJSONObject.S[AName] := EmptyStr else AJSONObject[AName] := Null; end; end; tkRecord: begin if AValue.TypeInfo.NameFld.ToString.StartsWith('Nullable') then begin if TryNullableToJSON(AValue, AJSONObject, AName, ACustomAttributes) then begin Exit; end; end; if (AValue.TypeInfo = System.TypeInfo(TTimeStamp)) then begin AJSONObject.F[AName] := TimeStampToMsecs(AValue.AsType); end else if (AValue.TypeInfo = System.TypeInfo(TValue)) then begin if TMVCSerializerHelper.AttributeExists(ACustomAttributes, ValueTypeAtt) then begin CastValue := AValue.AsType; if CastValue.TryCast(ValueTypeAtt.ValueTypeInfo, CastedValue) then begin TValueToJSONObjectProperty(AJSONObject, AName, CastedValue, stDefault, [], []) end else begin RaiseSerializationError (Format('Cannot serialize property or field "%s" of TypeKind tkRecord (TValue with MVCValueAsTypeAttribute)', [AName])); end; end else begin ChildValue := AValue.AsType; ChildJsonObject := AJSONObject.O[AName]; ChildJsonObject.S['type'] := TMVCSerializerHelper.GetTypeKindAsString(ChildValue.TypeInfo.Kind); TValueToJSONObjectProperty(ChildJsonObject, 'value', ChildValue, stDefault, [], []); end; end else begin lJSONValue := ConvertRecordToJsonValue(AValue.GetReferenceToRawData, AValue.TypeInfo, stFields, AIgnored, nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin AJSONObject.A[AName] := TJsonArray(lJSONValue); end; jdtObject: begin AJSONObject.O[AName] := TJsonObject(lJSONValue); end else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Data Type'); end; end; end; end; tkSet: begin {$IF defined(BERLINORBETTER)} lBuffer := AllocMem(AValue.DataSize); try AValue.ExtractRawDataNoCopy(lBuffer); AJSONObject.S[AName] := SetToString(AValue.TypeInfo, lBuffer); finally FreeMem(lBuffer) end; {$ELSE} raise EMVCSerializationException.CreateFmt ('Cannot serialize property or field "%s" of TypeKind tkSet in this Delphi version.', [AName]); {$ENDIF} end; tkArray, tkDynArray: begin if AValue.GetArrayLength > 0 then begin for I := 0 to AValue.GetArrayLength - 1 do begin lCurrentArrayItem := AValue.GetArrayElement(I); case lCurrentArrayItem.Kind of tkChar, tkString, tkWChar, tkLString, tkWString, tkUString: AJSONObject.A[AName].Add(lCurrentArrayItem.AsString); tkInteger: AJSONObject.A[AName].Add(lCurrentArrayItem.AsInteger); tkInt64: AJSONObject.A[AName].Add(lCurrentArrayItem.AsInt64); tkFloat: begin if lCurrentArrayItem.TypeInfo = TypeInfo(TDate) then begin AJSONObject.A[AName].Add(DateToISODate(lCurrentArrayItem.AsExtended)); end else if lCurrentArrayItem.TypeInfo = TypeInfo(TTime) then begin AJSONObject.A[AName].Add(TimeToISOTime(lCurrentArrayItem.AsExtended)); end else if lCurrentArrayItem.TypeInfo = TypeInfo(TDateTime) then begin AJSONObject.A[AName].Add(DateTimeToISOTimeStamp(lCurrentArrayItem.AsExtended)); end else begin AJSONObject.A[AName].Add(lCurrentArrayItem.AsExtended); end; end; tkEnumeration: AJSONObject.A[AName].Add(lCurrentArrayItem.AsBoolean); tkClass: begin Obj := lCurrentArrayItem.AsObject; if Obj = nil then begin AJSONObject.A[AName].Add(TJsonObject(nil)); end else begin lJSONValue := ConvertObjectToJsonValue(Obj, GetSerializationType(Obj), [], nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin AJSONObject.A[AName].Add(TJsonArray(lJSONValue)); end; jdtObject: begin AJSONObject.A[AName].Add(TJsonObject(lJSONValue)); end; else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Type for ' + AName); end; end; end; end; tkRecord: begin if lCurrentArrayItem.IsEmpty then begin AJSONObject.A[AName].Add(TJsonObject(nil)); end else begin lJSONValue := ConvertRecordToJsonValue(AValue.GetReferenceToRawArrayElement(I), lCurrentArrayItem.TypeInfo, stFields, [], nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin AJSONObject.A[AName].Add(TJsonArray(lJSONValue)); end; jdtObject: begin AJSONObject.A[AName].Add(TJsonObject(lJSONValue)); end; else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Type for ' + AName); end; end; end; end; else begin raise EMVCSerializationException.CreateFmt('Cannot serialize property or field "%s"', [AName]); end; end; end; end; end; tkUnknown: raise EMVCSerializationException.CreateFmt ('Cannot serialize property or field "%s" of TypeKind tkUnknown.', [AName]); end; end; function TMVCJsonDataObjectsSerializer.ConvertObjectToJsonValue(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredFields: TMVCIgnoredList; const ADataSetSerializationCallback: TMVCDataSetFieldSerializationAction; const ASerializationAction: TMVCSerializationAction; out AJsonDataType: TJsonDataType): TJsonBaseObject; var lList: IMVCList; I: Integer; lValue: TValue; lObj: TObject; lJSONValue: TJsonBaseObject; lJsonDataType: TJsonDataType; lLinks: IMVCLinks; begin Result := nil; try if AObject is TDataSet then begin Result := TJsonArray.Create; AJsonDataType := jdtArray; DataSetToJsonArray(TDataSet(AObject), TJsonArray(Result), TMVCNameCase.ncLowerCase, [], ADataSetSerializationCallback); end else if AObject is TJsonObject then begin AJsonDataType := jdtObject; Result := TJsonObject(TJsonObject(AObject).Clone); end else if AObject is TJsonArray then begin AJsonDataType := jdtArray; Result := TJsonArray(TJsonArray(AObject).Clone); end else if AObject = nil then begin AJsonDataType := jdtObject; Result := nil; end else begin lList := TDuckTypedList.Wrap(AObject); if Assigned(lList) then begin Result := TJsonArray.Create; // ChildJsonArray := AJsonObject.A[AName]; AJsonDataType := jdtArray; for I := 0 to lList.Count - 1 do begin if lList.ItemIsObject(I, lValue) then begin lObj := lValue.AsObject; // ChildList.GetItem(I); if Assigned(lObj) then begin lJSONValue := ConvertObjectToJsonValue(lObj, GetSerializationType(lObj, AType), AIgnoredFields, nil, ASerializationAction, lJsonDataType); case lJsonDataType of jdtObject: begin TJsonArray(Result).Add(TJsonObject(lJSONValue)); end; jdtArray: begin TJsonArray(Result).Add(TJsonArray(lJSONValue)); end; else begin RaiseSerializationError('Invalid JSON type'); end; end; end else begin TJsonArray(Result).Add(TJsonObject(nil)); end; end else begin AddTValueToJsonArray(lValue, TJsonArray(Result)); end; end; end else begin Result := TJsonObject.Create; AJsonDataType := jdtObject; lLinks := TMVCLinks.Create; InternalObjectToJsonObject(AObject, TJsonObject(Result), GetSerializationType(AObject, AType), AIgnoredFields, ASerializationAction, lLinks, nil); end; end; except FreeAndNil(Result); raise; end; end; function TMVCJsonDataObjectsSerializer.ConvertRecordToJsonValue(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ADataSetSerializationCallback: TMVCDataSetFieldSerializationAction; const ASerializationAction: TMVCSerializationAction; out AJsonDataType: TJsonDataType): TJsonBaseObject; var lLinks: IMVCLinks; begin Result := nil; try if ARecord = nil then begin AJsonDataType := jdtObject; Result := nil; end else begin Result := TJsonObject.Create; AJsonDataType := jdtObject; lLinks := TMVCLinks.Create; InternalRecordToJsonObject(ARecord, ARecordTypeInfo, TJsonObject(Result), stFields, AIgnoredAttributes, ASerializationAction, lLinks, nil); end; except FreeAndNil(Result); raise; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetRowToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields); var lMS: TMemoryStream; lSS: TStringStream; lNestedDataSet: TDataSet; lChildJsonArray: TJDOJsonArray; lField: TMVCDataSetField; lDataSetFieldsDetail: TMVCDataSetFields; begin Assert(Assigned(ADataSetFields)); for lField in ADataSetFields do begin begin if ADataSet.Fields[lField.I].IsNull then begin AJsonArray.Add(TJsonObject(nil)); end else begin case lField.DataType of ftBoolean: AJsonArray.Add(ADataSet.Fields[lField.I].AsBoolean); ftInteger, ftSmallint, ftShortint, ftByte: AJsonArray.Add(ADataSet.Fields[lField.I].AsInteger); ftLargeint, ftAutoInc, ftLongword: AJsonArray.Add(ADataSet.Fields[lField.I].AsLargeInt); {$IFDEF TOKYOORBETTER} ftGuid: AJsonArray.Add(GUIDToString(ADataSet.Fields[lField.I].AsGuid)); {$ENDIF} ftSingle, ftFloat: AJsonArray.Add(ADataSet.Fields[lField.I].AsFloat); ftString, ftMemo: AJsonArray.Add(ADataSet.Fields[lField.I].AsString); ftWideString, ftWideMemo: AJsonArray.Add(ADataSet.Fields[lField.I].AsWideString); ftDate: AJsonArray.Add(DateToISODate(ADataSet.Fields[lField.I].AsDateTime)); ftDateTime: AJsonArray.Add(DateTimeToISOTimeStamp(ADataSet.Fields[lField.I].AsDateTime)); ftTime: AJsonArray.Add(SQLTimeStampToStr('hh:nn:ss', ADataSet.Fields[lField.I].AsSQLTimeStamp)); ftTimeStamp: AJsonArray.Add(DateTimeToISOTimeStamp(SQLTimeStampToDateTime(ADataSet.Fields[lField.I].AsSQLTimeStamp))); ftCurrency: AJsonArray.Add(ADataSet.Fields[lField.I].AsCurrency); ftFMTBcd, ftBCD: AJsonArray.Add(BcdToDouble(ADataSet.Fields[lField.I].AsBcd)); ftGraphic, ftBlob, ftStream, ftOraBlob: begin lMS := TMemoryStream.Create; try TBlobField(ADataSet.Fields[lField.I]).SaveToStream(lMS); lMS.Position := 0; lSS := TStringStream.Create; try TMVCSerializerHelper.EncodeStream(lMS, lSS); AJsonArray.Add(lSS.DataString); finally lSS.Free; end; finally lMS.Free; end; end; ftDataSet: begin lNestedDataSet := TDataSetField(ADataSet.Fields[lField.I]).NestedDataSet; lDataSetFieldsDetail := GetDataSetFields(lNestedDataSet, AIgnoredFields, GetNameCase(lNestedDataSet, ncAsIs)); try case GetDataType(ADataSet.Owner, ADataSet.Fields[lField.I].Name, dtArray) of dtArray: begin lChildJsonArray := AJsonArray.AddArray; lNestedDataSet.First; while not lNestedDataSet.Eof do begin DataSetRowToJsonArrayOfValues(lNestedDataSet, lChildJsonArray, AIgnoredFields, lDataSetFieldsDetail); lNestedDataSet.Next; end; end; dtObject: begin lChildJsonArray := AJsonArray.AddArray; DataSetRowToJsonArrayOfValues(lNestedDataSet, lChildJsonArray, AIgnoredFields, lDataSetFieldsDetail); end; end; finally lDataSetFieldsDetail.Free; end; end; else raise EMVCSerializationException.CreateFmt('Cannot find type for field "%s"', [lField.FieldName]); end; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetToJsonArray(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ASerializationCallback: TMVCDataSetFieldSerializationAction); var LJObj: TJDOJsonObject; lDataSetFields: TMVCDataSetFields; begin lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ANameCase); try while not ADataSet.Eof do begin LJObj := AJsonArray.AddObject; DataSetToJsonObject(ADataSet, LJObj, ANameCase, AIgnoredFields, lDataSetFields, ASerializationCallback); ADataSet.Next; end; finally lDataSetFields.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList); var LJArr: TJDOJsonArray; lDataSetFields: TMVCDataSetFields; begin lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ncAsIs); try while not ADataSet.Eof do begin LJArr := AJsonArray.AddArray; DataSetRowToJsonArrayOfValues(ADataSet, LJArr, AIgnoredFields, lDataSetFields); ADataSet.Next; end; finally lDataSetFields.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetToJsonObject(const ADataSet: TDataSet; const AJSONObject: TJDOJsonObject; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields; const ASerializationCallback: TMVCDataSetFieldSerializationAction); var lMS: TMemoryStream; lSS: TStringStream; lNestedDataSet: TDataSet; lChildJsonArray: TJDOJsonArray; lChildJsonObject: TJDOJsonObject; lField: TMVCDataSetField; lDataSetFieldsDetail: TMVCDataSetFields; lHandled: Boolean; lFName: string; begin Assert(Assigned(ADataSetFields)); for lField in ADataSetFields do begin begin if Assigned(ASerializationCallback) then begin lHandled := False; ASerializationCallback(ADataSet.Fields[lField.I], AJSONObject, lHandled); if lHandled then begin continue; end; end; lFName := TMVCSerializerHelper.ApplyNameCase(ANameCase, lField.FieldName); if ADataSet.Fields[lField.I].IsNull then AJSONObject[lFName] := Null else begin case lField.DataType of ftBoolean: AJSONObject.B[lFName] := ADataSet.Fields[lField.I].AsBoolean; ftInteger, ftSmallint, ftShortint, ftByte, ftWord: AJSONObject.I[lFName] := ADataSet.Fields[lField.I].AsInteger; ftLargeint, ftAutoInc, ftLongword: AJSONObject.L[lFName] := ADataSet.Fields[lField.I].AsLargeInt; {$IFDEF TOKYOORBETTER} ftGuid: AJSONObject.S[lFName] := GUIDToString(ADataSet.Fields[lField.I].AsGuid); {$ENDIF} ftSingle, ftFloat: AJSONObject.F[lFName] := ADataSet.Fields[lField.I].AsFloat; ftString, ftMemo: AJSONObject.S[lFName] := ADataSet.Fields[lField.I].AsString; ftWideString, ftWideMemo: AJSONObject.S[lFName] := ADataSet.Fields[lField.I].AsWideString; ftDate: AJSONObject.S[lFName] := DateToISODate(ADataSet.Fields[lField.I].AsDateTime); ftDateTime: AJSONObject.S[lFName] := DateTimeToISOTimeStamp(ADataSet.Fields[lField.I].AsDateTime); ftTime: AJSONObject.S[lFName] := SQLTimeStampToStr('hh:nn:ss', ADataSet.Fields[lField.I].AsSQLTimeStamp); ftTimeStamp: AJSONObject.S[lFName] := DateTimeToISOTimeStamp (SQLTimeStampToDateTime(ADataSet.Fields[lField.I].AsSQLTimeStamp)); ftTimeStampOffset: AJSONObject.S[lFName] := DateTimeToISOTimeStamp (SQLTimeStampOffsetToDateTime(ADataSet.Fields[lField.I].AsSQLTimeStampOffset)); ftCurrency: AJSONObject.F[lFName] := ADataSet.Fields[lField.I].AsCurrency; ftFMTBcd, ftBCD: AJSONObject.F[lFName] := BcdToDouble(ADataSet.Fields[lField.I].AsBcd); ftGraphic, ftBlob, ftStream, ftOraBlob: begin lMS := TMemoryStream.Create; try TBlobField(ADataSet.Fields[lField.I]).SaveToStream(lMS); lMS.Position := 0; lSS := TStringStream.Create; try TMVCSerializerHelper.EncodeStream(lMS, lSS); AJSONObject.S[lFName] := lSS.DataString; finally lSS.Free; end; finally lMS.Free; end; end; ftDataSet: begin lNestedDataSet := TDataSetField(ADataSet.Fields[lField.I]).NestedDataSet; lDataSetFieldsDetail := GetDataSetFields(lNestedDataSet, AIgnoredFields, GetNameCase(lNestedDataSet, ANameCase)); try case GetDataType(ADataSet.Owner, ADataSet.Fields[lField.I].Name, dtArray) of dtArray: begin lChildJsonArray := AJSONObject.A[lField.FieldName]; lNestedDataSet.First; while not lNestedDataSet.Eof do begin DataSetToJsonObject(lNestedDataSet, lChildJsonArray.AddObject, GetNameCase(lNestedDataSet, ANameCase), AIgnoredFields, lDataSetFieldsDetail, ASerializationCallback); lNestedDataSet.Next; end; end; dtObject: begin lChildJsonObject := AJSONObject.O[lField.FieldName]; DataSetToJsonObject(lNestedDataSet, lChildJsonObject, GetNameCase(lNestedDataSet, ANameCase), AIgnoredFields, lDataSetFieldsDetail, ASerializationCallback); end; end; finally lDataSetFieldsDetail.Free; end; end; else raise EMVCSerializationException.CreateFmt('Cannot find type for field "%s" - TFieldType = %s', [lField.FieldName, GetEnumName(TypeInfo(TFieldType), Ord(lField.DataType))]); end; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: string); var JSONArray: TJDOJsonArray; JsonBase: TJDOJsonBaseObject; JSONObject: TJDOJsonObject; ObjList: IMVCList; begin if (ASerializedList = EmptyStr) then raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); if not Assigned(AList) then Exit; if GetTypeSerializers.ContainsKey(AList.ClassInfo) then begin if ARootNode.IsEmpty then begin JSONArray := TJDOJsonArray.Parse(ASerializedList) as TJDOJsonArray; end else begin try JsonBase := TJDOJsonObject.Parse(ASerializedList); if not(JsonBase is TJDOJsonObject) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonObject.ClassName, JsonBase.ClassName]); end; JSONObject := TJDOJsonObject(JsonBase); except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message); end; end; JSONArray := JSONObject.A[ARootNode] as TJDOJsonArray; end; try GetTypeSerializers.Items[AList.ClassInfo].DeserializeRoot(JSONArray, AList, []); Exit; finally JSONArray.Free; end; end; ObjList := TDuckTypedList.Wrap(AList); if Assigned(ObjList) then begin JsonBase := TJDOJsonObject.Parse(ASerializedList); try try if ARootNode.IsEmpty then begin if not(JsonBase is TJDOJsonArray) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonArray.ClassName, JsonBase.ClassName]); end; JSONArray := TJDOJsonArray(JsonBase); end else begin if not(JsonBase is TJDOJsonObject) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonObject.ClassName, JsonBase.ClassName]); end; JSONObject := TJDOJsonObject(JsonBase); JSONArray := JSONObject.A[ARootNode] as TJDOJsonArray; end; except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message); end; end; JsonArrayToList(JSONArray, ObjList, AClazz, AType, AIgnoredAttributes); finally JsonBase.Free; end; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeCollection(const ASerializedList: string; const AList: IInterface; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin DeserializeCollection(ASerializedList, TObject(AList), AClazz, AType, AIgnoredAttributes); end; procedure TMVCJsonDataObjectsSerializer.DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var lJsonArray: TJDOJsonArray; begin if (ASerializedDataSet = EmptyStr) then raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); if not Assigned(ADataSet) then Exit; try lJsonArray := TJDOJsonArray.Parse(ASerializedDataSet) as TJDOJsonArray; except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); end; end; try JsonArrayToDataSet(lJsonArray, ADataSet, AIgnoredFields, ANameCase); finally lJsonArray.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var lJsonBase: TJDOJsonBaseObject; begin if (ASerializedDataSetRecord = EmptyStr) or (not Assigned(ADataSet)) then Exit; lJsonBase := TJDOJsonObject.Parse(ASerializedDataSetRecord); try if lJsonBase is TJsonObject then begin if not(ADataSet.State in [dsInsert, dsEdit]) then begin ADataSet.Edit; end; JsonObjectToDataSet(TJsonObject(lJsonBase), ADataSet, AIgnoredFields, ANameCase); ADataSet.Post; end else begin raise EMVCSerializationException.Create('Cannot deserialize, expected json object'); end; finally lJsonBase.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeObject(const ASerializedObject: string; const AObject: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin DeserializeObject(ASerializedObject, TObject(AObject), AType, AIgnoredAttributes); end; function TMVCJsonDataObjectsSerializer.JsonArrayToArray(const AJsonArray: TJDOJsonArray): TValue; type TSetOfTypeElement = (xString, xInt, xLong, xFloat, xBool); TSetOfType = set of TSetOfTypeElement; var I: Integer; lStrArr: TArray; lIntArr: TArray; lLongArr: TArray; lDoubleArr: TArray; lBoolArr: TArray; lSetOfType: TSetOfType; lEl: TSetOfTypeElement; begin lSetOfType := []; { TODO -oDanieleT -cGeneral : I dont like this... } for I := 0 to Pred(AJsonArray.Count) do begin case AJsonArray.types[0] of jdtString: begin Include(lSetOfType, xString); lStrArr := lStrArr + [AJsonArray.Items[I].Value]; end; jdtInt: begin Include(lSetOfType, xInt); lIntArr := lIntArr + [AJsonArray.Items[I].IntValue]; end; jdtLong: begin Include(lSetOfType, xLong); lLongArr := lLongArr + [AJsonArray.Items[I].LongValue]; end; jdtFloat: begin Include(lSetOfType, xFloat); lDoubleArr := lDoubleArr + [AJsonArray.Items[I].FloatValue]; end; jdtBool: begin Include(lSetOfType, xBool); lBoolArr := lBoolArr + [AJsonArray.Items[I].BoolValue]; end; end; end; I := 0; for lEl in lSetOfType do begin Inc(I); if I > 1 then begin raise EMVCDeserializationException.Create('Types in the array must be homogeneous'); end; end; if Length(lStrArr) > 0 then Exit(TValue.From < TArray < string >> (lStrArr)); if Length(lIntArr) > 0 then Exit(TValue.From < TArray < Integer >> (lIntArr)); if Length(lLongArr) > 0 then Exit(TValue.From < TArray < Int64 >> (lLongArr)); if Length(lBoolArr) > 0 then Exit(TValue.From < TArray < Boolean >> (lBoolArr)); if Length(lDoubleArr) > 0 then Exit(TValue.From < TArray < Double >> (lDoubleArr)); Result := TValue.From < TArray < String >> ([]); end; procedure TMVCJsonDataObjectsSerializer.JsonArrayToDataSet(const AJsonArray: TJDOJsonArray; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var I: Integer; lSerializationMetaInfo: TSerializationMetaInfo; begin if AJsonArray.Count > 0 then begin lSerializationMetaInfo := TSerializationMetaInfo.CreateFieldsMetaInfo( ADataSet, ANameCase, AIgnoredFields); for I := 0 to Pred(AJsonArray.Count) do begin ADataSet.Append; JsonObjectToDataSet( AJsonArray.Items[I].ObjectValue, ADataSet, lSerializationMetaInfo); ADataSet.Post; end; end; end; procedure TMVCJsonDataObjectsSerializer.JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var I: Integer; Obj: TObject; begin for I := 0 to Pred(AJsonArray.Count) do begin Obj := TMVCSerializerHelper.CreateObject(AClazz.QualifiedClassName); Assert(AJsonArray.Items[I].Typ = jdtObject, 'Cannot deserialize non object type in ' + AClazz.QualifiedClassName + '. [HINT] Move data structure to objects or use manual deserialization.'); JsonObjectToObject(AJsonArray.Items[I].ObjectValue, Obj, GetSerializationType(Obj, AType), AIgnoredAttributes); AList.Add(Obj); end; end; procedure TMVCJsonDataObjectsSerializer.JsonDataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember; const AJSONObject: TJDOJsonObject; const AName: string; var AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); var ChildObject: TObject; lOwnedAttribute: MVCOwnedAttribute; lTypeInfo: PTypeInfo; lJSONExists: Boolean; lJSONIsNull: Boolean; lChildObjectAssigned: Boolean; begin ChildObject := nil; lTypeInfo := AValue.TypeInfo; if AValue.Kind in [tkClass, tkInterface] then begin if not AValue.IsEmpty then begin if AValue.Kind = tkInterface then ChildObject := TObject(AValue.AsInterface) else ChildObject := AValue.AsObject; end; if Assigned(ChildObject) then begin lTypeInfo := ChildObject.ClassInfo end; if TMVCSerializerHelper.AttributeExists(ACustomAttributes, lOwnedAttribute) then begin { Now, can happens the following situations: ChildObject JSON Outcome ----------- --------- ---------------------------------------------------- 1) Created Exists The JSON is loaded in the object (default) 2) Created NotExists Leave unchanged 3) Created is Null If ChildObject is Owned must be destroyed 4) nil Exists If ChildObject is Owned, create it and load the json 5) nil NotExists Leave unchanged 6) nil is Null Leave unchanged --> So, we'll manage only case 3 and 4 <-- } lJSONExists := AJSONObject.Contains(AName); lJSONIsNull := lJSONExists and AJSONObject.IsNull(AName); lChildObjectAssigned := ChildObject <> nil; // case 3 if lChildObjectAssigned and lJSONIsNull then begin ChildObject.Free; case AType of stUnknown, stDefault, stProperties: TRttiProperty(ARttiMember).SetValue(AObject, nil); stFields: TRttiField(ARttiMember).SetValue(AObject, nil); end; end // case 4 else if (not lChildObjectAssigned) and lJSONExists and (not lJSONIsNull) then begin if lOwnedAttribute.ClassRef <> nil then begin ChildObject := TMVCSerializerHelper.CreateObject(lOwnedAttribute.ClassRef.QualifiedClassName); AValue := ChildObject; //dt20221006 end else begin case AType of stUnknown, stDefault, stProperties: begin ChildObject := TMVCSerializerHelper.CreateObject(TRttiProperty(ARttiMember).PropertyType); AValue := ChildObject; //dt20221006 end; stFields: begin ChildObject := TMVCSerializerHelper.CreateObject(TRttiField(ARttiMember).FieldType); AValue := ChildObject; //dt20221006 end; end; end; lTypeInfo := ChildObject.ClassInfo; case AType of stUnknown, stDefault, stProperties: TRttiProperty(ARttiMember).SetValue(AObject, ChildObject); stFields: TRttiField(ARttiMember).SetValue(AObject, ChildObject); end; end; // end cases end; end; if GetTypeSerializers.ContainsKey(lTypeInfo) then begin case AJSONObject[AName].Typ of jdtNone: Exit; jdtObject: begin /// JsonDataObjects assumes values null as jdtObject if AJSONObject[AName].ObjectValue <> nil then GetTypeSerializers.Items[lTypeInfo].DeserializeAttribute(AValue, AName, AJSONObject[AName].ObjectValue, ACustomAttributes); end; jdtArray: GetTypeSerializers.Items[lTypeInfo].DeserializeAttribute(AValue, AName, AJSONObject[AName].ArrayValue, ACustomAttributes); else GetTypeSerializers.Items[lTypeInfo].DeserializeAttribute(AValue, AName, AJSONObject, ACustomAttributes); end; Exit; end; JSONObjectPropertyToTValue(AJSONObject, AName, AType, AIgnored, ChildObject, AValue, ACustomAttributes); end; procedure TMVCJsonDataObjectsSerializer.JSONObjectPropertyToTValue(AJSONObject: TJsonObject; const APropertyName: String; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; var ChildObject: TObject; var AValue: TValue; const ACustomAttributes: TArray); var ChildList: IMVCList; ChildListOfAtt: MVCListOfAttribute; LClazz: TClass; lValueTypeInfo: PTypeInfo; begin case AJSONObject[APropertyName].Typ of jdtNone: Exit; jdtString: begin ParseStringAsTValueUsingMetadata( AJSONObject[APropertyName].Value, AValue.TypeInfo, 'property ' + APropertyName, ACustomAttributes, AValue); end; jdtInt: begin if (AValue.Kind = tkEnumeration) then begin TValue.Make(GetEnumValue(AValue.TypeInfo, GetEnumName(AValue.TypeInfo, AJSONObject[APropertyName].IntValue)), AValue.TypeInfo, AValue) end else if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].IntValue); end else begin lValueTypeInfo := AValue.TypeInfo; if lValueTypeInfo = TypeInfo(NullableInt32) then AValue := TValue.From(NullableInt32(AJSONObject[APropertyName].IntValue)) else if lValueTypeInfo = TypeInfo(NullableUInt32) then AValue := TValue.From(NullableUInt32(AJSONObject[APropertyName].IntValue)) else if lValueTypeInfo = TypeInfo(NullableInt16) then AValue := TValue.From(NullableInt16(AJSONObject[APropertyName].IntValue)) else if lValueTypeInfo = TypeInfo(NullableUInt16) then AValue := TValue.From(NullableUInt16(AJSONObject[APropertyName].IntValue)) else if lValueTypeInfo = TypeInfo(NullableInt64) then AValue := TValue.From(NullableInt64(AJSONObject[APropertyName].LongValue)) else if lValueTypeInfo = TypeInfo(NullableUInt64) then AValue := TValue.From(NullableUInt64(AJSONObject[APropertyName].LongValue)) else if not TryMapNullableFloat(AValue, AJSONObject, APropertyName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize integer value for "%s"', [APropertyName]); end; end; jdtLong, jdtULong: begin lValueTypeInfo := AValue.TypeInfo; if (lValueTypeInfo = System.TypeInfo(TTimeStamp)) then begin AValue := TValue.From(MSecsToTimeStamp(AJSONObject[APropertyName].LongValue)) end else if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].LongValue); end else begin if lValueTypeInfo = TypeInfo(NullableInt64) then AValue := TValue.From(NullableInt64(AJSONObject[APropertyName].LongValue)) else if lValueTypeInfo = TypeInfo(NullableUInt64) then AValue := TValue.From(NullableUInt64(AJSONObject[APropertyName].LongValue)) else if not TryMapNullableFloat(AValue, AJSONObject, APropertyName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize long integer value for "%s"', [APropertyName]); end; end; jdtFloat: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].FloatValue); end else begin if not TryMapNullableFloat(AValue, AJSONObject, APropertyName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize floating-point value for "%s"', [APropertyName]); end; jdtDateTime: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].DateTimeValue); end else begin if AValue.TypeInfo = TypeInfo(NullableTDate) then AValue := TValue.From(NullableTDate(AJSONObject[APropertyName].DateTimeValue)) else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then AValue := TValue.From(NullableTDateTime(AJSONObject[APropertyName].DateTimeValue)) else if AValue.TypeInfo = TypeInfo(NullableTTime) then AValue := TValue.From(NullableTTime(AJSONObject[APropertyName].DateTimeValue)) else raise EMVCDeserializationException.CreateFmt('Cannot deserialize date or time value for "%s"', [APropertyName]); end; jdtBool: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].BoolValue); end else begin if AValue.TypeInfo = TypeInfo(NullableBoolean) then AValue := TValue.From(NullableBoolean(AJSONObject[APropertyName].BoolValue)) else raise EMVCDeserializationException.CreateFmt('Cannot deserialize boolean value for "%s"', [APropertyName]); end; jdtObject: begin if (AValue.TypeInfo = System.TypeInfo(TValue)) then begin AValue := TValue.FromVariant(AJSONObject[APropertyName].O['value'].VariantValue) end else begin // dt: if a key is null, jsondataobjects assign it the type jdtObject if AJSONObject[APropertyName].ObjectValue <> nil then begin case AValue.Kind of tkInterface: begin JsonObjectToObject(AJSONObject.O[APropertyName], ChildObject, GetSerializationType(ChildObject, AType), AIgnored); end; tkClass: begin JsonObjectToObject(AJSONObject.O[APropertyName], ChildObject, GetSerializationType(ChildObject, AType), AIgnored); end; tkString, tkUString: begin AValue := AJSONObject.O[APropertyName].ToJSON(); end; tkRecord: begin if AValue.TypeInfo = TypeInfo(NullableString) then begin AValue := TValue.From(NullableString(AJSONObject.O[APropertyName].ToJSON())); end else begin raise EMVCDeserializationException.CreateFmt('Cannot deserialize object value for "%s"', [APropertyName]); end; end end; end else if AValue.Kind = tkRecord then begin if String(AValue.TypeInfo.Name).StartsWith('Nullable') then begin case GetNullableType(AValue.TypeInfo) of ntNullableString: NullableString(AValue.GetReferenceToRawData^).SetNull; ntNullableCurrency: NullableCurrency(AValue.GetReferenceToRawData^).SetNull; ntNullableBoolean: NullableBoolean(AValue.GetReferenceToRawData^).SetNull; ntNullableTDate: NullableTDate(AValue.GetReferenceToRawData^).SetNull; ntNullableTTime: NullableTTime(AValue.GetReferenceToRawData^).SetNull; ntNullableTDateTime: NullableTDateTime(AValue.GetReferenceToRawData^).SetNull; ntNullableSingle: NullableSingle(AValue.GetReferenceToRawData^).SetNull; ntNullableDouble: NullableDouble(AValue.GetReferenceToRawData^).SetNull; ntNullableExtended: NullableExtended(AValue.GetReferenceToRawData^).SetNull; ntNullableInt16: NullableInt16(AValue.GetReferenceToRawData^).SetNull; ntNullableUInt16: NullableUInt16(AValue.GetReferenceToRawData^).SetNull; ntNullableInt32: NullableInt32(AValue.GetReferenceToRawData^).SetNull; ntNullableUInt32: NullableUInt32(AValue.GetReferenceToRawData^).SetNull; ntNullableInt64: NullableInt64(AValue.GetReferenceToRawData^).SetNull; ntNullableUInt64: NullableUInt64(AValue.GetReferenceToRawData^).SetNull; ntNullableTGUID: NullableTGUID(AValue.GetReferenceToRawData^).SetNull; else raise EMVCNullable.Create('Invalid Nullable Type: ' + String(AValue.TypeInfo.Name)); end; end; end; end; end; jdtArray: begin if AValue.Kind = tkInterface then ChildObject := TObject(AValue.AsInterface) else ChildObject := AValue.AsObject; if Assigned(ChildObject) then begin if ChildObject is TDataSet then JsonArrayToDataSet(AJSONObject.A[APropertyName], ChildObject as TDataSet, AIgnored, ncLowerCase) else if GetTypeSerializers.ContainsKey(ChildObject.ClassInfo) then begin GetTypeSerializers.Items[ChildObject.ClassInfo].DeserializeAttribute(AValue, APropertyName, AJSONObject, ACustomAttributes); end else begin ChildList := TDuckTypedList.Wrap(ChildObject); if TMVCSerializerHelper.AttributeExists(ACustomAttributes, ChildListOfAtt) then LClazz := ChildListOfAtt.Value else LClazz := GetObjectTypeOfGenericList(AValue.TypeInfo); if Assigned(LClazz) then JsonArrayToList(AJSONObject.A[APropertyName], ChildList, LClazz, AType, AIgnored) else raise EMVCDeserializationException.CreateFmt ('You can not deserialize a list "%s" without the MVCListOf attribute.', [APropertyName]); end; end else if AValue.isArray then begin AValue := JsonArrayToArray(AJSONObject.A[APropertyName]); end; end; end; end; procedure TMVCJsonDataObjectsSerializer.JSONObjectPropertyToTValueForRecord(AJSONObject: TJsonObject; const APropertyName: String; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; var AValue: TValue; const ACustomAttributes: TArray; const ARTTIField: TRttiField); var LEnumAsAttr: MVCEnumSerializationAttribute; LEnumMappedValues: TList; LEnumSerType: TMVCEnumSerializationType; LMappedValueIndex: Integer; lOutInteger: Integer; lInt: Integer; lOutInteger64: Int64; lChildObject: TObject; lRef: PByte; lInnerType: TRttiType; lCtx: TRttiContext; lArr: TArray; lBuff: PByte; lInnerTypeAsRecord: TRttiRecordType; lJItem: TJsonObject; procedure BuildATValueArrayFromJSONArrayOfJSONObject; var I: Integer; begin lInnerTypeAsRecord := lInnerType.AsRecord; for I := 0 to Length(lArr) - 1 do begin lBuff := AValue.GetReferenceToRawArrayElement(I); lJItem := AJSONObject.A[APropertyName].Items[I].ObjectValue; JSONObjectToRecord(lJItem, lInnerTypeAsRecord, lBuff); TValue.MakeWithoutCopy(lBuff, lInnerType.Handle, lArr[I]); FreeMem(lBuff, lInnerType.TypeSize); end; end; procedure BuildATValueArrayFromJSONArrayOfSimpleType; type TSetOfTypeElement = (xString, xInt, xLong, xFloat, xBool); TSetOfType = set of TSetOfTypeElement; var I: Integer; LJArr: TJsonArray; lArrayItemType: TJsonDataType; begin LJArr := AJSONObject.A[APropertyName]; if LJArr.Count = 0 then begin SetLength(lArr, 0); Exit; end; lArrayItemType := LJArr.types[0]; for I := 0 to Pred(LJArr.Count) do begin case lArrayItemType of jdtString: begin if lInnerType.Handle = TypeInfo(TDate) then begin lArr[I] := ISODateToDate(LJArr.Items[I].Value); end else if lInnerType.Handle = TypeInfo(TTime) then begin lArr[I] := ISOTimeToTime(LJArr.Items[I].Value); end else if lInnerType.Handle = TypeInfo(TDateTime) then begin lArr[I] := ISOTimeStampToDateTime(LJArr.Items[I].Value); end else begin lArr[I] := LJArr.Items[I].Value; end; end; jdtInt: begin lArr[I] := LJArr.Items[I].IntValue; end; jdtLong: begin lArr[I] := LJArr.Items[I].LongValue; end; jdtFloat: begin lArr[I] := LJArr.Items[I].FloatValue; end; jdtBool: begin lArr[I] := LJArr.Items[I].BoolValue; end; else raise EMVCDeserializationException.Create('Invalid element in array at property ' + APropertyName); end; end; end; begin lChildObject := nil; case AJSONObject[APropertyName].Typ of jdtNone: Exit; jdtString: begin if (AValue.TypeInfo = System.TypeInfo(TDate)) then AValue := TValue.From(ISODateToDate(AJSONObject[APropertyName].Value)) else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then AValue := TValue.From(ISOTimeStampToDateTime(AJSONObject[APropertyName].Value)) else if (AValue.TypeInfo = System.TypeInfo(TTime)) then AValue := TValue.From(ISOTimeToTime(AJSONObject[APropertyName].Value)) else if (AValue.Kind = tkRecord) and (AValue.TypeInfo <> TypeInfo(TValue)) then { nullables } begin if AValue.TypeInfo = TypeInfo(NullableString) then begin AValue := TValue.From(NullableString(AJSONObject[APropertyName].Value)) end else if AValue.TypeInfo = TypeInfo(NullableTDate) then begin AValue := TValue.From(NullableTDate(ISODateToDate(AJSONObject[APropertyName].Value))) end else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then begin AValue := TValue.From (NullableTDateTime(ISOTimeStampToDateTime(AJSONObject[APropertyName].Value))) end else if AValue.TypeInfo = TypeInfo(NullableTTime) then begin AValue := TValue.From(NullableTTime(ISOTimeToTime(AJSONObject[APropertyName].Value))) end else raise EMVCSerializationException.CreateFmt('Cannot deserialize property "%s" from string', [APropertyName]); end else if (AValue.Kind = tkEnumeration) then begin LEnumSerType := estEnumName; LEnumMappedValues := nil; if TMVCSerializerHelper.AttributeExists(ACustomAttributes, LEnumAsAttr) then begin LEnumSerType := LEnumAsAttr.SerializationType; LEnumMappedValues := LEnumAsAttr.MappedValues; end; if LEnumSerType = estEnumName then begin TValue.Make(GetEnumValue(AValue.TypeInfo, AJSONObject[APropertyName].Value), AValue.TypeInfo, AValue) end else begin LMappedValueIndex := LEnumMappedValues.IndexOf(AJSONObject[APropertyName].Value); if LMappedValueIndex < 0 then raise EMVCSerializationException.CreateFmt('Cannot deserialize property "%s" from mapped values', [APropertyName]); TValue.Make(GetEnumValue(AValue.TypeInfo, GetEnumName(AValue.TypeInfo, LMappedValueIndex)), AValue.TypeInfo, AValue) end; end else if (AValue.Kind = tkInteger) and (TryStrToInt(AJSONObject[APropertyName].Value, lOutInteger)) then begin AValue := lOutInteger; end else if (AValue.Kind = tkInt64) and (TryStrToInt64(AJSONObject[APropertyName].Value, lOutInteger64)) then begin AValue := lOutInteger64; end else if AValue.TypeInfo.Kind = tkSet then begin lInt := StringToSet(AValue.TypeInfo, StringReplace(AJSONObject[APropertyName].Value, ' ', '', [rfReplaceAll])); TValue.Make(lInt, AValue.TypeInfo, AValue); end else begin AValue := TValue.From(AJSONObject[APropertyName].Value); end; end; jdtInt: begin if (AValue.Kind = tkEnumeration) then begin TValue.Make(GetEnumValue(AValue.TypeInfo, GetEnumName(AValue.TypeInfo, AJSONObject[APropertyName].IntValue)), AValue.TypeInfo, AValue) end else if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].IntValue); end else begin if AValue.TypeInfo = TypeInfo(NullableInt32) then AValue := TValue.From(NullableInt32(AJSONObject[APropertyName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt32) then AValue := TValue.From(NullableUInt32(AJSONObject[APropertyName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableInt16) then AValue := TValue.From(NullableInt16(AJSONObject[APropertyName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt16) then AValue := TValue.From(NullableUInt16(AJSONObject[APropertyName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableInt64) then AValue := TValue.From(NullableInt64(AJSONObject[APropertyName].LongValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt64) then AValue := TValue.From(NullableUInt64(AJSONObject[APropertyName].LongValue)) else if not TryMapNullableFloat(AValue, AJSONObject, APropertyName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize integer value for "%s"', [APropertyName]); end; end; jdtLong, jdtULong: begin if (AValue.TypeInfo = System.TypeInfo(TTimeStamp)) then begin AValue := TValue.From(MSecsToTimeStamp(AJSONObject[APropertyName].LongValue)) end else if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].LongValue); end else begin if AValue.TypeInfo = TypeInfo(NullableInt64) then AValue := TValue.From(NullableInt64(AJSONObject[APropertyName].LongValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt64) then AValue := TValue.From(NullableUInt64(AJSONObject[APropertyName].LongValue)) else if not TryMapNullableFloat(AValue, AJSONObject, APropertyName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize long integer value for "%s"', [APropertyName]); end; end; jdtFloat: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].FloatValue); end else begin if not TryMapNullableFloat(AValue, AJSONObject, APropertyName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize floating-point value for "%s"', [APropertyName]); end; jdtDateTime: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].DateTimeValue); end else begin if AValue.TypeInfo = TypeInfo(NullableTDate) then AValue := TValue.From(NullableTDate(AJSONObject[APropertyName].DateTimeValue)) else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then AValue := TValue.From(NullableTDateTime(AJSONObject[APropertyName].DateTimeValue)) else if AValue.TypeInfo = TypeInfo(NullableTTime) then AValue := TValue.From(NullableTTime(AJSONObject[APropertyName].DateTimeValue)) else raise EMVCDeserializationException.CreateFmt('Cannot deserialize date or time value for "%s"', [APropertyName]); end; jdtBool: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJSONObject[APropertyName].BoolValue); end else begin if AValue.TypeInfo = TypeInfo(NullableBoolean) then AValue := TValue.From(NullableBoolean(AJSONObject[APropertyName].BoolValue)) else raise EMVCDeserializationException.CreateFmt('Cannot deserialize boolean value for "%s"', [APropertyName]); end; jdtObject: begin if (AValue.TypeInfo = System.TypeInfo(TValue)) then AValue := TValue.FromVariant(AJSONObject[APropertyName].O['value'].VariantValue) else begin // dt: if a key is null, jsondataobjects assign it the type jdtObject if AJSONObject[APropertyName].ObjectValue <> nil then begin case AValue.Kind of tkInterface: begin JsonObjectToObject(AJSONObject.O[APropertyName], lChildObject, GetSerializationType(lChildObject, AType), AIgnored); end; tkClass: begin JsonObjectToObject(AJSONObject.O[APropertyName], lChildObject, GetSerializationType(lChildObject, AType), AIgnored); end; tkString, tkUString: begin AValue := AJSONObject.O[APropertyName].ToJSON(); end; tkRecord: begin if AValue.TypeInfo = TypeInfo(NullableString) then begin AValue := TValue.From(NullableString(AJSONObject.O[APropertyName].ToJSON())); end else begin lRef := PByte(AValue.GetReferenceToRawData); JSONObjectToNestedRecordFieldStatic(AJSONObject, ARTTIField, 0, lRef); end; end; else begin raise Exception.Create('Type not suppported: ' + GetEnumName(TypeInfo(TJsonDataType), Ord(AJSONObject[APropertyName].Typ))); end; end; end; end; end; jdtArray: begin lCtx := TRttiContext.Create; try if AValue.Kind = tkArray then begin if AValue.GetArrayLength <> AJSONObject.A[APropertyName].Count then begin raise EMVCDeserializationException.Create(Format('Wrong array size, expected %d, got %d', [AValue.GetArrayLength, AJSONObject.A[APropertyName].Count])); end; SetLength(lArr, AJSONObject.A[APropertyName].Count); lInnerType := lCtx.GetType(AValue.GetArrayElement(0).TypeInfo); BuildATValueArrayFromJSONArrayOfJSONObject; AValue := TValue.FromArray(ARTTIField.FieldType.Handle, lArr); end else if AValue.Kind = tkDynArray then begin SetLength(lArr, AJSONObject.A[APropertyName].Count); if Length(lArr) > 0 then begin // DT: This line is required to know the typeinfo of an element of the dynamic array // still not created (see BuildATValueArrayFromJSONArrayOfJSONObject). // This is required because the dynamic array is still // not dimensioned here, for a static array this is not necessary. AValue := TValue.FromArray(ARTTIField.FieldType.Handle, [TValue.Empty]); lInnerType := lCtx.GetType(AValue.GetArrayElement(0).TypeInfo); if lInnerType.IsRecord then begin BuildATValueArrayFromJSONArrayOfJSONObject; end else begin BuildATValueArrayFromJSONArrayOfSimpleType; // raise Exception.Create('Unsupported type: ' + ARTTIField.FieldType.Name); end; end; AValue := TValue.FromArray(ARTTIField.FieldType.Handle, lArr); end else begin raise Exception.Create('A JSON Array cannot be mapped to ' + ARTTIField.FieldType.Name); end; finally lCtx.Free; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.JsonObjectToDataSet( const AJSONObject: TJDOJsonObject; const ADataSet: TDataSet; const SerializationMetaInfo: TSerializationMetaInfo); var Field: TField; lName: string; SS: TStringStream; SM: TMemoryStream; NestedDataSet: TDataSet; begin if (ADataSet.State in [dsInsert, dsEdit]) then begin for Field in ADataSet.Fields do begin if SerializationMetaInfo.FieldsMetaInfo[Field.Index].Ignored then begin Continue; end; // lName := GetNameAs(ADataSet.Owner, Field.Name, Field.FieldName); // if (IsIgnoredAttribute(AIgnoredFields, lName)) or (IsIgnoredComponent(ADataSet.Owner, Field.Name)) then // continue; // lName := TMVCSerializerHelper.ApplyNameCase(GetNameCase(ADataSet, ANameCase), lName); lName := SerializationMetaInfo.FieldsMetaInfo[Field.Index].NameAs; if not AJSONObject.Contains(lName) then continue; if (AJSONObject[lName].Typ = jdtObject) and (AJSONObject.Values[lName].ObjectValue = nil) then // Nullable Type begin Field.Clear; continue; end; case Field.DataType of TFieldType.ftBoolean: Field.AsBoolean := AJSONObject.B[lName]; TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint, TFieldType.ftByte, TFieldType.ftLongword, TFieldType.ftWord, TFieldType.ftAutoInc: Field.AsInteger := AJSONObject.I[lName]; TFieldType.ftLargeint: Field.AsLargeInt := AJSONObject.L[lName]; TFieldType.ftCurrency: Field.AsCurrency := AJSONObject.F[lName]; TFieldType.ftSingle: Field.AsSingle := AJSONObject.F[lName]; TFieldType.ftFloat, TFieldType.ftFMTBcd, TFieldType.ftBCD: Field.AsFloat := AJSONObject.F[lName]; TFieldType.ftExtended: Field.AsExtended := AJSONObject.F[lName]; ftString, ftWideString, ftMemo, ftWideMemo: Field.AsWideString := AJSONObject.S[lName]; TFieldType.ftDate: Field.AsDateTime := ISODateToDate(AJSONObject.S[lName]); TFieldType.ftDateTime, TFieldType.ftTimeStamp: Field.AsDateTime := ISOTimeStampToDateTime(AJSONObject.S[lName]); TFieldType.ftTime: Field.AsDateTime := ISOTimeToTime(AJSONObject.S[lName]); {$IFDEF TOKYOORBETTER} TFieldType.ftGuid: Field.AsGuid := StringToGUID(AJSONObject.S[lName]); {$ENDIF} TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream: begin SS := TStringStream.Create(AJSONObject.S[lName]); try SS.Position := 0; SM := TMemoryStream.Create; try TMVCSerializerHelper.DecodeStream(SS, SM); TBlobField(Field).LoadFromStream(SM); finally SM.Free; end; finally SS.Free; end; end; TFieldType.ftDataSet: begin NestedDataSet := TDataSetField(Field).NestedDataSet; NestedDataSet.First; while not NestedDataSet.Eof do NestedDataSet.Delete; case GetDataType(ADataSet.Owner, Field.Name, dtArray) of dtArray: begin JsonArrayToDataSet( AJSONObject.A[lName], NestedDataSet, SerializationMetaInfo.IgnoredFields, SerializationMetaInfo.NameCase); end; dtObject: begin NestedDataSet.Edit; JsonObjectToDataSet( AJSONObject.O[lName], NestedDataSet, SerializationMetaInfo.IgnoredFields, SerializationMetaInfo.NameCase); NestedDataSet.Post; end; end; end; else raise EMVCDeserializationException.CreateFmt('Cannot find type for field "%s"', [Field.FieldName]); end; end; end; end; procedure TMVCJsonDataObjectsSerializer.JsonObjectToDataSet(const AJSONObject: TJDOJsonObject; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var Field: TField; lName: string; SS: TStringStream; SM: TMemoryStream; NestedDataSet: TDataSet; begin if (ADataSet.State in [dsInsert, dsEdit]) then begin for Field in ADataSet.Fields do begin lName := GetNameAs(ADataSet.Owner, Field.Name, Field.FieldName); if (IsIgnoredAttribute(AIgnoredFields, lName)) or (IsIgnoredComponent(ADataSet.Owner, Field.Name)) then continue; lName := TMVCSerializerHelper.ApplyNameCase(GetNameCase(ADataSet, ANameCase), lName); if not AJSONObject.Contains(lName) then continue; if (AJSONObject[lName].Typ = jdtObject) and (AJSONObject.Values[lName].ObjectValue = nil) then // Nullable Type begin Field.Clear; continue; end; case Field.DataType of TFieldType.ftBoolean: Field.AsBoolean := AJSONObject.B[lName]; TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint, TFieldType.ftByte, TFieldType.ftLongword, TFieldType.ftWord, TFieldType.ftAutoInc: Field.AsInteger := AJSONObject.I[lName]; TFieldType.ftLargeint: Field.AsLargeInt := AJSONObject.L[lName]; TFieldType.ftCurrency: Field.AsCurrency := AJSONObject.F[lName]; TFieldType.ftSingle: Field.AsSingle := AJSONObject.F[lName]; TFieldType.ftFloat, TFieldType.ftFMTBcd, TFieldType.ftBCD: Field.AsFloat := AJSONObject.F[lName]; TFieldType.ftExtended: Field.AsExtended := AJSONObject.F[lName]; ftString, ftWideString, ftMemo, ftWideMemo: Field.AsWideString := AJSONObject.S[lName]; TFieldType.ftDate: Field.AsDateTime := ISODateToDate(AJSONObject.S[lName]); TFieldType.ftDateTime, TFieldType.ftTimeStamp: Field.AsDateTime := ISOTimeStampToDateTime(AJSONObject.S[lName]); TFieldType.ftTimeStampOffset: Field.AsSQLTimeStampOffset := StrToSQLTimeStampOffset(AJSONObject.S[lName]); TFieldType.ftTime: Field.AsDateTime := ISOTimeToTime(AJSONObject.S[lName]); {$IFDEF TOKYOORBETTER} TFieldType.ftGuid: Field.AsGuid := StringToGUID(AJSONObject.S[lName]); {$ENDIF} TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream: begin SS := TStringStream.Create(AJSONObject.S[lName]); try SS.Position := 0; SM := TMemoryStream.Create; try TMVCSerializerHelper.DecodeStream(SS, SM); TBlobField(Field).LoadFromStream(SM); finally SM.Free; end; finally SS.Free; end; end; TFieldType.ftDataSet: begin NestedDataSet := TDataSetField(Field).NestedDataSet; NestedDataSet.First; while not NestedDataSet.Eof do NestedDataSet.Delete; case GetDataType(ADataSet.Owner, Field.Name, dtArray) of dtArray: begin JsonArrayToDataSet(AJSONObject.A[lName], NestedDataSet, AIgnoredFields, ANameCase); end; dtObject: begin NestedDataSet.Edit; JsonObjectToDataSet(AJSONObject.O[lName], NestedDataSet, AIgnoredFields, ANameCase); NestedDataSet.Post; end; end; end; else raise EMVCDeserializationException.CreateFmt('Cannot find type for field "%s"', [Field.FieldName]); end; end; end; end; procedure TMVCJsonDataObjectsSerializer.JsonObjectToObject(const AJSONObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var lObjType: TRttiType; lProp: TRttiProperty; lFld: TRttiField; lAttributeValue: TValue; lKeyName: string; lErrMsg: string; begin if AObject = nil then begin Exit; end; if AObject is TJsonObject then begin if not Assigned(AObject) then begin raise EMVCDeserializationException.Create(AObject.ClassName + ' is not assigned'); end; TJsonObject(AObject).Assign(AJSONObject); Exit; end; lProp := nil; lFld := nil; lObjType := GetRttiContext.GetType(AObject.ClassType); case AType of stDefault, stProperties: begin try for lProp in lObjType.GetProperties do begin {$IFDEF AUTOREFCOUNT} if TMVCSerializerHelper.IsAPropertyToSkip(lProp.Name) then continue; {$ENDIF} if ((not TMVCSerializerHelper.HasAttribute(lProp)) and (not IsIgnoredAttribute(AIgnoredAttributes, lProp.Name)) and (lProp.IsWritable or lProp.GetValue(AObject).IsObject)) then begin lAttributeValue := lProp.GetValue(AObject); lKeyName := TMVCSerializerHelper.GetKeyName(lProp, lObjType); JsonDataValueToAttribute(AObject, lProp, AJSONObject, lKeyName, lAttributeValue, AType, AIgnoredAttributes, lProp.GetAttributes); if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) and lProp.IsWritable then begin lProp.SetValue(AObject, lAttributeValue); end; end; end; except on E: EInvalidCast do begin if lProp <> nil then begin lErrMsg := Format('Invalid class typecast for property "%s" [Expected: %s, Actual: %s]', [lKeyName, lProp.PropertyType.ToString(), JDO_TYPE_DESC[AJSONObject[lKeyName].Typ]]); end else begin lErrMsg := Format('Invalid class typecast for property "%s" [Actual: %s]', [lKeyName, JDO_TYPE_DESC[AJSONObject[lKeyName].Typ]]); end; raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg); end; end; end; stFields: begin try for lFld in lObjType.GetFields do if (not TMVCSerializerHelper.HasAttribute(lFld)) and (not IsIgnoredAttribute(AIgnoredAttributes, lFld.Name)) then begin lAttributeValue := lFld.GetValue(AObject); lKeyName := TMVCSerializerHelper.GetKeyName(lFld, lObjType); JsonDataValueToAttribute(AObject, lFld, AJSONObject, lKeyName, lAttributeValue, AType, AIgnoredAttributes, lFld.GetAttributes); if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) then lFld.SetValue(AObject, lAttributeValue); end; except on E: EInvalidCast do begin if lFld <> nil then begin lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Actual: %s]', [lKeyName, lFld.FieldType.ToString(), JDO_TYPE_DESC[AJSONObject[lKeyName].Typ]]); end else begin lErrMsg := Format('Invalid class typecast for field "%s" [Actual: %s]', [lKeyName, JDO_TYPE_DESC[AJSONObject[lKeyName].Typ]]); end; raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg); end; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.JSONObjectToRecord(const JSONObject: TJsonObject; RTTIType: TRttiRecordType; out Buffer: PByte); var lTypeSize: Integer; AIgnoredAttributes: TMVCIgnoredList; lKeyName: string; lAttributeValue: TValue; lErrMsg: string; lField: TRttiField; begin if RTTIType = nil then begin raise EMVCDeserializationException.Create('Insufficient RTTI to deserialize record'); end; lTypeSize := RTTIType.TypeSize; GetMem(Buffer, lTypeSize); FillChar(Buffer^, lTypeSize, 0); {$IF Defined(SYDNEYORBETTER)} InvokeRecordInitializer(Buffer, RTTIType.Handle); {$ENDIF} lField := nil; AIgnoredAttributes := []; try for lField in RTTIType.GetFields do if (not TMVCSerializerHelper.HasAttribute(lField)) and (not IsIgnoredAttribute(AIgnoredAttributes, lField.Name)) then begin lKeyName := TMVCSerializerHelper.GetKeyName(lField, RTTIType); if lField.FieldType.IsRecord then begin JSONObjectToNestedRecordField(JSONObject.O[lKeyName], lField, 0, Buffer); end else begin lAttributeValue := lField.GetValue(Buffer); JSONObjectPropertyToTValueForRecord(JSONObject, lKeyName, TMVCSerializationType.stProperties, AIgnoredAttributes, lAttributeValue, lField.GetAttributes, lField); lField.SetValue(Buffer, lAttributeValue); end; end; except on E: EInvalidCast do begin if lField <> nil then begin lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Actual: %s]', [lKeyName, lField.FieldType.ToString(), JDO_TYPE_DESC[JSONObject[lKeyName].Typ]]); end else begin lErrMsg := Format('Invalid class typecast for field "%s" [Actual: %s]', [lKeyName, JDO_TYPE_DESC[JSONObject[lKeyName].Typ]]); end; raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg); end; end; end; procedure TMVCJsonDataObjectsSerializer.JSONObjectToRecordStatic(const JSONObject: TJsonObject; RTTIType: TRttiRecordType; var Buffer: PByte); var lTypeSize: Integer; AIgnoredAttributes: TMVCIgnoredList; lKeyName: string; lAttributeValue: TValue; lErrMsg: string; lField: TRttiField; begin lTypeSize := RTTIType.TypeSize; GetMem(Buffer, lTypeSize); FillChar(Buffer^, lTypeSize, 0); {$IF Defined(SYDNEYORBETTER)} InvokeRecordInitializer(Buffer, RTTIType.Handle); {$ENDIF} lField := nil; AIgnoredAttributes := []; try for lField in RTTIType.GetFields do if (not TMVCSerializerHelper.HasAttribute(lField)) and (not IsIgnoredAttribute(AIgnoredAttributes, lField.Name)) then begin lKeyName := TMVCSerializerHelper.GetKeyName(lField, RTTIType); if lField.FieldType.IsRecord then begin JSONObjectToNestedRecordField(JSONObject.O[lKeyName], lField, 0, Buffer); end else begin lAttributeValue := lField.GetValue(Buffer); JSONObjectPropertyToTValueForRecord(JSONObject, lKeyName, TMVCSerializationType.stProperties, AIgnoredAttributes, lAttributeValue, lField.GetAttributes, lField); lField.SetValue(Buffer, lAttributeValue); end; end; except on E: EInvalidCast do begin if lField <> nil then begin lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Actual: %s]', [lKeyName, lField.FieldType.ToString(), JDO_TYPE_DESC[JSONObject[lKeyName].Typ]]); end else begin lErrMsg := Format('Invalid class typecast for field "%s" [Actual: %s]', [lKeyName, JDO_TYPE_DESC[JSONObject[lKeyName].Typ]]); end; raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg); end; end; end; procedure TMVCJsonDataObjectsSerializer.JSONObjectToNestedRecordField(const JSONObject: TJsonObject; RecordFieldRTTIType: TRttiField; const TypeOffset: Integer; var Buffer: PByte); var lChildType: TRttiType; lChildFieldOffset: Integer; lKeyName: String; lValue: TValue; lField: TRttiField; begin if RecordFieldRTTIType.FieldType.TypeKind <> tkRecord then begin raise EMVCDeserializationException.Create('Only record type allowed'); end; lChildType := RecordFieldRTTIType.FieldType; lChildFieldOffset := RecordFieldRTTIType.Offset + TypeOffset; for lField in lChildType.GetFields do begin lKeyName := TMVCSerializerHelper.GetKeyName(lField, lChildType); lValue := lField.GetValue(Buffer + lChildFieldOffset); JSONObjectPropertyToTValueForRecord(JSONObject, lKeyName, stFields, nil, lValue, nil, lField); lField.SetValue(Buffer + lChildFieldOffset, lValue); end; end; procedure TMVCJsonDataObjectsSerializer.JSONObjectToNestedRecordFieldStatic(const JSONObject: TJsonObject; RecordFieldRTTIType: TRttiField; const TypeOffset: Integer; var Buffer: PByte); var lChildType: TRttiType; lKeyName: String; lValue: TValue; lField: TRttiField; begin if RecordFieldRTTIType.FieldType.TypeKind <> tkRecord then begin raise EMVCDeserializationException.Create('Only record type allowed'); end; // Recupero il tipo e l'offset lChildType := RecordFieldRTTIType.FieldType; // lChildFieldOffset := RecordFieldRTTIType.Offset + TypeOffset; // recupero i campi for lField in lChildType.GetFields do begin lKeyName := TMVCSerializerHelper.GetKeyName(lField, lChildType); lValue := lField.GetValue(Buffer); // + lChildFieldOffset); JSONObjectPropertyToTValueForRecord(JSONObject, lKeyName, stFields, nil, lValue, nil, lField); lField.SetValue(Buffer { + lChildFieldOffset } , lValue); end; end; procedure TMVCJsonDataObjectsSerializer.ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction); var I: Integer; lDict: IMVCLinks; lSer: IMVCTypeSerializer; lJsonDataType: TJsonDataType; lJSONValue: TJsonBaseObject; begin if not Assigned(AList) then begin raise EMVCSerializationException.Create('List not assigned'); end; if Assigned(ASerializationAction) then begin lDict := TJDOLinks.Create; for I := 0 to Pred(AList.Count) do begin lDict.Clear; InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, ASerializationAction, lDict, lSer); end; end else begin for I := 0 to Pred(AList.Count) do begin lJSONValue := ConvertObjectToJsonValue(AList.GetItem(I), AType, AIgnoredAttributes, nil, ASerializationAction, lJsonDataType); case lJsonDataType of jdtArray: begin AJsonArray.Add(lJSONValue as TJsonArray); end; jdtObject: begin AJsonArray.Add(lJSONValue as TJsonObject); end; else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Data Type: ' + GetEnumName(TypeInfo(TJsonDataType), Ord(lJsonDataType))); end end; 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 Links: IMVCLinks; const Serializer: IMVCTypeSerializer); var ObjType: TRttiType; Prop: TRttiProperty; Fld: TRttiField; begin { TODO -oDanieleT -cGeneral : Find a way to automatically add HATEOS } if AObject = nil then begin Exit; end; ObjType := GetRttiContext.GetType(AObject.ClassType); case AType of stDefault, stProperties: begin for Prop in ObjType.GetProperties do begin {$IFDEF AUTOREFCOUNT} if TMVCSerializerHelper.IsAPropertyToSkip(Prop.Name) then continue; {$ENDIF} if (not TMVCSerializerHelper.HasAttribute(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then TValueToJSONObjectProperty(AJSONObject, TMVCSerializerHelper.GetKeyName(Prop, ObjType), Prop.GetValue(AObject), AType, AIgnoredAttributes, Prop.GetAttributes); end; end; stFields: begin for Fld in ObjType.GetFields do begin if (not TMVCSerializerHelper.HasAttribute(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then TValueToJSONObjectProperty(AJSONObject, TMVCSerializerHelper.GetKeyName(Fld, ObjType), Fld.GetValue(AObject), AType, AIgnoredAttributes, Fld.GetAttributes); end; end; end; if Assigned(ASerializationAction) then begin ASerializationAction(AObject, Links); TJDOLinks(Links).FillJSONArray(AJSONObject.A[TMVCConstants.HATEOAS_PROP_NAME]); end; end; procedure TMVCJsonDataObjectsSerializer.InternalRecordToJsonObject(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AJSONObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction; const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); var ObjType: TRttiType; Prop: TRttiProperty; Fld: TRttiField; lKeyName: String; begin { TODO -oDanieleT -cGeneral : Find a way to automatically add HATEOS } if ARecord = nil then begin Exit; end; ObjType := GetRttiContext.GetType(ARecordTypeInfo); case AType of stDefault, stProperties: begin for Prop in ObjType.GetProperties do begin {$IFDEF AUTOREFCOUNT} if TMVCSerializerHelper.IsAPropertyToSkip(Prop.Name) then continue; {$ENDIF} if (not TMVCSerializerHelper.HasAttribute(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then TValueToJSONObjectProperty(AJSONObject, TMVCSerializerHelper.GetKeyName(Prop, ObjType), Prop.GetValue(ARecord), AType, AIgnoredAttributes, Prop.GetAttributes); end; end; stFields: begin try for Fld in ObjType.GetFields do begin if (not TMVCSerializerHelper.HasAttribute(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then begin lKeyName := TMVCSerializerHelper.GetKeyName(Fld, ObjType); TValueToJSONObjectProperty(AJSONObject, lKeyName, Fld.GetValue(ARecord), AType, AIgnoredAttributes, Fld.GetAttributes); end; end; except on E: Exception do begin raise EMVCSerializationException.CreateFmt('Cannot serialize field [%s] - [CLS: %s][MSG: %s]', [lKeyName, E.ClassName, E.Message]); end; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.InternalSerializeDataSet(const ADataSet: TDataSet; const AJsonArray: TJsonArray; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction); var BookMark: TBookmark; lLinks: IMVCLinks; LJObj: TJsonObject; lDataSetFields: TMVCDataSetFields; begin lLinks := nil; if Assigned(ASerializationAction) then begin lLinks := TJDOLinks.Create; end; lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ANameCase); try BookMark := ADataSet.BookMark; try ADataSet.First; while not ADataSet.Eof do begin LJObj := AJsonArray.AddObject; DataSetToJsonObject(ADataSet, LJObj, ncAsIs { already applied } , AIgnoredFields, lDataSetFields); if Assigned(ASerializationAction) then begin lLinks.Clear; ASerializationAction(ADataSet, lLinks); TJDOLinks(lLinks).FillJSONArray(LJObj.A[TMVCConstants.HATEOAS_PROP_NAME]); end; ADataSet.Next; end; finally if ADataSet.BookmarkValid(BookMark) then ADataSet.GotoBookmark(BookMark); ADataSet.FreeBookmark(BookMark); end; finally lDataSetFields.Free; end; end; procedure TMVCJsonDataObjectsSerializer.InternalSerializeDataSetRecord(const DataSet: TDataSet; const JSONObject: TJsonObject; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase; const SerializationAction: TMVCDatasetSerializationAction); var lNameCase: TMVCNameCase; lDataSetFields: TList; lLinks: IMVCLinks; begin lNameCase := GetNameCase(DataSet, NameCase); lDataSetFields := GetDataSetFields(DataSet, IgnoredFields, lNameCase); try DataSetToJsonObject(DataSet, JSONObject, ncAsIs { lNameCase } , IgnoredFields, lDataSetFields); lLinks := TJDOLinks.Create; if Assigned(SerializationAction) then begin SerializationAction(DataSet, lLinks); TJDOLinks(lLinks).FillJSONArray(JSONObject.A[TMVCSerializerHelper.ApplyNameCase(lNameCase, TMVCConstants.HATEOAS_PROP_NAME)]); end; finally lDataSetFields.Free; end; end; procedure TMVCJsonDataObjectsSerializer.InternalTValueToJsonObject(const AValue: TValue; const AJSONObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction; const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); var ObjType: TRttiType; Prop: TRttiProperty; Fld: TRttiField; begin if AValue.IsEmpty then begin Exit; end; if AValue.TypeInfo.Kind <> tkRecord then begin raise EMVCSerializationException.Create('Expected Record'); end; ObjType := GetRttiContext.GetType(AValue.TypeInfo); case AType of stDefault, stProperties: begin for Prop in ObjType.GetProperties do begin {$IFDEF AUTOREFCOUNT} if TMVCSerializerHelper.IsAPropertyToSkip(Prop.Name) then continue; {$ENDIF} if (not TMVCSerializerHelper.HasAttribute(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then TValueToJSONObjectProperty(AJSONObject, TMVCSerializerHelper.GetKeyName(Prop, ObjType), Prop.GetValue(AValue.GetReferenceToRawData), AType, AIgnoredAttributes, Prop.GetAttributes); end; end; stFields: begin for Fld in ObjType.GetFields do begin if (not TMVCSerializerHelper.HasAttribute(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then TValueToJSONObjectProperty(AJSONObject, TMVCSerializerHelper.GetKeyName(Fld, ObjType), Fld.GetValue(AValue.GetReferenceToRawData), AType, AIgnoredAttributes, Fld.GetAttributes); end; end; end; // if Assigned(ASerializationAction) then // begin // ASerializationAction(AObject, Links); // TJDOLinks(Links).FillJSONArray(AJsonObject.A[TMVCConstants.HATEOAS_PROP_NAME]); // end; end; class function TMVCJsonDataObjectsSerializer.Parse(const AString: string): T; begin Result := TJDOJsonObject.Parse(AString) as T; if not Assigned(Result) then raise EMVCDeserializationException.Create('Cannot parse string as ' + T.ClassName); end; class function TMVCJsonDataObjectsSerializer.ParseArray(const AString: string): TJDOJsonArray; begin Result := Parse(AString); end; class function TMVCJsonDataObjectsSerializer.ParseObject(const AString: string): TJDOJsonObject; begin Result := Parse(AString); end; procedure TMVCJsonDataObjectsSerializer.ParseStringAsTValueUsingMetadata( const AStringValue: String; const DestinationTypeInfo: PTypeInfo; const ExceptionHintString: String; const AAttributes: TArray; var AValue: TValue); var lValueTypeInfo: PTypeInfo; lEnumSerType: TMVCEnumSerializationType; lEnumAsAttr: MVCEnumSerializationAttribute; lEnumMappedValues: TList; lMappedValueIndex: Integer; lOutInteger: Integer; lOutInteger64: Int64; lInt: Integer; begin lValueTypeInfo := DestinationTypeInfo; if (lValueTypeInfo = System.TypeInfo(TDate)) then AValue := TValue.From(ISODateToDate(AStringValue)) else if (lValueTypeInfo = System.TypeInfo(TDateTime)) then AValue := TValue.From(ISOTimeStampToDateTime(AStringValue)) else if (lValueTypeInfo = System.TypeInfo(TTime)) then AValue := TValue.From(ISOTimeToTime(AStringValue)) else if (lValueTypeInfo.Kind = tkRecord) and (lValueTypeInfo <> TypeInfo(TValue)) then { nullables } begin if lValueTypeInfo = TypeInfo(NullableString) then begin AValue := TValue.From(NullableString(AStringValue)) end else if lValueTypeInfo = TypeInfo(NullableTDate) then begin AValue := TValue.From(NullableTDate(ISODateToDate(AStringValue))) end else if lValueTypeInfo = TypeInfo(NullableTDateTime) then begin AValue := TValue.From (NullableTDateTime(ISOTimeStampToDateTime(AStringValue))) end else if lValueTypeInfo = TypeInfo(NullableTTime) then begin AValue := TValue.From(NullableTTime(ISOTimeToTime(AStringValue))) end else if lValueTypeInfo = TypeInfo(NullableTGUID) then begin AValue := TValue.From(TMVCGuidHelper.StringToGUIDEx(AStringValue)); end else begin raise EMVCSerializationException.CreateFmt('Cannot deserialize "%s" from string', [ExceptionHintString]); end; end else if (lValueTypeInfo.Kind = tkEnumeration) then begin lEnumSerType := estEnumName; lEnumMappedValues := nil; if TMVCSerializerHelper.AttributeExists(AAttributes, lEnumAsAttr) then begin lEnumSerType := lEnumAsAttr.SerializationType; lEnumMappedValues := lEnumAsAttr.MappedValues; end; if lEnumSerType = estEnumName then begin lOutInteger := GetEnumValue(lValueTypeInfo, AStringValue); if lOutInteger = -1 then begin raise EMVCSerializationException.CreateFmt('Cannot deserialize "%s" from mapped values', [ExceptionHintString]); end; TValue.Make(lOutInteger, lValueTypeInfo, AValue) end else begin lMappedValueIndex := lEnumMappedValues.IndexOf(AStringValue); if lMappedValueIndex < 0 then raise EMVCSerializationException.CreateFmt('Cannot deserialize "%s" from mapped values', [ExceptionHintString]); TValue.Make(GetEnumValue(lValueTypeInfo, GetEnumName(lValueTypeInfo, lMappedValueIndex)), lValueTypeInfo, AValue) end; end else if (lValueTypeInfo.Kind = tkInteger) and (TryStrToInt(AStringValue, lOutInteger)) then begin AValue := lOutInteger; end else if (lValueTypeInfo.Kind = tkInt64) and (TryStrToInt64(AStringValue, lOutInteger64)) then begin AValue := lOutInteger64; end else if lValueTypeInfo.Kind = tkSet then begin lInt := StringToSet(lValueTypeInfo, StringReplace(AStringValue, ' ', '', [rfReplaceAll])); TValue.Make(lInt, lValueTypeInfo, AValue); end else begin AValue := TValue.From(AStringValue); end; end; procedure TMVCJsonDataObjectsSerializer.RecordToJsonObject(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AJSONObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin InternalRecordToJsonObject(ARecord, ARecordTypeInfo, AJSONObject, AType, AIgnoredAttributes, nil, nil, nil); end; function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var JSONArray: TJDOJsonArray; ObjList: IMVCList; Obj: TObject; lLinks: IMVCLinks; lSer: IMVCTypeSerializer; lObjType: TRttiType; begin Result := EmptyStr; if not Assigned(AList) then Exit; if AList is TJsonBaseObject then Exit(TJsonBaseObject(AList).ToJSON(True)); lObjType := GetRttiContext.GetType(AList.ClassType); if GetTypeSerializers.ContainsKey(lObjType.Handle) then begin GetTypeSerializers.Items[lObjType.Handle].SerializeRoot(AList, TObject(JSONArray), []); try Result := JSONArray.ToJSON(True); finally JSONArray.Free; end; Exit; end; ObjList := TDuckTypedList.Wrap(AList); if Assigned(ObjList) then begin JSONArray := TJDOJsonArray.Create; try if Assigned(ASerializationAction) then begin if not GetTypeSerializers.TryGetValue(TypeInfo(TMVCStringDictionary), lSer) then begin raise EMVCSerializationException.Create ('Cannot serialize _links without TMVCStringDictionary custom serializer'); end; lLinks := TJDOLinks.Create; for Obj in ObjList do begin lLinks.Clear; InternalObjectToJsonObject(Obj, JSONArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes, ASerializationAction, lLinks, lSer); end; end else begin for Obj in ObjList do begin if Obj <> nil then begin if Obj is TDataSet then begin DataSetToJsonArray(TDataSet(Obj), JSONArray.AddArray, TMVCNameCase.ncLowerCase, nil,nil,); end else begin ObjectToJsonObject(Obj, JSONArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes) end; end else begin JSONArray.Add(TJsonObject(nil)); end; end; end; Result := JSONArray.ToJSON(True); finally JSONArray.Free; end; end; end; function TMVCJsonDataObjectsSerializer.SerializeArrayOfRecord( var ATValueContainingAnArray: TValue; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var I: Integer; lCurrentArrayItem: TValue; lJSONArr: TJsonArray; lJObj: TJsonObject; begin if not ATValueContainingAnArray.IsArray then begin raise EMVCSerializationException.Create(String(ATValueContainingAnArray.TypeInfo^.Name) + ' is not an array'); end; if ATValueContainingAnArray.GetArrayLength = 0 then begin Result := '[]'; end; lJSONArr := TJsonArray.Create; try for I := 0 to ATValueContainingAnArray.GetArrayLength - 1 do begin lJObj := lJSONArr.AddObject; lCurrentArrayItem := ATValueContainingAnArray.GetArrayElement(I); if lCurrentArrayItem.IsObjectInstance then begin raise EMVCSerializationException.CreateFmt('Found a "%s" while serializing array. Instance types not allowed in arrays - [HINT] Use list of objects instead of array', [lCurrentArrayItem.AsObject.ClassName]); end else begin InternalRecordToJsonObject( lCurrentArrayItem.GetReferenceToRawData, lCurrentArrayItem.TypeInfo, lJObj, TMVCSerializationType.stFields, nil, nil, nil, nil ); end; end; Result := lJSONArr.ToJSON(); finally lJSONArr.free; end; end; function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; begin Result := SerializeCollection(TObject(AList), AType, AIgnoredAttributes, ASerializationAction); end; function TMVCJsonDataObjectsSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string; var JSONArray: TJDOJsonArray; begin Result := EmptyStr; if (not Assigned(ADataSet)) then Exit('null'); if ADataSet.IsEmpty then Exit('[]'); // https://github.com/danieleteti/delphimvcframework/issues/219 JSONArray := TJsonArray.Create; try InternalSerializeDataSet(ADataSet, JSONArray, AIgnoredFields, ANameCase, ASerializationAction); Result := JSONArray.ToJSON(True); finally JSONArray.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(const DataSet: TDataSet; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase = ncAsIs; const SerializationAction: TMVCDatasetSerializationAction = nil): string; var lJSONObject: TJDOJsonObject; begin Result := EmptyStr; if (not Assigned(DataSet)) or DataSet.IsEmpty then Exit('null'); lJSONObject := TJDOJsonObject.Create; try InternalSerializeDataSetRecord(DataSet, lJSONObject, IgnoredFields, NameCase, SerializationAction); Result := lJSONObject.ToJSON(True); finally lJSONObject.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var LJObj: TJDOJsonObject; lObjType: TRttiType; lDict: IMVCLinks; begin Result := EmptyStr; if not Assigned(AObject) then Exit('null'); if AObject is TJsonBaseObject then Exit(TJsonBaseObject(AObject).ToJSON(True)); if AObject is TDataSet then Exit(self.SerializeDataSet(TDataSet(AObject), AIgnoredAttributes)); if AObject is System.JSON.TJsonValue then Exit(System.JSON.TJsonValue(AObject).ToJSON); lObjType := GetRttiContext.GetType(AObject.ClassType); if GetTypeSerializers.ContainsKey(lObjType.Handle) then begin GetTypeSerializers.Items[lObjType.Handle].SerializeRoot(AObject, TObject(LJObj), []); try Result := LJObj.ToJSON(True); finally LJObj.Free; end; Exit; end; LJObj := TJDOJsonObject.Create; try if Assigned(ASerializationAction) then begin lDict := TJDOLinks.Create; InternalObjectToJsonObject(AObject, LJObj, GetSerializationType(AObject, AType), AIgnoredAttributes, ASerializationAction, lDict, fStringDictionarySerializer); end else begin InternalObjectToJsonObject(AObject, LJObj, GetSerializationType(AObject, AType), AIgnoredAttributes, nil, nil, nil); end; Result := LJObj.ToJSON(True); finally LJObj.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var LIgnoredAttrs: TList; begin if not Assigned(AObject) then Exit('null'); LIgnoredAttrs := TList.Create; try LIgnoredAttrs.AddRange(AIgnoredAttributes); // if Assigned(GetRttiContext.GetType(TObject(AObject).ClassType).GetProperty('RefCount')) then // LIgnoredAttrs.Add('RefCount'); Result := SerializeObject(TObject(AObject), AType, TMVCIgnoredList(LIgnoredAttrs.ToArray), ASerializationAction); finally LIgnoredAttrs.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeObjectToJSON(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): TJDOJsonObject; var JSONObject: TJDOJsonObject; ObjType: TRttiType; begin if not Assigned(AObject) then Exit(TJDOJsonObject.Create); if AObject is TJsonBaseObject then Exit(TJsonBaseObject(AObject).Clone as TJDOJsonObject); if AObject is TDataSet then begin raise Exception.Create('Not supported yet'); end; if AObject is TJsonValue then begin Exit(TJDOJsonObject.Parse(TJsonValue(AObject).ToJSON) as TJDOJsonObject); end; ObjType := GetRttiContext.GetType(AObject.ClassType); if GetTypeSerializers.ContainsKey(ObjType.Handle) then begin GetTypeSerializers.Items[ObjType.Handle].SerializeRoot(AObject, TObject(JSONObject), []); try Result := JSONObject; except JSONObject.Free; raise; end; Exit; end; Result := TJDOJsonObject.Create; try ObjectToJsonObject(AObject, Result, GetSerializationType(AObject, AType), AIgnoredAttributes); except Result.Free; raise; end; end; function TMVCJsonDataObjectsSerializer.SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var lJSON: TJDOJsonObject; begin lJSON := TJDOJsonObject.Create; try RecordToJsonObject(ARecord, ARecordTypeInfo, lJSON, TMVCSerializationType.stFields, nil); Result := lJSON.ToJSON(True); finally lJSON.Free; end; end; function TMVCJsonDataObjectsSerializer.TryMapNullableFloat(var Value: TValue; const JSONDataObject: TJsonObject; const AttribName: string): Boolean; begin Result := True; if Value.TypeInfo = TypeInfo(NullableSingle) then Value := TValue.From(NullableSingle(JSONDataObject[AttribName].FloatValue)) else if Value.TypeInfo = TypeInfo(NullableCurrency) then Value := TValue.From(NullableCurrency(JSONDataObject[AttribName].FloatValue)) else if Value.TypeInfo = TypeInfo(NullableDouble) then Value := TValue.From(NullableDouble(JSONDataObject[AttribName].FloatValue)) else if Value.TypeInfo = TypeInfo(NullableExtended) then Value := TValue.From(NullableExtended(JSONDataObject[AttribName].FloatValue)) else Result := False; end; function TMVCJsonDataObjectsSerializer.TryNullableToJSON(const AValue: TValue; const AJSONObject: TJDOJsonObject; const AName: string; const ACustomAttributes: TArray): Boolean; var lFoundANullable: Boolean; begin Result := False; lFoundANullable := False; if (AValue.TypeInfo = System.TypeInfo(NullableString)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.S[AName] := AValue.AsType().Value; Result := True; end end else if (AValue.TypeInfo = System.TypeInfo(NullableInt32)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.I[AName] := AValue.AsType().Value; Result := True; end end else if (AValue.TypeInfo = System.TypeInfo(NullableInt64)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.L[AName] := AValue.AsType().Value; Result := True; end end else if (AValue.TypeInfo = System.TypeInfo(NullableInt16)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.I[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableTDate)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.S[AName] := DateToISODate(AValue.AsType().Value); Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableTDateTime)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.S[AName] := DateTimeToISOTimeStamp(AValue.AsType().Value); Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableTTime)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.S[AName] := TimeToISOTime(AValue.AsType().Value); Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableBoolean)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.B[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableCurrency)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.F[AName] := AValue.AsType().Value; Result := True; end end else if (AValue.TypeInfo = System.TypeInfo(NullableSingle)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.F[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableDouble)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.F[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableExtended)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.F[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableUInt16)) then { from here all nullable integers } begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.I[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableUInt32)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.I[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableUInt64)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin AJSONObject.I[AName] := AValue.AsType().Value; Result := True; end; end else if (AValue.TypeInfo = System.TypeInfo(NullableTGUID)) then begin lFoundANullable := True; if AValue.AsType().HasValue then begin if TMVCSerializerHelper.AttributeExists(ACustomAttributes) then AJSONObject.S[AName] := TMVCGuidHelper.GUIDToStringEx(AValue.AsType().Value) else AJSONObject.S[AName] := GUIDToString(AValue.AsType().Value); Result := True; end; end; { if the type is a nullable but doesn't contains a value... } if lFoundANullable and (not Result) and MVCSerializeNulls then begin AJSONObject.Values[AName] := nil; end; { if MVCSerializeEmptyNullableAsNull = False, an empty nullable doesn't have to contains "null"} Result := lFoundANullable; {caller needs to know if AJSONObject contains a valid data} end; procedure TMVCJsonDataObjectsSerializer.DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: string); var JSONObject: TJDOJsonObject; JsonBase: TJsonBaseObject; begin if (ASerializedObject = EmptyStr) then raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); if not Assigned(AObject) then Exit; try JsonBase := TJDOJsonObject.Parse(ASerializedObject); if not(JsonBase is TJDOJsonObject) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonObject.ClassName, JsonBase.ClassName]); end; JSONObject := TJDOJsonObject(JsonBase); except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message); end; end; try if GetTypeSerializers.ContainsKey(AObject.ClassInfo) then begin GetTypeSerializers.Items[AObject.ClassInfo].DeserializeRoot(SelectRootNodeOrWholeObject(ARootNode, JSONObject), AObject, []) end else begin JsonObjectToObject(SelectRootNodeOrWholeObject(ARootNode, JSONObject), AObject, GetSerializationType(AObject, AType), AIgnoredAttributes); end; finally JSONObject.Free; end; end; function TMVCJsonDataObjectsSerializer.GetDataSetFields(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs): TMVCDataSetFields; var I: Integer; lField: TMVCDataSetField; begin Result := TMVCDataSetFields.Create; for I := 0 to ADataSet.Fields.Count - 1 do begin { gets the name as defined by NameAs attribute } lField.FieldName := GetNameAs(ADataSet.Owner, ADataSet.Fields[I].Name, ADataSet.Fields[I].FieldName); { apply the name case to the field name } lField.FieldName := TMVCSerializerHelper.ApplyNameCase(ANameCase, lField.FieldName); lField.DataType := ADataSet.Fields[I].DataType; lField.I := I; if (not IsIgnoredAttribute(AIgnoredFields, ADataSet.Fields[I].FieldName)) and (not IsIgnoredComponent(ADataSet.Owner, ADataSet.Fields[I].Name)) then Result.Add(lField); end; end; procedure TMVCJsonDataObjectsSerializer.AddTValueToJsonArray(const Value: TValue; const JSON: TJDOJsonArray); var lOrdinalValue: Int64; lValueAsObj: TObject; lTypeName: string; lJSONValue: TJsonBaseObject; lJsonDataType: TJsonDataType; begin if Value.IsEmpty then begin JSON.Add(TJsonObject(nil)); Exit; end; case Value.Kind of tkInteger: begin JSON.Add(Value.AsInteger); end; tkFloat: begin {$IFDEF NEXTGEN} lTypeName := PChar(Pointer(Value.TypeInfo.Name)); {$ELSE} lTypeName := string(Value.TypeInfo.Name); {$ENDIF} if (lTypeName = 'TDate') or (lTypeName = 'TDateTime') or (lTypeName = 'TTime') then begin JSON.Add(DateTimeToISOTimeStamp(Value.AsExtended)); end else begin JSON.Add(Value.AsExtended); end; end; tkString, tkUString, tkWChar, tkLString, tkWString: begin JSON.Add(Value.AsString); end; tkInt64: begin JSON.Add(Value.AsInt64); end; tkEnumeration: begin if (Value.TypeInfo = System.TypeInfo(Boolean)) then begin JSON.Add(Value.AsBoolean); end else begin Value.TryAsOrdinal(lOrdinalValue); JSON.Add(lOrdinalValue); end; end; tkClass, tkInterface: begin if Value.Kind = tkInterface then lValueAsObj := TObject(Value.AsInterface) else lValueAsObj := Value.AsObject; lJSONValue := ConvertObjectToJsonValue(lValueAsObj, GetSerializationType(lValueAsObj), [], nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin JSON.Add(TJsonArray(lJSONValue)); end; jdtObject: begin JSON.Add(TJsonObject(lJSONValue)); end; else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Type') end; end; end; else raise EMVCException.Create('Invalid type'); end; end; procedure TValueToJSONObjectPropertyEx(const Value: TValue; const JSON: TJDOJsonObject; const KeyName: string); var lSer: TMVCJsonDataObjectsSerializer; lMVCList: IMVCList; lOrdinalValue: Int64; lValueAsObj: TObject; lValueAsObjQualifClassName, lTypeName: string; begin if Value.IsEmpty then begin JSON.Values[KeyName] := nil; Exit; end; case Value.Kind of tkInteger: begin JSON.I[KeyName] := Value.AsInteger; end; tkFloat: begin {$IFDEF NEXTGEN} lTypeName := PChar(Pointer(Value.TypeInfo.Name)); {$ELSE} lTypeName := string(Value.TypeInfo.Name); {$ENDIF} if (lTypeName = 'TDate') or (lTypeName = 'TDateTime') or (lTypeName = 'TTime') then begin JSON.D[KeyName] := Value.AsExtended; end else begin JSON.F[KeyName] := Value.AsExtended; end; end; tkString, tkUString, tkWChar, tkLString, tkWString: begin JSON.S[KeyName] := Value.AsString; end; tkInt64: begin JSON.I[KeyName] := Value.AsInt64; end; tkEnumeration: begin if (Value.TypeInfo = System.TypeInfo(Boolean)) then begin JSON.B[KeyName] := Value.AsBoolean; end else begin Value.TryAsOrdinal(lOrdinalValue); JSON.I[KeyName] := lOrdinalValue; end; end; tkClass, tkInterface: begin if Value.Kind = tkInterface then lValueAsObj := TObject(Value.AsInterface) else lValueAsObj := Value.AsObject; lValueAsObjQualifClassName := lValueAsObj.QualifiedClassName.ToLower; if (lValueAsObj is TJDOJsonObject) or (lValueAsObj is TJsonObject) {$IFDEF RIOORBETTER} or { this is for a bug in delphi103rio } (lValueAsObjQualifClassName = 'jsondataobjects.tjsonobject') or { this is for a bug in delphi103rio } (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjdojsonobject') {$ENDIF} then begin JSON.O[KeyName] := TJDOJsonObject.Create; JSON.O[KeyName].Assign(TJDOJsonObject(Value.AsObject)); end else if (lValueAsObj is TJDOJsonArray) or (lValueAsObj is TJsonArray) {$IFDEF RIOORBETTER} or { this is for a bug in delphi103rio } (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjsonarray') or { this is for a bug in delphi103rio } (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjdojsonarray') {$ENDIF} then begin JSON.A[KeyName] := TJDOJsonArray.Create; JSON.A[KeyName].Assign(TJDOJsonArray(Value.AsObject)); end else if lValueAsObj is TDataSet then begin lSer := TMVCJsonDataObjectsSerializer.Create; try JSON.A[KeyName] := TJDOJsonArray.Create; lSer.DataSetToJsonArray(TDataSet(lValueAsObj), JSON.A[KeyName], TMVCNameCase.ncLowerCase, []); finally lSer.Free; end; end else if TDuckTypedList.CanBeWrappedAsList(lValueAsObj, lMVCList) then begin lSer := TMVCJsonDataObjectsSerializer.Create; try JSON.A[KeyName] := TJDOJsonArray.Create; lSer.ListToJsonArray(lMVCList, JSON.A[KeyName], TMVCSerializationType.stDefault, nil); finally lSer.Free; end; end else begin lSer := TMVCJsonDataObjectsSerializer.Create; try JSON.O[KeyName] := lSer.SerializeObjectToJSON(lValueAsObj, TMVCSerializationType.stProperties, [], nil); finally lSer.Free; end; end; end; else raise EMVCException.Create('Invalid type'); end; end; function StrToJSONObject(const AValue: string; ARaiseExceptionOnError: Boolean): TJDOJsonObject; var lJSON: TJDOJsonObject; begin lJSON := nil; try lJSON := TJDOJsonObject.Parse(AValue) as TJDOJsonObject; if ARaiseExceptionOnError and (lJSON = nil) then begin raise EMVCException.Create('Invalid JSON'); end; Result := lJSON; except on E: Exception do begin lJSON.Free; Result := nil; if ARaiseExceptionOnError then begin raise EMVCDeserializationException.Create('Invalid JSON Object - ' + E.Message); end; end; end; end; function StrToJSONArray(const AValue: string; ARaiseExceptionOnError: Boolean): TJDOJsonArray; var lJSON: TJDOJsonArray; begin lJSON := nil; try lJSON := TJDOJsonObject.Parse(AValue) as TJDOJsonArray; if ARaiseExceptionOnError and (lJSON = nil) then begin raise EMVCException.Create('Invalid JSON'); end; Result := lJSON; except on E: Exception do begin lJSON.Free; Result := nil; if ARaiseExceptionOnError then begin raise EMVCDeserializationException.Create('Invalid JSON Array - ' + E.Message); end; end; end; end; procedure JsonObjectToObject(const AJSONObject: TJDOJsonObject; const AObject: TObject); begin JsonObjectToObject(AJSONObject, AObject, TMVCSerializationType.stDefault, nil) end; procedure JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var lSer: TMVCJsonDataObjectsSerializer; I: Integer; lObj: TObject; begin lSer := TMVCJsonDataObjectsSerializer.Create; try for I := 0 to AJsonArray.Count - 1 do begin lObj := AClazz.Create; try lSer.JsonObjectToObject(AJsonArray[I].ObjectValue, lObj, TMVCSerializationType.stDefault, nil); except lObj.Free; raise; end; end; finally lSer.Free; end; end; procedure JsonObjectToObject(const AJSONObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var lSer: TMVCJsonDataObjectsSerializer; begin lSer := TMVCJsonDataObjectsSerializer.Create; try lSer.JsonObjectToObject(AJSONObject, AObject, AType, AIgnoredAttributes); finally lSer.Free; end; end; procedure MVCStringDictionaryListToJSONArray(const aStringDictionaryList: TMVCStringDictionaryList; const AJsonArray: TJsonArray); var lStringDictionary: TMVCStringDictionary; begin if aStringDictionaryList = nil then Exit; for lStringDictionary in aStringDictionaryList do begin TMVCStringDictionarySerializer.Serialize(lStringDictionary, AJsonArray.AddObject); end; end; { TJDOLinks } procedure TJDOLinks.FillJSONArray(const AJsonArray: TJsonArray); begin MVCStringDictionaryListToJSONArray(LinksData, AJsonArray); end; { TJSONObjectHelper } procedure TJSONObjectHelper.LoadFromString(const Value: string; Encoding: TEncoding; Utf8WithoutBOM: Boolean); var lSS: TStringStream; begin if Assigned(Encoding) then begin lSS := TStringStream.Create(Value, Encoding); end else begin lSS := TStringStream.Create(Value); end; try lSS.Position := 0; LoadFromStream(lSS, Encoding, Utf8WithoutBOM); finally lSS.Free; end; end; { TMVCRecordHelper } function TMVCJsonDataObjectsSerializer.JSONObjectToRecord(const JSONObject: TJsonObject): T; var AIgnoredAttributes: TMVCIgnoredList; lKeyName: string; lAttributeValue: TValue; lErrMsg: string; lField: TRttiField; lBuffer: PByte; lCtx: TRttiContext; lRTTIType: TRttiType; begin lCtx := GetRttiContext; lRTTIType := lCtx.GetType(TypeInfo(T)); if not lRTTIType.IsRecord then begin raise EMVCDeserializationException.Create('Extected record, got ' + lRTTIType.QualifiedName); end; lBuffer := @Result; lField := nil; AIgnoredAttributes := []; try for lField in lRTTIType.GetFields do if (not TMVCSerializerHelper.HasAttribute(lField)) and (not IsIgnoredAttribute(AIgnoredAttributes, lField.Name)) then begin lKeyName := TMVCSerializerHelper.GetKeyName(lField, lRTTIType); //issue 648 if lField.FieldType.IsRecord and not lField.FieldType.Handle.NameFld.ToString.StartsWith('Nullable') then begin JSONObjectToNestedRecordField(JSONObject.O[lKeyName], lField, 0, lBuffer); end else begin lAttributeValue := lField.GetValue(lBuffer); JSONObjectPropertyToTValueForRecord(JSONObject, lKeyName, TMVCSerializationType.stFields, AIgnoredAttributes, lAttributeValue, lField.GetAttributes, lField); lField.SetValue(lBuffer, lAttributeValue); end; end; except on E: EInvalidCast do begin if lField <> nil then begin lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Actual: %s]', [lKeyName, lField.FieldType.ToString(), JDO_TYPE_DESC[JSONObject[lKeyName].Typ]]); end else begin lErrMsg := Format('Invalid class typecast for field "%s" [Actual: %s]', [lKeyName, JDO_TYPE_DESC[JSONObject[lKeyName].Typ]]); end; raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg); end; end; end; function TMVCJsonDataObjectsSerializer.StrToRecord(const AJSONString: String): T; var lSer: TMVCJsonDataObjectsSerializer; LJObj: TJsonObject; lBuff: PByte; begin lSer := TMVCJsonDataObjectsSerializer.Create(nil); try LJObj := StrToJSONObject(AJSONString); try lBuff := @Result; lSer.JSONObjectToNestedRecordField(LJObj, nil, 0, lBuff); finally LJObj.Free; end; finally lSer.Free; end; end; { TJSONUtils } class function TJSONUtils.JSONArrayToArrayOfRecord(const JSONArray: TJsonArray): TArray; var I: Integer; lSer: TMVCJsonDataObjectsSerializer; begin lSer := TMVCJsonDataObjectsSerializer.Create(nil); try SetLength(Result, JSONArray.Count); for I := Low(Result) to High(Result) do begin Result[I] := JSONObjectToRecord(JSONArray.Items[I].ObjectValue, lSer); end; finally lSer.Free; end; end; class function TJSONUtils.JSONArrayToListOf(const JSONArray: TJsonArray): TObjectList; var I: Integer; lSer: TMVCJsonDataObjectsSerializer; begin lSer := TMVCJsonDataObjectsSerializer.Create(nil); try Result := TObjectList.Create(True); try for I := 0 to JSONArray.Count - 1 do begin Result.Add(JsonObjectToObject(JSONArray.Items[I].ObjectValue)); end; except Result.Free; raise; end; finally lSer.Free; end; end; class function TJSONUtils.JsonObjectToObject(const JSONObject: TJsonObject): T; var lSer: TMVCJsonDataObjectsSerializer; begin lSer := TMVCJsonDataObjectsSerializer.Create(nil); try Result := T.Create; try lSer.JsonObjectToObject(JSONObject, Result, TMVCSerializationType.stDefault, nil); except Result.Free; raise; end; finally lSer.Free; end; end; class function TJSONUtils.JSONObjectToRecord(const JSONObject: TJsonObject): T; var lSer: TMVCJsonDataObjectsSerializer; begin lSer := TMVCJsonDataObjectsSerializer.Create(nil); try Result := JSONObjectToRecord(JSONObject, lSer); finally lSer.Free; end; end; class function TJSONUtils.JSONObjectToRecord(const JSONObject: TJsonObject; const Serializer: TMVCJsonDataObjectsSerializer): T; begin Result := Serializer.JSONObjectToRecord(JSONObject); end; { TMVCJsonDataObjectsSerializer.TSerializationMetaInfo } class function TMVCJsonDataObjectsSerializer.TSerializationMetaInfo.CreateFieldsMetaInfo( const ADataSet: TDataSet; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList): TSerializationMetaInfo; var lField: TField; I: Integer; lName: String; begin Result.IgnoredFields := AIgnoredFields; Result.NameCase := ANameCase; SetLength(Result.FieldsMetaInfo, ADataSet.Fields.Count); for I := 0 to ADataSet.FieldCount - 1 do begin lField := ADataSet.Fields[I]; lName := GetNameAs(ADataSet.Owner, lField.Name, lField.FieldName); Result.FieldsMetaInfo[I].Ignored := IsIgnoredAttribute(AIgnoredFields, lName) or (IsIgnoredComponent(ADataSet.Owner, lField.Name)); Result.FieldsMetaInfo[I].NameAs := TMVCSerializerHelper.ApplyNameCase( GetNameCase(ADataSet, ANameCase), lName); end; end; end.