paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 22:49:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r46329 from trunk:

Browse Source 
------------------------------------------------------------------------
    r46329 | michael | 2020-08-08 14:36:47 +0200 (Sat, 08 Aug 2020) | 1 line
    
    * Added jdoNullClearsProperty
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46637 -
This commit is contained in:
michael 2020-08-23 10:23:18 +00:00
parent 3d7a00bfc9
commit bac46c9d3b
1 changed files with 58 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
packages/fcl-json/src/fpjsonrtti.pp
View File

@ -115,7 +115,7 @@ Type
TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors,jdoIgnoreNulls);
TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors,jdoIgnoreNulls,jdoNullClearsProperty);
TJSONDestreamOptions = set of TJSONDestreamOption;
TJSONDeStreamer = Class(TJSONFiler)
@ -134,6 +134,7 @@ Type
// Try to parse a date.
Function ExtractDateTime(S : String): TDateTime;
function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
procedure DoClearProperty(AObject: TObject; PropInfo: PPropInfo); virtual;
procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData); virtual;
function DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData; virtual;
procedure DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject); virtual;
@ -398,8 +399,13 @@ begin
If B then
exit;
end;
if (PropData.JSONType<>jtNull) or not (jdoIgnoreNulls in Options) then
if (PropData.JSONType<>jtNull) then
DoRestoreProperty(AObject,PropInfo,PropData)
else if (jdoNullClearsProperty in Options) then
DoClearProperty(aObject,PropInfo)
else if not (jdoIgnoreNulls in Options) then
DoRestoreProperty(AObject,PropInfo,PropData)
except
On E : Exception do
If Assigned(FOnPropError) then
@ -414,6 +420,56 @@ begin
end;
end;
procedure TJSONDeStreamer.DoClearProperty(AObject : TObject;PropInfo : PPropInfo);
Var
PI : PPropInfo;
TI : PTypeInfo;
I,J,S : Integer;
A : TJSONArray;
JS : TJSONStringType;
begin
PI:=PropInfo;
TI:=PropInfo^.PropType;
case TI^.Kind of
tkUnknown :
Error(SErrUnknownPropertyKind,[PI^.Name]);
tkInteger,
tkEnumeration,
tkSet,
tkChar,
tkWChar,
tkBool,
tkQWord,
tkUChar,
tkInt64 :
SetOrdProp(AObject,PI,0);
tkFloat :
SetFloatProp(AObject,PI,0.0);
tkSString,
tkLString,
tkAString:
SetStrProp(AObject,PI,'');
tkWString :
SetWideStrProp(AObject,PI,'');
tkVariant:
SetVariantProp(AObject,PI,Null);
tkClass:
SetOrdProp(AObject,PI,0);
tkUString :
SetUnicodeStrProp(AObject,PI,'');
tkObject,
tkArray,
tkRecord,
tkInterface,
tkDynArray,
tkInterfaceRaw,
tkProcVar,
tkMethod :
Error(SErrUnsupportedPropertyKind,[PI^.Name]);
end;
end;
procedure TJSONDeStreamer.DoRestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
Var