Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 15:55:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity
ee6075d6a2
delphimvcframework/sources/MVCFramework.Serializer.JsonDataObjects.pas

4138 lines
144 KiB
ObjectPascal
Raw Blame History

// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2022 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<TMVCDataSetField>;
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<TFieldMetaInfo>;
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<TCustomAttribute>;
var AValue: TValue);
function JSONObjectToRecord<T: record >(const JSONObject: TJsonObject): T; overload;
function StrToRecord<T: record >(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<TCustomAttribute>; 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<TCustomAttribute>);
function TryNullableToJSON(const AValue: TValue; const AJSONObject: TJDOJsonObject; const AName: string;
const ACustomAttributes: TArray<TCustomAttribute>): 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<TCustomAttribute>);
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<TCustomAttribute>);
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;
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<T: TJsonBaseObject>(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<T: record >(const JSONObject: TJsonObject;
const Serializer: TMVCJsonDataObjectsSerializer): T; overload; static; inline;
public
// records
class function JSONObjectToRecord<T: record >(const JSONObject: TJsonObject): T; overload; static;
class function JSONObjectToRecord<T: record >(const JSONRPCResponse: IInterface): T; overload; static;
class function JSONArrayToArrayOfRecord<T: record >(const JSONArray: TJsonArray): TArray<T>; overload; static;
class function JSONArrayToArrayOfRecord<T: record >(const JSONRPCResponse: IInterface): TArray<T>; overload; static;
// objects
class function JsonObjectToObject<T: class, constructor>(const JSONObject: TJsonObject): T; overload; static;
class function JSONArrayToListOf<T: class, constructor>(const JSONArray: TJsonArray): TObjectList<T>;
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.JSONRPC,
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<string> } ), TMVCListOfStringSerializer.Create);
GetTypeSerializers.Add(TypeInfo(TMVCListOfInteger { TList<Integer> } ), TMVCListOfIntegerSerializer.Create);
GetTypeSerializers.Add(TypeInfo(TMVCListOfBoolean { TList<Boolean> } ), TMVCListOfBooleanSerializer.Create);
GetTypeSerializers.Add(TypeInfo(TMVCListOfDouble { TList<Double> } ), TMVCListOfDoubleSerializer.Create);
end;
procedure TMVCJsonDataObjectsSerializer.TValueToJSONObjectProperty(const AJSONObject: TJDOJsonObject;
const AName: string; const AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>);
var
ChildJsonObject: TJDOJsonObject;
ChildValue: TValue;
ChildObject, Obj: TObject;
ValueTypeAtt: MVCValueAsTypeAttribute;
CastValue, CastedValue: TValue;
I: Integer;
LEnumAsAttr: MVCEnumSerializationAttribute;
LEnumSerType: TMVCEnumSerializationType;
LEnumMappedValues: TList<string>;
LEnumName: string;
lJSONValue: TJsonBaseObject;
lJsonDataType: TJsonDataType;
lTypeInfo: PTypeInfo;
lBuffer: Pointer;
// lValue: TValue;
lCurrentArrayItem: TValue;
begin
if SameText(AName, 'RefCount') then
begin
Exit;
end;
if AValue.IsEmpty then
begin
AJSONObject[AName] := Null;
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<MVCEnumSerializationAttribute>(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<MVCSerializeAsStringAttribute>(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<TTimeStamp>);
end
else if (AValue.TypeInfo = System.TypeInfo(TValue)) then
begin
if TMVCSerializerHelper.AttributeExists<MVCValueAsTypeAttribute>(ACustomAttributes, ValueTypeAtt) then
begin
CastValue := AValue.AsType<TValue>;
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<TValue>;
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));
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"', [lField.FieldName]);
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<string>;
lIntArr: TArray<Integer>;
lLongArr: TArray<Int64>;
lDoubleArr: TArray<Double>;
lBoolArr: TArray<Boolean>;
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<TCustomAttribute>);
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<MVCOwnedAttribute>(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);
end
else
begin
case AType of
stUnknown, stDefault, stProperties:
ChildObject := TMVCSerializerHelper.CreateObject(TRttiProperty(ARttiMember).PropertyType);
stFields:
ChildObject := TMVCSerializerHelper.CreateObject(TRttiField(ARttiMember).FieldType);
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
/// <summary>JsonDataObjects assumes values null as jdtObject</summary>
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<TCustomAttribute>);
var
ChildList: IMVCList;
ChildListOfAtt: MVCListOfAttribute;
LEnumAsAttr: MVCEnumSerializationAttribute;
LEnumMappedValues: TList<string>;
LEnumSerType: TMVCEnumSerializationType;
LClazz: TClass;
LMappedValueIndex: Integer;
lOutInteger: Integer;
lInt: Integer;
lOutInteger64: Int64;
lValueTypeInfo: PTypeInfo;
begin
case AJSONObject[APropertyName].Typ of
jdtNone:
Exit;
jdtString:
begin
ParseStringAsTValueUsingMetadata(
AJSONObject[APropertyName].Value,
AValue.TypeInfo,
'property ' + APropertyName,
ACustomAttributes,
AValue);
// lValueTypeInfo := AValue.TypeInfo;
// if (lValueTypeInfo = System.TypeInfo(TDate)) then
// AValue := TValue.From<TDate>(ISODateToDate(AJSONObject[APropertyName].Value))
//
// else if (lValueTypeInfo = System.TypeInfo(TDateTime)) then
// AValue := TValue.From<TDateTime>(ISOTimeStampToDateTime(AJSONObject[APropertyName].Value))
//
// else if (lValueTypeInfo = System.TypeInfo(TTime)) then
// AValue := TValue.From<TTime>(ISOTimeToTime(AJSONObject[APropertyName].Value))
// else if (AValue.Kind = tkRecord) and (lValueTypeInfo <> TypeInfo(TValue)) then { nullables }
// begin
// if lValueTypeInfo = TypeInfo(NullableString) then
// begin
// AValue := TValue.From<NullableString>(NullableString(AJSONObject[APropertyName].Value))
// end
// else if lValueTypeInfo = TypeInfo(NullableTDate) then
// begin
// AValue := TValue.From<NullableTDate>(NullableTDate(ISODateToDate(AJSONObject[APropertyName].Value)))
// end
// else if lValueTypeInfo = TypeInfo(NullableTDateTime) then
// begin
// AValue := TValue.From<NullableTDateTime>
// (NullableTDateTime(ISOTimeStampToDateTime(AJSONObject[APropertyName].Value)))
// end
// else if lValueTypeInfo = TypeInfo(NullableTTime) then
// begin
// AValue := TValue.From<NullableTTime>(NullableTTime(ISOTimeToTime(AJSONObject[APropertyName].Value)))
// end
// else if lValueTypeInfo = TypeInfo(NullableTGUID) then
// begin
// AValue := TValue.From<NullableTGUID>(TMVCGuidHelper.StringToGUIDEx(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<MVCEnumSerializationAttribute>(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 lValueTypeInfo.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<string>(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<Integer>(AJSONObject[APropertyName].IntValue);
end
else
begin
lValueTypeInfo := AValue.TypeInfo;
if lValueTypeInfo = TypeInfo(NullableInt32) then
AValue := TValue.From<NullableInt32>(NullableInt32(AJSONObject[APropertyName].IntValue))
else if lValueTypeInfo = TypeInfo(NullableUInt32) then
AValue := TValue.From<NullableUInt32>(NullableUInt32(AJSONObject[APropertyName].IntValue))
else if lValueTypeInfo = TypeInfo(NullableInt16) then
AValue := TValue.From<NullableInt16>(NullableInt16(AJSONObject[APropertyName].IntValue))
else if lValueTypeInfo = TypeInfo(NullableUInt16) then
AValue := TValue.From<NullableUInt16>(NullableUInt16(AJSONObject[APropertyName].IntValue))
else if lValueTypeInfo = TypeInfo(NullableInt64) then
AValue := TValue.From<NullableInt64>(NullableInt64(AJSONObject[APropertyName].LongValue))
else if lValueTypeInfo = TypeInfo(NullableUInt64) then
AValue := TValue.From<NullableUInt64>(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<TTimeStamp>(MSecsToTimeStamp(AJSONObject[APropertyName].LongValue))
end
else if (AValue.Kind <> tkRecord) then { nullables }
begin
AValue := TValue.From<Int64>(AJSONObject[APropertyName].LongValue);
end
else
begin
if lValueTypeInfo = TypeInfo(NullableInt64) then
AValue := TValue.From<NullableInt64>(NullableInt64(AJSONObject[APropertyName].LongValue))
else if lValueTypeInfo = TypeInfo(NullableUInt64) then
AValue := TValue.From<NullableUInt64>(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<Double>(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<TDateTime>(AJSONObject[APropertyName].DateTimeValue);
end
else
begin
if AValue.TypeInfo = TypeInfo(NullableTDate) then
AValue := TValue.From<NullableTDate>(NullableTDate(AJSONObject[APropertyName].DateTimeValue))
else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then
AValue := TValue.From<NullableTDateTime>(NullableTDateTime(AJSONObject[APropertyName].DateTimeValue))
else if AValue.TypeInfo = TypeInfo(NullableTTime) then
AValue := TValue.From<NullableTTime>(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<Boolean>(AJSONObject[APropertyName].BoolValue);
end
else
begin
if AValue.TypeInfo = TypeInfo(NullableBoolean) then
AValue := TValue.From<NullableBoolean>(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>(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<MVCListOfAttribute>(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<TCustomAttribute>; const ARTTIField: TRttiField);
var
LEnumAsAttr: MVCEnumSerializationAttribute;
LEnumMappedValues: TList<string>;
LEnumSerType: TMVCEnumSerializationType;
LMappedValueIndex: Integer;
lOutInteger: Integer;
lInt: Integer;
lOutInteger64: Int64;
lChildObject: TObject;
lRef: PByte;
lInnerType: TRttiType;
lCtx: TRttiContext;
lArr: TArray<TValue>;
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<TDate>(ISODateToDate(AJSONObject[APropertyName].Value))
else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then
AValue := TValue.From<TDateTime>(ISOTimeStampToDateTime(AJSONObject[APropertyName].Value))
else if (AValue.TypeInfo = System.TypeInfo(TTime)) then
AValue := TValue.From<TTime>(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>(NullableString(AJSONObject[APropertyName].Value))
end
else if AValue.TypeInfo = TypeInfo(NullableTDate) then
begin
AValue := TValue.From<NullableTDate>(NullableTDate(ISODateToDate(AJSONObject[APropertyName].Value)))
end
else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then
begin
AValue := TValue.From<NullableTDateTime>
(NullableTDateTime(ISOTimeStampToDateTime(AJSONObject[APropertyName].Value)))
end
else if AValue.TypeInfo = TypeInfo(NullableTTime) then
begin
AValue := TValue.From<NullableTTime>(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<MVCEnumSerializationAttribute>(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<string>(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<Integer>(AJSONObject[APropertyName].IntValue);
end
else
begin
if AValue.TypeInfo = TypeInfo(NullableInt32) then
AValue := TValue.From<NullableInt32>(NullableInt32(AJSONObject[APropertyName].IntValue))
else if AValue.TypeInfo = TypeInfo(NullableUInt32) then
AValue := TValue.From<NullableUInt32>(NullableUInt32(AJSONObject[APropertyName].IntValue))
else if AValue.TypeInfo = TypeInfo(NullableInt16) then
AValue := TValue.From<NullableInt16>(NullableInt16(AJSONObject[APropertyName].IntValue))
else if AValue.TypeInfo = TypeInfo(NullableUInt16) then
AValue := TValue.From<NullableUInt16>(NullableUInt16(AJSONObject[APropertyName].IntValue))
else if AValue.TypeInfo = TypeInfo(NullableInt64) then
AValue := TValue.From<NullableInt64>(NullableInt64(AJSONObject[APropertyName].LongValue))
else if AValue.TypeInfo = TypeInfo(NullableUInt64) then
AValue := TValue.From<NullableUInt64>(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<TTimeStamp>(MSecsToTimeStamp(AJSONObject[APropertyName].LongValue))
end
else if (AValue.Kind <> tkRecord) then { nullables }
begin
AValue := TValue.From<Int64>(AJSONObject[APropertyName].LongValue);
end
else
begin
if AValue.TypeInfo = TypeInfo(NullableInt64) then
AValue := TValue.From<NullableInt64>(NullableInt64(AJSONObject[APropertyName].LongValue))
else if AValue.TypeInfo = TypeInfo(NullableUInt64) then
AValue := TValue.From<NullableUInt64>(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<Double>(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<TDateTime>(AJSONObject[APropertyName].DateTimeValue);
end
else
begin
if AValue.TypeInfo = TypeInfo(NullableTDate) then
AValue := TValue.From<NullableTDate>(NullableTDate(AJSONObject[APropertyName].DateTimeValue))
else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then
AValue := TValue.From<NullableTDateTime>(NullableTDateTime(AJSONObject[APropertyName].DateTimeValue))
else if AValue.TypeInfo = TypeInfo(NullableTTime) then
AValue := TValue.From<NullableTTime>(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<Boolean>(AJSONObject[APropertyName].BoolValue);
end
else
begin
if AValue.TypeInfo = TypeInfo(NullableBoolean) then
AValue := TValue.From<NullableBoolean>(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>(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];
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];
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, 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<MVCDoNotDeserializeAttribute>(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<MVCDoNotDeserializeAttribute>(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<MVCDoNotDeserializeAttribute>(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<MVCDoNotDeserializeAttribute>(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<MVCDoNotSerializeAttribute>(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<MVCDoNotSerializeAttribute>(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<MVCDoNotSerializeAttribute>(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<MVCDoNotSerializeAttribute>(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<TMVCDataSetField>;
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<MVCDoNotSerializeAttribute>(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<MVCDoNotSerializeAttribute>(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<T>(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<TJDOJsonArray>(AString);
end;
class function TMVCJsonDataObjectsSerializer.ParseObject(const AString: string): TJDOJsonObject;
begin
Result := Parse<TJDOJsonObject>(AString);
end;
procedure TMVCJsonDataObjectsSerializer.ParseStringAsTValueUsingMetadata(
const AStringValue: String;
const DestinationTypeInfo: PTypeInfo;
const ExceptionHintString: String;
const AAttributes: TArray<TCustomAttribute>;
var AValue: TValue);
var
lValueTypeInfo: PTypeInfo;
LEnumSerType: TMVCEnumSerializationType;
LEnumAsAttr: MVCEnumSerializationAttribute;
LEnumMappedValues: TList<string>;
LMappedValueIndex: Integer;
lOutInteger: Integer;
lOutInteger64: Int64;
lInt: Integer;
begin
lValueTypeInfo := DestinationTypeInfo;
if (lValueTypeInfo = System.TypeInfo(TDate)) then
AValue := TValue.From<TDate>(ISODateToDate(AStringValue))
else if (lValueTypeInfo = System.TypeInfo(TDateTime)) then
AValue := TValue.From<TDateTime>(ISOTimeStampToDateTime(AStringValue))
else if (lValueTypeInfo = System.TypeInfo(TTime)) then
AValue := TValue.From<TTime>(ISOTimeToTime(AStringValue))
else if (lValueTypeInfo.Kind = tkRecord) and (lValueTypeInfo <> TypeInfo(TValue)) then { nullables }
begin
if lValueTypeInfo = TypeInfo(NullableString) then
begin
AValue := TValue.From<NullableString>(NullableString(AStringValue))
end
else if lValueTypeInfo = TypeInfo(NullableTDate) then
begin
AValue := TValue.From<NullableTDate>(NullableTDate(ISODateToDate(AStringValue)))
end
else if lValueTypeInfo = TypeInfo(NullableTDateTime) then
begin
AValue := TValue.From<NullableTDateTime>
(NullableTDateTime(ISOTimeStampToDateTime(AStringValue)))
end
else if lValueTypeInfo = TypeInfo(NullableTTime) then
begin
AValue := TValue.From<NullableTTime>(NullableTTime(ISOTimeToTime(AStringValue)))
end
else if lValueTypeInfo = TypeInfo(NullableTGUID) then
begin
AValue := TValue.From<NullableTGUID>(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<MVCEnumSerializationAttribute>(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<string>(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
ObjectToJsonObject(Obj, JSONArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes)
end
else
begin
JSONArray.Add(TJsonObject(nil));
end;
end;
end;
Result := JSONArray.ToJSON(True);
finally
JSONArray.Free;
end;
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<string>;
begin
if not Assigned(AObject) then
Exit('null');
LIgnoredAttrs := TList<string>.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>(NullableSingle(JSONDataObject[AttribName].FloatValue))
else if Value.TypeInfo = TypeInfo(NullableCurrency) then
Value := TValue.From<NullableCurrency>(NullableCurrency(JSONDataObject[AttribName].FloatValue))
else if Value.TypeInfo = TypeInfo(NullableDouble) then
Value := TValue.From<NullableDouble>(NullableDouble(JSONDataObject[AttribName].FloatValue))
else if Value.TypeInfo = TypeInfo(NullableExtended) then
Value := TValue.From<NullableExtended>(NullableExtended(JSONDataObject[AttribName].FloatValue))
else
Result := False;
end;
function TMVCJsonDataObjectsSerializer.TryNullableToJSON(const AValue: TValue; const AJSONObject: TJDOJsonObject;
const AName: string; const ACustomAttributes: TArray<TCustomAttribute>): Boolean;
begin
Result := False;
if (AValue.TypeInfo = System.TypeInfo(NullableString)) then
begin
if AValue.AsType<NullableString>().HasValue then
begin
AJSONObject.S[AName] := AValue.AsType<NullableString>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableInt32)) then
begin
if AValue.AsType<NullableInt32>().HasValue then
begin
AJSONObject.I[AName] := AValue.AsType<NullableInt32>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableInt64)) then
begin
if AValue.AsType<NullableInt64>().HasValue then
begin
AJSONObject.L[AName] := AValue.AsType<NullableInt64>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableInt16)) then
begin
if AValue.AsType<NullableInt16>().HasValue then
begin
AJSONObject.I[AName] := AValue.AsType<NullableInt16>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableTDate)) then
begin
if AValue.AsType<NullableTDate>().HasValue then
begin
AJSONObject.S[AName] := DateToISODate(AValue.AsType<NullableTDate>().Value);
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableTDateTime)) then
begin
if AValue.AsType<NullableTDateTime>().HasValue then
begin
AJSONObject.S[AName] := DateTimeToISOTimeStamp(AValue.AsType<NullableTDateTime>().Value);
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableTTime)) then
begin
if AValue.AsType<NullableTTime>().HasValue then
begin
AJSONObject.S[AName] := TimeToISOTime(AValue.AsType<NullableTTime>().Value);
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableBoolean)) then
begin
if AValue.AsType<NullableBoolean>().HasValue then
begin
AJSONObject.B[AName] := AValue.AsType<NullableBoolean>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableCurrency)) then
begin
if AValue.AsType<NullableCurrency>().HasValue then
begin
AJSONObject.F[AName] := AValue.AsType<NullableCurrency>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableSingle)) then
begin
if AValue.AsType<NullableSingle>().HasValue then
begin
AJSONObject.F[AName] := AValue.AsType<NullableSingle>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableDouble)) then
begin
if AValue.AsType<NullableDouble>().HasValue then
begin
AJSONObject.F[AName] := AValue.AsType<NullableDouble>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableExtended)) then
begin
if AValue.AsType<NullableExtended>().HasValue then
begin
AJSONObject.F[AName] := AValue.AsType<NullableExtended>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
{ from here all nullable integers }
if (AValue.TypeInfo = System.TypeInfo(NullableUInt16)) then
begin
if AValue.AsType<NullableUInt16>().HasValue then
begin
AJSONObject.I[AName] := AValue.AsType<NullableUInt16>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableUInt32)) then
begin
if AValue.AsType<NullableUInt32>().HasValue then
begin
AJSONObject.I[AName] := AValue.AsType<NullableUInt32>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableUInt64)) then
begin
if AValue.AsType<NullableUInt64>().HasValue then
begin
AJSONObject.I[AName] := AValue.AsType<NullableUInt64>().Value;
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
if (AValue.TypeInfo = System.TypeInfo(NullableTGUID)) then
begin
if AValue.AsType<NullableTGUID>().HasValue then
begin
if TMVCSerializerHelper.AttributeExists<MVCSerializeGuidWithoutBracesAttribute>(ACustomAttributes) then
AJSONObject.S[AName] := TMVCGuidHelper.GUIDToStringEx(AValue.AsType<NullableTGUID>().Value)
else
AJSONObject.S[AName] := GUIDToString(AValue.AsType<NullableTGUID>().Value);
end
else
begin
AJSONObject.Values[AName] := nil;
end;
Exit(True);
end;
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;
raise EMVCDeserializationException.Create('Invalid JSON Object - ' + E.Message);
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;
raise EMVCDeserializationException.Create('Invalid JSON Array - ' + E.Message);
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;
// lSer.JsonArrayToList(AJsonArray, AList, AClazz, AType, AIgnoredAttributes);
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<T>(const JSONObject: TJsonObject): T;
var
lTypeSize: Integer;
lTypeInfo: PTypeInfo;
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;
lTypeInfo := lRTTIType.Handle;
lBuffer := @Result;
lField := nil;
AIgnoredAttributes := [];
try
for lField in lRTTIType.GetFields do
if (not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lField)) and
(not IsIgnoredAttribute(AIgnoredAttributes, lField.Name)) then
begin
lKeyName := TMVCSerializerHelper.GetKeyName(lField, lRTTIType);
if lField.FieldType.IsRecord 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<T>(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<T>(const JSONArray: TJsonArray): TArray<T>;
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<T>(JSONArray.Items[I].ObjectValue, lSer);
end;
finally
lSer.Free;
end;
end;
class function TJSONUtils.JSONArrayToArrayOfRecord<T>(const JSONRPCResponse: IInterface): TArray<T>;
var
lIntf: IJSONRPCResponse;
begin
if Supports(JSONRPCResponse, IJSONRPCResponse, lIntf) then
begin
Result := TJSONUtils.JSONArrayToArrayOfRecord<T>(lIntf.ResultAsJSONArray);
end
else
begin
RaiseSerializationError('Parameter doesn''t support IJSONRPCResponse');
end;
end;
class function TJSONUtils.JSONArrayToListOf<T>(const JSONArray: TJsonArray): TObjectList<T>;
var
I: Integer;
lSer: TMVCJsonDataObjectsSerializer;
begin
lSer := TMVCJsonDataObjectsSerializer.Create(nil);
try
Result := TObjectList<T>.Create(True);
try
for I := 0 to JSONArray.Count - 1 do
begin
Result.Add(JsonObjectToObject<T>(JSONArray.Items[I].ObjectValue));
end;
except
Result.Free;
raise;
end;
finally
lSer.Free;
end;
end;
class function TJSONUtils.JsonObjectToObject<T>(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<T>(const JSONRPCResponse: IInterface): T;
var
lIntf: IJSONRPCResponse;
begin
if Supports(JSONRPCResponse, IJSONRPCResponse, lIntf) then
begin
Result := TJSONUtils.JSONObjectToRecord<T>(lIntf.ResultAsJSONObject);
end
else
begin
RaiseSerializationError('Parameter doesn''t support IJSONRPCResponse');
end;
end;
class function TJSONUtils.JSONObjectToRecord<T>(const JSONObject: TJsonObject): T;
var
lSer: TMVCJsonDataObjectsSerializer;
begin
lSer := TMVCJsonDataObjectsSerializer.Create(nil);
try
Result := JSONObjectToRecord<T>(JSONObject, lSer);
finally
lSer.Free;
end;
end;
class function TJSONUtils.JSONObjectToRecord<T>(const JSONObject: TJsonObject;
const Serializer: TMVCJsonDataObjectsSerializer): T;
begin
Result := Serializer.JSONObjectToRecord<T>(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.
Reference in New Issue View Git Blame Copy Permalink