Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

+ First changes to allow records as JSONRPC parameters

Browse Source
This commit is contained in:
Daniele Teti 2022-05-25 15:13:49 +02:00
parent 0fac2dd2fa
commit 63cc2aa4c6
9 changed files with 618 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
samples/jsonrpc_with_published_objects/MainClientFormU.dfm
View File

@ -17,7 +17,7 @@ object MainForm: TMainForm
Top = 0
Width = 842
Height = 604
ActivePage = TabSheet5
ActivePage = TabSheet1
Align = alClient
TabOrder = 0
object TabSheet1: TTabSheet

31
samples/jsonrpc_with_published_objects/MyObjectU.pas
View File

@ -36,6 +36,21 @@ uses
MVCFramework.Commons, MVCFramework, MVCFramework.JSONRPC;
type
[MVCNameCase(ncCamelCase)]
TChildRec = record
ChildName: String;
ChildSurname: String;
end;
[MVCNameCase(ncCamelCase)]
TPersonRec = record
Name: String;
Surname: String;
[MVCNameAs('pippi')]
Age: Integer;
Child: TChildRec;
end;
TMyObject = class
private
function GetCustomersDataset: TFDMemTable;
@ -63,6 +78,8 @@ type
function GetStringDictionary: TMVCStringDictionary;
function GetUser(aUserName: string): TPerson;
function SavePerson(const Person: TJsonObject): Integer;
function SavePersonRec(const PersonRec: TPersonRec): TPersonRec;
function GetPersonRec: TPersonRec;
function FloatsTest(const aDouble: Double; const aExtended: Extended): Extended;
procedure DoSomething;
procedure RaiseCustomException;
@ -215,6 +232,15 @@ begin
Result := lDate;
end;
function TMyObject.GetPersonRec: TPersonRec;
begin
Result.Name := 'Daniele';
Result.Surname := 'Teti';
Result.Age := 42;
Result.Child.ChildName := 'Mattia';
Result.Child.ChildSurname := 'Teti';
end;
// function TMyObject.GetPeopleDataset: TFDMemTable;
// var
// lMT: TFDMemTable;
@ -333,6 +359,11 @@ begin
Result := Random(1000);
end;
function TMyObject.SavePersonRec(const PersonRec: TPersonRec): TPersonRec;
begin
Result := PersonRec;
end;
function TMyObject.Subtract(Value1, Value2: Integer): Integer;
begin
Result := Value1 - Value2;

18
samples/jsonrpc_with_published_objects/jsonrpc_with_objects_group.groupproj
View File

@ -9,6 +9,9 @@
<Projects Include="jsonrpcclientwithobjects.dproj">
<Dependencies/>
</Projects>
<Projects Include="C:\WORK\ORION\tests\PlainSerialier.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
@ -35,14 +38,23 @@
<Target Name="jsonrpcclientwithobjects:Make">
<MSBuild Projects="jsonrpcclientwithobjects.dproj" Targets="Make"/>
</Target>
<Target Name="PlainSerialier">
<MSBuild Projects="C:\WORK\ORION\tests\PlainSerialier.dproj"/>
</Target>
<Target Name="PlainSerialier:Clean">
<MSBuild Projects="C:\WORK\ORION\tests\PlainSerialier.dproj" Targets="Clean"/>
</Target>
<Target Name="PlainSerialier:Make">
<MSBuild Projects="C:\WORK\ORION\tests\PlainSerialier.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="jsonrpcserverwithobjects;jsonrpcclientwithobjects"/>
<CallTarget Targets="jsonrpcserverwithobjects;jsonrpcclientwithobjects;PlainSerialier"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="jsonrpcserverwithobjects:Clean;jsonrpcclientwithobjects:Clean"/>
<CallTarget Targets="jsonrpcserverwithobjects:Clean;jsonrpcclientwithobjects:Clean;PlainSerialier:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="jsonrpcserverwithobjects:Make;jsonrpcclientwithobjects:Make"/>
<CallTarget Targets="jsonrpcserverwithobjects:Make;jsonrpcclientwithobjects:Make;PlainSerialier:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

5
samples/jsonrpc_with_published_objects/jsonrpcserverwithobjects.dproj
View File

@ -70,6 +70,7 @@
<DCC_UnitSearchPath>$(DMVC);$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_Framework>VCL;$(DCC_Framework)</DCC_Framework>
<SanitizedProjectName>jsonrpcserverwithobjects</SanitizedProjectName>
<VerInfo_Locale>1040</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android)'!=''">
<DCC_UsePackage>DBXSqliteDriver;DBXInterBaseDriver;tethering;bindcompfmx;FmxTeeUI;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;bindengine;DataSnapClient;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;ibmonitor;FMXTee;DbxCommonDriver;ibxpress;xmlrtl;DataSnapNativeClient;FireDACDSDriver;rtl;ibxbindings;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage)</DCC_UsePackage>
@ -164,6 +165,10 @@
<Source>
<Source Name="MainSource">jsonrpcserverwithobjects.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k280.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp280.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">

99
sources/MVCFramework.JSONRPC.pas
View File

@ -131,7 +131,7 @@ type
end;
TJSONRPCParamDataType = (pdtString, pdtInteger, pdtLongInteger, pdTJDOJsonObject, pdtJSONArray, pdtBoolean, pdtDate,
pdtTime, pdtDateTime, pdtFloat, pdtObject);
pdtTime, pdtDateTime, pdtFloat, pdtObject, pdtRecord);
TJSONRPCRequestParams = class
private
@ -179,7 +179,7 @@ type
IJSONRPCNotification = interface(IJSONRPCObject)
['{FAA65A29-3305-4303-833E-825BDBD3FF7F}']
procedure SetMethod(const Value: string);
procedure FillParameters(const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod);
procedure FillParameters(const Serializer: TMVCJsonDataObjectsSerializer; const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod; var MethodParameters: TArray<TValue>);
function GetMethod: string;
function GetParams: TJSONRPCRequestParams;
property Method: string read GetMethod write SetMethod;
@ -190,7 +190,7 @@ type
protected
FMethod: string;
FParams: TJSONRPCRequestParams;
procedure FillParameters(const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod);
procedure FillParameters(const Serializer: TMVCJsonDataObjectsSerializer; const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod; var MethodParameters: TArray<TValue>);
procedure SetMethod(const Value: string);
function GetMethod: string;
function GetParams: TJSONRPCRequestParams;
@ -688,8 +688,8 @@ begin
Result := RTTIParameter.Name + ': ' + RTTIParameter.ParamType.Name;
end;
procedure JSONDataValueToTValueParam(const JSONDataValue: TJsonDataValueHelper; const RTTIParameter: TRttiParameter;
const JSONRPCRequestParams: TJSONRPCRequestParams);
procedure JSONDataValueToTValueParam(const Serializer: TMVCJsonDataObjectsSerializer; const JSONDataValue: TJsonDataValueHelper; const RTTIParameter: TRttiParameter;
{const JSONRPCRequestParams: TJSONRPCRequestParams;} var MethodParams: TArray<TValue>; const MethodParamIndex: Integer);
begin
case RTTIParameter.ParamType.TypeKind of
tkString, tkUString {$IF CompilerVersion > 28}, tkAnsiString {$ENDIF}:
@ -698,24 +698,33 @@ begin
begin
raise EMVCJSONRPCInvalidParams.Create('Invalid param type for [' + BuildDeclaration(RTTIParameter) + ']');
end;
JSONRPCRequestParams.Add(JSONDataValue.Value);
//JSONRPCRequestParams.Add(JSONDataValue.Value);
MethodParams[MethodParamIndex] := TValue.From<String>(JSONDataValue.Value);
end;
tkFloat:
begin
if SameText(RTTIParameter.ParamType.Name, 'TDate') then
begin
JSONRPCRequestParams.Add(ISODateToDate(JSONDataValue.Value), pdtDate);
//JSONRPCRequestParams.Add(ISODateToDate(JSONDataValue.Value), pdtDate);
MethodParams[MethodParamIndex] := TValue.From<TDate>(ISODateToDate(JSONDataValue.Value));
end
else if SameText(RTTIParameter.ParamType.Name, 'TDateTime') then
begin
if JSONDataValue.Value.Contains('T') then
JSONRPCRequestParams.Add(JSONDataValue.UtcDateTimeValue, pdtDateTime)
begin
//JSONRPCRequestParams.Add(JSONDataValue.UtcDateTimeValue, pdtDateTime)
MethodParams[MethodParamIndex] := TValue.From<TDateTime>(JSONDataValue.UtcDateTimeValue);
end
else
JSONRPCRequestParams.Add(ISOTimeStampToDateTime(JSONDataValue.Value), pdtDateTime);
begin
//JSONRPCRequestParams.Add(ISOTimeStampToDateTime(JSONDataValue.Value), pdtDateTime);
MethodParams[MethodParamIndex] := TValue.From<TDateTime>(ISOTimeStampToDateTime(JSONDataValue.Value));
end;
end
else if SameText(RTTIParameter.ParamType.Name, 'TTime') then
begin
JSONRPCRequestParams.Add(ISOTimeToTime(JSONDataValue.Value), pdtTime);
//JSONRPCRequestParams.Add(ISOTimeToTime(JSONDataValue.Value), pdtTime);
MethodParams[MethodParamIndex] := TValue.From<TTime>(ISOTimeToTime(JSONDataValue.Value));
end
else
begin
@ -723,18 +732,22 @@ begin
// FIX https://github.com/danieleteti/delphimvcframework/issues/270
case JSONDataValue.Typ of
jdtInt:
JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtFloat);
//JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtFloat);
MethodParams[MethodParamIndex] := TValue.From<Double>(JSONDataValue.IntValue);
jdtLong:
JSONRPCRequestParams.Add(JSONDataValue.LongValue, pdtFloat);
// JSONRPCRequestParams.Add(JSONDataValue.LongValue, pdtFloat);
MethodParams[MethodParamIndex] := TValue.From<Int64>(JSONDataValue.LongValue);
jdtULong:
JSONRPCRequestParams.Add(JSONDataValue.ULongValue, pdtFloat);
// JSONRPCRequestParams.Add(JSONDataValue.ULongValue, pdtFloat);
MethodParams[MethodParamIndex] := TValue.From<UInt64>(JSONDataValue.ULongValue);
else
begin
if JSONDataValue.Typ <> jdtFloat then
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
JSONRPCRequestParams.Add(JSONDataValue.FloatValue, pdtFloat);
//JSONRPCRequestParams.Add(JSONDataValue.FloatValue, pdtFloat);
MethodParams[MethodParamIndex] := TValue.From<Double>(JSONDataValue.FloatValue);
end;
end;
end
@ -745,51 +758,68 @@ begin
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
JSONRPCRequestParams.Add(JSONDataValue.BoolValue, pdtBoolean);
//JSONRPCRequestParams.Add(JSONDataValue.BoolValue, pdtBoolean);
MethodParams[MethodParamIndex] := TValue.From<Boolean>(JSONDataValue.BoolValue);
end;
tkClass:
begin
if (SameText(RTTIParameter.ParamType.Name, TJDOJsonArray.ClassName)) then
begin
JSONRPCRequestParams.Add(JSONDataValue.ArrayValue.Clone, pdtJSONArray);
//JSONRPCRequestParams.Add(JSONDataValue.ArrayValue.Clone, pdtJSONArray);
MethodParams[MethodParamIndex] := TValue.From<TJDOJsonArray>(JSONDataValue.ArrayValue.Clone);
end
else if SameText(RTTIParameter.ParamType.Name, TJDOJsonObject.ClassName) then
begin
JSONRPCRequestParams.Add(JSONDataValue.ObjectValue.Clone as TJDOJsonObject, pdTJDOJsonObject);
//JSONRPCRequestParams.Add(JSONDataValue.ObjectValue.Clone as TJDOJsonObject, pdTJDOJsonObject);
MethodParams[MethodParamIndex] := TValue.From<TJDOJsonObject>(JSONDataValue.ObjectValue.Clone);
end
else
begin
{ TODO -oDanieleT -cGeneral : Automatically inject the dseserialized version of arbitrary object? }
{ TODO -oDanieleT -cGeneral : Automatically inject the deserialized version of arbitrary object? }
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
end;
tkRecord:
begin
var lTypeSize := RTTIParameter.ParamType.TypeSize;
var lTypeInfo := RTTIParameter.ParamType.Handle;
var lBuffer: PByte := GetMemory(lTypeSize);
var lRec := RTTIParameter.ParamType.AsRecord;
Serializer.JSONObjectToRecord(JSONDataValue.ObjectValue, lRec, lBuffer);
//InvokeRecordInitializer(lBuffer, lRec.Handle);
{TODO -oDanieleT -cGeneral : JSONObjectToRecord}
TValue.MakeWithoutCopy(lBuffer, lRec.Handle, MethodParams[MethodParamIndex]);
end;
tkInteger:
begin
if JSONDataValue.Typ <> jdtInt then
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtInteger);
//JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtInteger);
MethodParams[MethodParamIndex] := TValue.From<Integer>(JSONDataValue.IntValue);
end;
tkInt64:
begin
if JSONDataValue.Typ = jdtInt then
begin
JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtInteger);
//JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtInteger);
MethodParams[MethodParamIndex] := TValue.From<Integer>(JSONDataValue.IntValue);
end
else if JSONDataValue.Typ = jdtLong then
begin
JSONRPCRequestParams.Add(JSONDataValue.LongValue, pdtLongInteger);
//JSONRPCRequestParams.Add(JSONDataValue.LongValue, pdtLongInteger);
MethodParams[MethodParamIndex] := TValue.From<Int64>(JSONDataValue.LongValue);
end
else if JSONDataValue.Typ = jdtULong then
begin
JSONRPCRequestParams.Add(JSONDataValue.ULongValue, pdtLongInteger);
// JSONRPCRequestParams.Add(JSONDataValue.ULongValue, pdtLongInteger);
MethodParams[MethodParamIndex] := TValue.From<UInt64>(JSONDataValue.ULongValue);
end
else
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
end;
else
begin
@ -1173,6 +1203,7 @@ procedure TMVCJSONRPCController.Index;
var
lJSONRPCReq: IJSONRPCRequest;
lMethod: string;
lMethodParameters: TArray<TValue>;
lRTTI: TRTTIContext;
lRTTIType: TRttiType;
lRTTIMethod: TRTTIMethod;
@ -1189,6 +1220,7 @@ var
lAllMethodsCallableWithGET: Boolean;
lExceptionHandled: Boolean;
lJSONRespErrorInfo: TMVCJSONRPCExceptionErrorInfo;
lSerializer: TMVCJsonDataObjectsSerializer;
begin
lBeforeCallHookHasBeenInvoked := False;
lAfterCallHookHasBeenInvoked := False;
@ -1283,14 +1315,19 @@ begin
end;
end;
lSerializer := TMVCJsonDataObjectsSerializer.Create(nil);
try
lJSONRPCReq.FillParameters(lJSON, lRTTIMethod);
try
lJSONRPCReq.FillParameters(lSerializer, lJSON, lRTTIMethod, lMethodParameters);
except
on Ex: EMVCJSONRPCErrorResponse do
begin
raise EMVCJSONRPCInvalidParams.Create('Cannot map all parameters to remote method. ' + Ex.Message);
end;
end;
finally
lSerializer.Free;
end;
lJSONResp := nil;
// try
@ -1299,7 +1336,7 @@ begin
try
LogD('[JSON-RPC][CALL][' + CALL_TYPE[lRTTIMethod.MethodKind] + '][' + fRPCInstance.ClassName + '.' +
lRTTIMethod.Name + ']');
lRes := lRTTIMethod.Invoke(fRPCInstance, lJSONRPCReq.Params.ToArray);
lRes := lRTTIMethod.Invoke(fRPCInstance, lMethodParameters);
except
on E: EInvalidCast do
begin
@ -1648,7 +1685,7 @@ begin
inherited;
end;
procedure TJSONRPCNotification.FillParameters(const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod);
procedure TJSONRPCNotification.FillParameters(const Serializer: TMVCJsonDataObjectsSerializer; const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod; var MethodParameters: TArray<TValue>);
var
lRTTIMethodParams: TArray<TRttiParameter>;
lRTTIMethodParam: TRttiParameter;
@ -1716,7 +1753,7 @@ begin
for lRTTIMethodParam in lRTTIMethodParams do
begin
if lRTTIMethodParam.Flags * [pfVar, pfOut, pfArray, pfReference] <> [] then
if lRTTIMethodParam.Flags * [pfVar, pfOut, pfArray {, pfReference}] <> [] then
raise EMVCJSONRPCInvalidParams.CreateFmt
('Parameter modifier not supported for formal parameter [%s]. Only const and value modifiers are allowed.',
[lRTTIMethodParam.Name]);
@ -1725,20 +1762,22 @@ begin
// scroll json params and rttimethod params and find the best match
if Assigned(lJSONParams) then
begin
SetLength(MethodParameters, lJSONParams.Count);
// positional params
for I := 0 to lJSONParams.Count - 1 do
begin
JSONDataValueToTValueParam(lJSONParams[I], lRTTIMethodParams[I], Params);
JSONDataValueToTValueParam(Serializer, lJSONParams[I], lRTTIMethodParams[I], MethodParameters, I);
end;
end
else if Assigned(lJSONNamedParams) then
begin
SetLength(MethodParameters, lJSONNamedParams.Count);
// named params
for I := 0 to lJSONNamedParams.Count - 1 do
begin
JSONDataValueToTValueParam(GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower),
JSONDataValueToTValueParam(Serializer, GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower),
{ lJSONNamedParams.Values[lRTTIMethodParams[I].Name.ToLower], }
lRTTIMethodParams[I], Params);
lRTTIMethodParams[I], MethodParameters, I);
end;
end;
end;

2
sources/MVCFramework.RESTClient.Indy.pas
View File

@ -762,6 +762,8 @@ begin
FHTTP.Request.CustomHeaders.FoldLines := False;
FHTTP.Request.BasicAuthentication := False; // DT 2018/07/24
// https://www.indyproject.org/2016/01/10/new-tidhttp-flags-and-onchunkreceived-event/
FHTTP.HTTPOptions := FHTTP.HTTPOptions + [hoWantProtocolErrorContent, hoNoProtocolErrorException]; //DT 2022/05/24
FSerializer := GetDefaultSerializer;
end;

1
sources/MVCFramework.RESTClient.pas
View File

@ -908,7 +908,6 @@ begin
fLock := TObject.Create;
fBaseURL := '';
fResource := '';
ClearAllParams;
end;

484
sources/MVCFramework.Serializer.JsonDataObjects.pas
View File

@ -70,6 +70,10 @@ type
function TryMapNullableFloat(var Value: TValue; const JSONDataObject: TJsonObject;
const AttribName: string): Boolean;
public
procedure JSONObjectPropertyToTValueForRecord(AJSONObject: TJSONObject;
const APropertyName: String; const AType: TMVCSerializationType;
const AIgnored: TMVCIgnoredList;
var AValue: TValue; const ACustomAttributes: TArray<TCustomAttribute>);
function GetDataSetFields(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase = ncAsIs): TMVCDataSetFields;
procedure ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject;
@ -78,6 +82,10 @@ type
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 AIgnoredAttributes: TMVCIgnoredList;
const ADataSetSerializationCallback: TMVCDataSetFieldSerializationAction;
@ -92,6 +100,7 @@ type
function TryNullableToJSON(const AValue: TValue; const AJsonObject: TJDOJsonObject; const AName: string): 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);
procedure JSONObjectPropertyToTValue(
AJSONObject: TJSONObject;
const APropertyName: String;
@ -246,8 +255,9 @@ begin
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;
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;
@ -406,7 +416,8 @@ begin
end
else
begin
if TMVCSerializerHelper.AttributeExists<MVCSerializeAsStringAttribute>(ACustomAttributes) then
if TMVCSerializerHelper
.AttributeExists<MVCSerializeAsStringAttribute>(ACustomAttributes) then
AJsonObject.S[AName] := EmptyStr
else
AJsonObject[AName] := Null;
@ -429,7 +440,8 @@ begin
end
else if (AValue.TypeInfo = System.TypeInfo(TValue)) then
begin
if TMVCSerializerHelper.AttributeExists<MVCValueAsTypeAttribute>(ACustomAttributes, ValueTypeAtt) then
if TMVCSerializerHelper
.AttributeExists<MVCValueAsTypeAttribute>(ACustomAttributes, ValueTypeAtt) then
begin
CastValue := AValue.AsType<TValue>;
if CastValue.TryCast(ValueTypeAtt.ValueTypeInfo, CastedValue) then
@ -448,8 +460,17 @@ begin
end;
end
else
raise EMVCSerializationException.CreateFmt
('Cannot serialize property or field "%s" of TypeKind tkRecord.', [AName]);
begin
InternalTValueToJsonObject(
AValue,
AJsonObject.O[AName],
TMVCSerializationType.stFields,
[],
nil,
nil,
nil
);
end;
end;
tkSet:
@ -1512,6 +1533,285 @@ begin
end;
end;
procedure TMVCJsonDataObjectsSerializer.JSONObjectPropertyToTValueForRecord(
AJSONObject: TJSONObject;
const APropertyName: String;
const AType: TMVCSerializationType;
const AIgnored: TMVCIgnoredList;
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;
begin
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
{TODO -oDanieleT -cGeneral : Nested record types are not correctly deserialized here}
{
// 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;
}
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.JsonObjectToDataSet(const AJsonObject: TJDOJsonObject; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
var
@ -1741,6 +2041,119 @@ begin
end;
end;
procedure TMVCJsonDataObjectsSerializer.JSONObjectToRecord(
const JSONObject: TJsonObject; RTTIType: TRttiRecordType; out Buffer: PByte);
var
CTX: TRttiContext;
lField: TRTTIField;
lTypeSize: Integer;
lTypeInfo: PTypeInfo;
// lBuffer: PByte;
// lRec: TRttiRecordType;
AType: TMVCSerializationType;
lProp: TRTTIProperty;
AIgnoredAttributes: TMVCIgnoredList;
lKeyName: string;
lAttributeValue: TValue;
lErrMsg: string;
lFld: TRTTIField;
begin
lTypeSize := RTTIType.TypeSize;
lTypeInfo := RTTIType.Handle;
Buffer := GetMemory(lTypeSize);
InvokeRecordInitializer(Buffer, lTypeInfo);
// lRec := RTTIType.AsRecord;
//var
// lObjType: TRttiType;
// lProp: TRttiProperty;
// lFld: TRttiField;
// lAttributeValue: TValue;
// lKeyName: string;
// lErrMsg: string;
//begin
AIgnoredAttributes := [];
AType := stDefault;
case AType of
stProperties:
begin
try
for lProp in RTTIType.GetProperties do
begin
if TMVCSerializerHelper.IsAPropertyToSkip(lProp.Name) then
continue;
if ((not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lProp)) and
(not IsIgnoredAttribute(AIgnoredAttributes, lProp.Name)) and
(lProp.IsWritable or lProp.GetValue(Buffer).IsObject)) then
begin
lAttributeValue := lProp.GetValue(Buffer);
lKeyName := TMVCSerializerHelper.GetKeyName(lProp, RTTIType);
JSONObjectPropertyToTValueForRecord(
JSONObject,
lKeyName,
TMVCSerializationType.stProperties,
AIgnoredAttributes,
lAttributeValue,
lProp.GetAttributes
);
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[JSONObject[lKeyName].Typ]]);
end
else
begin
lErrMsg := Format('Invalid class typecast for property "%s" [Actual: %s]',
[lKeyName, JDO_TYPE_DESC[JSONObject[lKeyName].Typ]]);
end;
raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg);
end;
end;
end;
stDefault, stUnknown, stFields:
begin
try
for lFld in RTTIType.GetFields do
if (not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lFld)) and
(not IsIgnoredAttribute(AIgnoredAttributes, lFld.Name)) then
begin
lAttributeValue := lFld.GetValue(Buffer);
lKeyName := TMVCSerializerHelper.GetKeyName(lFld, RTTIType);
JSONObjectPropertyToTValueForRecord(
JSONObject,
lKeyName,
TMVCSerializationType.stProperties,
AIgnoredAttributes,
lAttributeValue,
lFld.GetAttributes
);
lFld.SetValue(Buffer, 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[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;
end;
end;
procedure TMVCJsonDataObjectsSerializer.ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
const ASerializationAction: TMVCSerializationAction);
@ -1912,6 +2325,62 @@ begin
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;
@ -2531,7 +3000,8 @@ begin
end;
end;
procedure TValueToJSONObjectProperty(const Value: TValue; const JSON: TJDOJsonObject; const KeyName: string);
procedure TValueToJSONObjectProperty(
const Value: TValue; const JSON: TJDOJsonObject; const KeyName: string);
var
lSer: TMVCJsonDataObjectsSerializer;
lMVCList: IMVCList;

14
sources/MVCFramework.SystemJSONUtils.pas
View File

@ -13,7 +13,9 @@ type
class var CTX: TRttiContext;
public
class function StringToJSONValue(const Value: string): TJSONValue;
class function StringToJSONValueNoException(const Value: string): TJSONValue;
class function StringAsJSONObject(const Value: string): TJSONObject;
class function StringAsJSONObjectNoException(const Value: string): TJSONObject;
class function StringAsJSONArray(const Value: string): TJSONArray;
class function JSONValueToString(JSONValue: TJSONValue; const Owns: Boolean = true): string;
class function GetPair(JSONObject: TJSONObject; PropertyName: string)
@ -54,6 +56,12 @@ begin
Result := TSystemJSON.StringToJSONValue(Value) as TJSONObject;
end;
class function TSystemJSON.StringAsJSONObjectNoException(
const Value: string): TJSONObject;
begin
Result := TSystemJSON.StringToJSONValueNoException(Value) as TJSONObject;
end;
class function TSystemJSON.StringToJSONValue(const Value: string): TJSONValue;
var
lBodyAsJSONValue: TJSONValue;
@ -64,6 +72,12 @@ begin
Result := lBodyAsJSONValue;
end;
class function TSystemJSON.StringToJSONValueNoException(
const Value: string): TJSONValue;
begin
Result := TJSONObject.ParseJSONValue(Value);
end;
class function TSystemJSON.JSONValueToString(JSONValue: TJSONValue;
const Owns: Boolean): string;
begin