paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 14:39:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added jdoNullClearsProperty

Browse Source 
git-svn-id: trunk@46329 -
This commit is contained in:
michael 2020-08-08 12:36:47 +00:00
parent a5a4a32ff9
commit cc4e6458c4
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

@ -113,7 +113,7 @@ Type
TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object; 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; 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); 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; TJSONDestreamOptions = set of TJSONDestreamOption;
TJSONDeStreamer = Class(TJSONFiler) TJSONDeStreamer = Class(TJSONFiler)
@ -132,6 +132,7 @@ Type
// Try to parse a date. // Try to parse a date.
Function ExtractDateTime(S : String): TDateTime; Function ExtractDateTime(S : String): TDateTime;
function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject; 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; procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData); virtual;
function DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData; virtual; function DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData; virtual;
procedure DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject); virtual; procedure DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject); virtual;
@ -396,8 +397,13 @@ begin
If B then If B then
exit; exit;
end; end;
if (PropData.JSONType<>jtNull) or not (jdoIgnoreNulls in Options) then if (PropData.JSONType<>jtNull) then
DoRestoreProperty(AObject,PropInfo,PropData) 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 except
On E : Exception do On E : Exception do
If Assigned(FOnPropError) then If Assigned(FOnPropError) then
@ -412,6 +418,56 @@ begin
end; end;
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); procedure TJSONDeStreamer.DoRestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
Var Var