From 86751055b6cf9e8290d2e1205c1286904aff710b Mon Sep 17 00:00:00 2001 From: Drake Date: Sun, 23 Jun 2019 20:05:04 +0600 Subject: [PATCH 1/3] add single support --- json/clJsonParser.pas | 69 +++++++- json/clJsonSerializer.pas | 351 ++++++++++++++++++++++++-------------- 2 files changed, 284 insertions(+), 136 deletions(-) diff --git a/json/clJsonParser.pas b/json/clJsonParser.pas index 2ea8e52..5fe1cee 100644 --- a/json/clJsonParser.pas +++ b/json/clJsonParser.pas @@ -26,7 +26,10 @@ interface uses - System.Classes, System.SysUtils, System.Contnrs; + System.Classes, + System.SysUtils, + System.Contnrs, + System.Generics.Collections; type EclJSONError = class(Exception) @@ -110,9 +113,21 @@ TclJSONString = class(TclJSONValue) procedure BuildJSONString(ABuffer: TStringBuilder); override; end; + TclJSONSingle = class(TclJSONValue) + private + function GetValue: Single; + procedure SetValue(const value: Single); + public + constructor Create; overload; + constructor Create(AValue: Single); overload; + + property Value: Single read GetValue write SetValue; + end; + TclJSONBoolean = class(TclJSONValue) private function GetValue: Boolean; + procedure SetValue(const Value: Boolean); protected procedure SetValueWideString(const AValue: WideString); override; @@ -190,6 +205,9 @@ TclJSONObject = class(TclJSONBase) function AddBoolean(const AName: string; AValue: Boolean): TclJSONBoolean; overload; function AddBoolean(const AName: WideString; AValue: Boolean): TclJSONBoolean; overload; + function AddSingle(const AName: string; AValue: Single): TclJSONSingle; overload; + function AddSingle(const AName: WideString; AValue: Single): TclJSONSingle; overload; + property Count: Integer read GetCount; property Members[Index: Integer]: TclJSONPair read GetMember; end; @@ -1039,10 +1057,7 @@ procedure TclJSONPair.SetValueWideString(const AValue: WideString); function TclJSONArray.Add(AItem: TclJSONBase): TclJSONBase; begin - if (AItem <> nil) then - begin - FItems.Add(AItem); - end; + if (AItem <> nil) then FItems.Add(AItem); Result := AItem; end; @@ -1190,4 +1205,48 @@ procedure TclJSONBoolean.SetValueWideString(const AValue: WideString); end; end; +function TclJSONSingle.GetValue: Single; +begin + Result := StrToFloat(Self.ValueWideString); +end; + +procedure TclJSONSingle.SetValue(const value: Single); +begin + Self.ValueString := value.ToString; +end; + +constructor TclJSONSingle.Create; +begin + inherited Create(); + Value := 0.0; +end; + +constructor TclJSONSingle.Create(AValue: Single); +begin + inherited Create(); + Value := AValue; +end; + +function TclJSONObject.AddSingle(const AName: string; AValue: Single): TclJSONSingle; +begin + if (AValue <> 0.0) then + begin + Result := TclJSONSingle(AddMember(AName, TclJSONSingle.Create(AValue))); + end else + begin + Result := Nil; + end; +end; + +function TclJSONObject.AddSingle(const AName: WideString; AValue: Single): TclJSONSingle; +begin + if (AValue <> 0.0) then + begin + Result := TclJSONSingle(AddMember(AName, TclJSONSingle.Create(AValue))); + end else + begin + Result := Nil; + end; +end; + end. diff --git a/json/clJsonSerializer.pas b/json/clJsonSerializer.pas index 0325d5f..436a1a6 100644 --- a/json/clJsonSerializer.pas +++ b/json/clJsonSerializer.pas @@ -111,34 +111,63 @@ procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; for i := 0 to AJsonArray.Count - 1 do begin - if (elType.Kind = tkClass) - and (AJsonArray.Items[i] is TclJSONObject) then - begin - objClass := elType.TypeData.ClassType; - rItemValue := Deserialize(objClass, TclJSONObject(AJsonArray.Items[i])); - end else - if (elType.Kind in [tkString, tkLString, tkWString, tkUString]) then - begin - rItemValue := AJsonArray.Items[i].ValueString; - end else - if (elType.Kind = tkInteger) then - begin - rItemValue := StrToInt(AJsonArray.Items[i].ValueString); - end else - if (elType.Kind = tkInt64) then - begin - rItemValue := StrToInt64(AJsonArray.Items[i].ValueString); - end else - if (elType.Kind = tkEnumeration) - and (elType = System.TypeInfo(Boolean)) - and (AJsonArray.Items[i] is TclJSONBoolean) then - begin - rItemValue := TclJSONBoolean(AJsonArray.Items[i]).Value; - end else - begin - raise EclJsonSerializerError.Create(cUnsupportedDataType); + + case elType.Kind of + tkClass: + if (AJsonArray.Items[i] is TclJSONObject) then begin + objClass := elType.TypeData.ClassType; + rItemValue := Deserialize(objClass, TclJSONObject(AJsonArray.Items[i])); + end; + + tkString, tkLString, tkWString, tkUString: + rItemValue := AJsonArray.Items[i].ValueString; + + tkInteger: + rItemValue := StrToInt(AJsonArray.Items[i].ValueString); + + tkInt64: + rItemValue := StrToInt64(AJsonArray.Items[i].ValueString); + + tkFloat: + rItemValue := StrToFloat(AJsonArray.Items[i].ValueString); + + tkEnumeration: + if (elType = System.TypeInfo(Boolean)) and (AJsonArray.Items[i] is TclJSONBoolean) then begin + rItemValue := TclJSONBoolean(AJsonArray.Items[i]).Value; + end; + + else + raise EclJsonSerializerError.Create(cUnsupportedDataType); end; + // if (elType.Kind = tkClass) + // and (AJsonArray.Items[i] is TclJSONObject) then + // begin + // objClass := elType.TypeData.ClassType; + // rItemValue := Deserialize(objClass, TclJSONObject(AJsonArray.Items[i])); + // end else + // if (elType.Kind in [tkString, tkLString, tkWString, tkUString]) then + // begin + // rItemValue := AJsonArray.Items[i].ValueString; + // end else + // if (elType.Kind = tkInteger) then + // begin + // rItemValue := StrToInt(AJsonArray.Items[i].ValueString); + // end else + // if (elType.Kind = tkInt64) then + // begin + // rItemValue := StrToInt64(AJsonArray.Items[i].ValueString); + // end else + // if (elType.Kind = tkEnumeration) + // and (elType = System.TypeInfo(Boolean)) + // and (AJsonArray.Items[i] is TclJSONBoolean) then + // begin + // rItemValue := TclJSONBoolean(AJsonArray.Items[i]).Value; + // end else + // begin + // raise EclJsonSerializerError.Create(cUnsupportedDataType); + // end; + rValue.SetArrayElement(i, rItemValue); end; @@ -253,43 +282,85 @@ function TclJsonSerializer.Deserialize(AObject: TObject; const AJson: TclJSONObj member := AJson.MemberByName(TclJsonPropertyAttribute(propAttr).Name); if (member = nil) then Continue; - if (rProp.PropertyType.TypeKind = tkDynArray) - and (member.Value is TclJSONArray) then - begin - DeserializeArray(rProp, Result, TclJSONArray(member.Value)); - end else - if (rProp.PropertyType.TypeKind = tkClass) - and (member.Value is TclJSONObject) then - begin - objClass := rProp.PropertyType.Handle^.TypeData.ClassType; - rValue := Deserialize(objClass, TclJSONObject(member.Value)); - rProp.SetValue(Result, rValue); - end else - if (rProp.PropertyType.TypeKind in [tkString, tkLString, tkWString, tkUString]) then - begin - rValue := member.ValueString; - rProp.SetValue(Result, rValue); - end else - if (rProp.PropertyType.TypeKind = tkInteger) then - begin - rValue := StrToInt(member.ValueString); - rProp.SetValue(Result, rValue); - end else - if (rProp.PropertyType.TypeKind = tkInt64) then - begin - rValue := StrToInt64(member.ValueString); - rProp.SetValue(Result, rValue); - end else - if (rProp.PropertyType.TypeKind = tkEnumeration) - and (rProp.GetValue(Result).TypeInfo = System.TypeInfo(Boolean)) - and (member.Value is TclJSONBoolean) then - begin - rValue := TclJSONBoolean(member.Value).Value; - rProp.SetValue(Result, rValue); - end else - begin - raise EclJsonSerializerError.Create(cUnsupportedDataType); + case rProp.PropertyType.TypeKind of + tkDynArray: + if (member.Value is TclJSONArray) then + DeserializeArray(rProp, Result, TclJSONArray(member.Value)); + + tkClass: + if (member.Value is TclJSONObject) then begin + objClass := rProp.PropertyType.Handle^.TypeData.ClassType; + rValue := Deserialize(objClass, TclJSONObject(member.Value)); + rProp.SetValue(Result, rValue); + end; + + tkString, tkLString, tkWString, tkUString: begin + rValue := member.ValueString; + rProp.SetValue(Result, rValue); + end; + + tkInteger: begin + rValue := StrToInt(member.ValueString); + rProp.SetValue(Result, rValue); + end; + + tkInt64: begin + rValue := StrToInt64(member.ValueString); + rProp.SetValue(Result, rValue); + end; + + tkFloat: begin + rValue := StrToFloat(member.ValueString); + rProp.SetValue(Result, rValue) + end; + + tkEnumeration: + if (rProp.GetValue(Result).TypeInfo = System.TypeInfo(Boolean)) and (member.Value is TclJSONBoolean) then begin + rValue := TclJSONBoolean(member.Value).Value; + rProp.SetValue(Result, rValue); + end; + + else + raise EclJsonSerializerError.Create(cUnsupportedDataType); end; + + // if (rProp.PropertyType.TypeKind = tkDynArray) + // and (member.Value is TclJSONArray) then + // begin + // DeserializeArray(rProp, Result, TclJSONArray(member.Value)); + // end else + // if (rProp.PropertyType.TypeKind = tkClass) + // and (member.Value is TclJSONObject) then + // begin + // objClass := rProp.PropertyType.Handle^.TypeData.ClassType; + // rValue := Deserialize(objClass, TclJSONObject(member.Value)); + // rProp.SetValue(Result, rValue); + // end else + // if (rProp.PropertyType.TypeKind in [tkString, tkLString, tkWString, tkUString]) then + // begin + // rValue := member.ValueString; + // rProp.SetValue(Result, rValue); + // end else + // if (rProp.PropertyType.TypeKind = tkInteger) then + // begin + // rValue := StrToInt(member.ValueString); + // rProp.SetValue(Result, rValue); + // end else + // if (rProp.PropertyType.TypeKind = tkInt64) then + // begin + // rValue := StrToInt64(member.ValueString); + // rProp.SetValue(Result, rValue); + // end else + // if (rProp.PropertyType.TypeKind = tkEnumeration) + // and (rProp.GetValue(Result).TypeInfo = System.TypeInfo(Boolean)) + // and (member.Value is TclJSONBoolean) then + // begin + // rValue := TclJSONBoolean(member.Value).Value; + // rProp.SetValue(Result, rValue); + // end else + // begin + // raise EclJsonSerializerError.Create(cUnsupportedDataType); + // end; end; end; finally @@ -352,8 +423,7 @@ function TclJsonSerializer.Serialize(AObject: TObject): TclJSONObject; requiredAttr: TclJsonRequiredAttribute; propAttr: TclJsonPropertyAttribute; begin - if (AObject = nil) then - begin + if (AObject = nil) then begin Result := nil; Exit; end; @@ -365,57 +435,48 @@ function TclJsonSerializer.Serialize(AObject: TObject): TclJSONObject; Result := TclJSONObject.Create(); try rType := ctx.GetType(AObject.ClassInfo); - for rProp in rType.GetProperties() do - begin + for rProp in rType.GetProperties() do begin GetPropertyAttributes(rProp, propAttr, requiredAttr); - if (propAttr <> nil) then - begin + if (propAttr <> nil) then begin nonSerializable := False; - if (rProp.PropertyType.TypeKind = tkDynArray) then - begin - SerializeArray(rProp, AObject, TclJsonPropertyAttribute(propAttr), Result); - end else - if (rProp.PropertyType.TypeKind = tkClass) then - begin - Result.AddMember(TclJsonPropertyAttribute(propAttr).Name, Serialize(rProp.GetValue(AObject).AsObject())); - end else - if (rProp.PropertyType.TypeKind in [tkString, tkLString, tkWString, tkUString]) then - begin - if (propAttr is TclJsonStringAttribute) then - begin - if (requiredAttr <> nil) then - begin - Result.AddRequiredString(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsString()); - end else - begin - Result.AddString(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsString()); - end; - end else - begin - Result.AddValue(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsString()); - end; - end else - if (rProp.PropertyType.TypeKind in [tkInteger, tkInt64]) then - begin - Result.AddValue(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).ToString()); - end else - if (rProp.PropertyType.TypeKind = tkEnumeration) - and (rProp.GetValue(AObject).TypeInfo = System.TypeInfo(Boolean)) then - begin - Result.AddBoolean(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsBoolean()); - end else - begin + case rProp.PropertyType.TypeKind of + tkDynArray: + SerializeArray(rProp, AObject, TclJsonPropertyAttribute(propAttr), Result); + + tkClass: + Result.AddMember(TclJsonPropertyAttribute(propAttr).Name, Serialize(rProp.GetValue(AObject).AsObject())); + + tkString, tkLString, tkWString, tkUString: + if (propAttr is TclJsonStringAttribute) then + if (requiredAttr <> nil) then + Result.AddRequiredString(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsString()) + else + Result.AddString(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsString()) + else + Result.AddValue(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsString()); + + tkInteger, tkInt64: + Result.AddValue(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).ToString()); + + tkFloat: + Result.AddSingle(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsType); + + tkRecord: + Result.AddMember(TclJsonPropertyAttribute(propAttr).Name, Serialize(rProp.GetValue(AObject))); + + tkEnumeration: + if rProp.GetValue(AObject).TypeInfo = System.TypeInfo(Boolean) then + Result.AddBoolean(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsBoolean()); + else raise EclJsonSerializerError.Create(cUnsupportedDataType); end; end; end; if (nonSerializable) then - begin raise EclJsonSerializerError.Create(cNonSerializable); - end; except Result.Free(); raise; @@ -425,8 +486,11 @@ function TclJsonSerializer.Serialize(AObject: TObject): TclJSONObject; end; end; -procedure TclJsonSerializer.SerializeArray(AProperty: TRttiProperty; AObject: TObject; - Attribute: TclJsonPropertyAttribute; AJson: TclJsonObject); +procedure TclJsonSerializer.SerializeArray( + AProperty: TRttiProperty; + AObject: TObject; + Attribute: TclJsonPropertyAttribute; + AJson: TclJsonObject); var rValue: TValue; i: Integer; @@ -441,32 +505,57 @@ procedure TclJsonSerializer.SerializeArray(AProperty: TRttiProperty; AObject: TO for i := 0 to rValue.GetArrayLength() - 1 do begin - if (rValue.GetArrayElement(i).Kind = tkClass) then - begin - arr.Add(Serialize(rValue.GetArrayElement(i).AsObject())); - end else - if (rValue.GetArrayElement(i).Kind in [tkString, tkLString, tkWString, tkUString]) then - begin - if (Attribute is TclJsonStringAttribute) then - begin - arr.Add(TclJSONString.Create(rValue.GetArrayElement(i).AsString())); - end else - begin - arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).AsString())); - end; - end else - if (rValue.GetArrayElement(i).Kind in [tkInteger, tkInt64]) then - begin - arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).ToString())); - end else - if (rValue.GetArrayElement(i).Kind = tkEnumeration) - and (rValue.GetArrayElement(i).TypeInfo = System.TypeInfo(Boolean)) then - begin - arr.Add(TclJSONBoolean.Create(rValue.GetArrayElement(i).AsBoolean())); - end else - begin - raise EclJsonSerializerError.Create(cUnsupportedDataType); + + case rValue.GetArrayElement(i).Kind of + tkClass: + arr.Add(Serialize(rValue.GetArrayElement(i).AsObject())); + + tkString, tkLString, tkWString, tkUString: + if (Attribute is TclJsonStringAttribute) then + arr.Add(TclJSONString.Create(rValue.GetArrayElement(i).AsString())) + else + arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).AsString())); + + tkInteger, tkInt64: + arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).ToString())); + + tkFloat: + arr.Add(TclJSONSingle.Create(rValue.GetArrayElement(i).AsType)); + + tkEnumeration: + if (rValue.GetArrayElement(i).TypeInfo = System.TypeInfo(Boolean)) then + arr.Add(TclJSONBoolean.Create(rValue.GetArrayElement(i).AsBoolean())); + + else + raise EclJsonSerializerError.Create(cUnsupportedDataType); end; + + // if (rValue.GetArrayElement(i).Kind = tkClass) then + // begin + // arr.Add(Serialize(rValue.GetArrayElement(i).AsObject())); + // end else + // if (rValue.GetArrayElement(i).Kind in [tkString, tkLString, tkWString, tkUString]) then + // begin + // if (Attribute is TclJsonStringAttribute) then + // begin + // arr.Add(TclJSONString.Create(rValue.GetArrayElement(i).AsString())); + // end else + // begin + // arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).AsString())); + // end; + // end else + // if (rValue.GetArrayElement(i).Kind in [tkInteger, tkInt64]) then + // begin + // arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).ToString())); + // end else + // if (rValue.GetArrayElement(i).Kind = tkEnumeration) + // and (rValue.GetArrayElement(i).TypeInfo = System.TypeInfo(Boolean)) then + // begin + // arr.Add(TclJSONBoolean.Create(rValue.GetArrayElement(i).AsBoolean())); + // end else + // begin + // raise EclJsonSerializerError.Create(cUnsupportedDataType); + // end; end; end; end; From 712c32b89d119712df11bfb2e58b58f0ddea97c7 Mon Sep 17 00:00:00 2001 From: Arman Toximbayev Date: Wed, 22 Jul 2020 21:49:07 +0300 Subject: [PATCH 2/3] add auto-cleaning Fields and DynArrays of Objects --- json/clJsonSerializer.pas | 227 +++++++++++++++++++++----------------- 1 file changed, 128 insertions(+), 99 deletions(-) diff --git a/json/clJsonSerializer.pas b/json/clJsonSerializer.pas index 436a1a6..81f4edc 100644 --- a/json/clJsonSerializer.pas +++ b/json/clJsonSerializer.pas @@ -51,12 +51,103 @@ TclJsonSerializer = class(TclJsonSerializerBase) function ObjectToJson(AObject: TObject): string; override; end; + /// Class with autoclean class-members and DynArray of objects + TclJsonParsedObject = class + public + constructor Create; + destructor Destroy; override; + end; + resourcestring cUnsupportedDataType = 'Unsupported data type'; cNonSerializable = 'The object is not serializable'; implementation +{ TclJsonParsedObject } + +constructor TclJsonParsedObject.Create; +var + ctx: TRttiContext; + rType: TRttiType; + rProp: TRttiProperty; +begin + inherited Create(); + + ctx := TRttiContext.Create(); + try + rType := ctx.GetType(Self.ClassInfo); + + for rProp in rType.GetProperties() do + if rProp.PropertyType.TypeKind in [tkDynArray, tkClass] then + rProp.SetValue(Self, nil); + finally + ctx.Free(); + end; +end; + +destructor TclJsonParsedObject.Destroy; + procedure FreeAndNilArray(AProperty: TRttiProperty; AObject: TObject); + var + elType: PTypeInfo; + rValue, rItemValue: TValue; + i: Integer; + xObject: TObject; + begin + if (GetTypeData(AProperty.PropertyType.Handle).DynArrElType = nil) then Exit; + elType := GetTypeData(AProperty.PropertyType.Handle).DynArrElType^; + + if (elType.Kind = tkClass) then + begin + rValue := AProperty.GetValue(AObject); + if not rValue.IsEmpty then + for i := 0 to rValue.GetArrayLength - 1 do + begin + rItemValue := rValue.GetArrayElement(i); + if not rItemValue.IsEmpty then + begin + xObject := rItemValue.AsObject; + FreeAndNil(xObject); + rValue.SetArrayElement(i, nil); + end; + AProperty.SetValue(AObject, nil); + end; + end; + end; +var + ctx: TRttiContext; + rType: TRttiType; + rProp: TRttiProperty; + rValue: TValue; + xObject: TObject; +begin + ctx := TRttiContext.Create(); + try + rType := ctx.GetType(Self.ClassInfo); + + for rProp in rType.GetProperties() do + case rProp.PropertyType.TypeKind of + tkDynArray: + FreeAndNilArray(rProp, Self); + + tkClass: + begin + rValue := rProp.GetValue(Self); + if not rValue.IsEmpty then + begin + xObject := rValue.AsObject; + FreeAndNil(xObject); + rProp.SetValue(Self, nil); + end; + end; + end; + finally + ctx.Free(); + end; + + inherited; +end; + { TclJsonSerializer } function TclJsonSerializer.GetObjectClass(ATypeNameAttrs: TclJsonTypeNameMapAttributeList; AJsonObject: TclJSONObject): TRttiType; @@ -90,11 +181,12 @@ procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; AObject: TObject; AJsonArray: TclJSONArray); var elType: PTypeInfo; - len: LongInt; + len: NativeInt; // using NativeInt for work in x32/x64 platforms pArr: Pointer; rValue, rItemValue: TValue; i: Integer; objClass: TClass; + xObject: TObject; begin len := AJsonArray.Count; if (len = 0) then Exit; @@ -105,6 +197,25 @@ procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; pArr := nil; + // clean array's items - old values of objects + if (elType.Kind = tkClass) then + begin + rValue := AProperty.GetValue(AObject); + if not rValue.IsEmpty then + for i := 0 to rValue.GetArrayLength - 1 do + begin + rItemValue := rValue.GetArrayElement(i); + if not rItemValue.IsEmpty then + begin + xObject := rItemValue.AsObject; + FreeAndNil(xObject); + rValue.SetArrayElement(i, nil); + end; + AProperty.SetValue(AObject, nil); + end; + end; + // + DynArraySetLength(pArr, AProperty.PropertyType.Handle, 1, @len); try TValue.Make(@pArr, AProperty.PropertyType.Handle, rValue); @@ -114,7 +225,8 @@ procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; case elType.Kind of tkClass: - if (AJsonArray.Items[i] is TclJSONObject) then begin + if (AJsonArray.Items[i] is TclJSONObject) then + begin objClass := elType.TypeData.ClassType; rItemValue := Deserialize(objClass, TclJSONObject(AJsonArray.Items[i])); end; @@ -140,34 +252,6 @@ procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; raise EclJsonSerializerError.Create(cUnsupportedDataType); end; - // if (elType.Kind = tkClass) - // and (AJsonArray.Items[i] is TclJSONObject) then - // begin - // objClass := elType.TypeData.ClassType; - // rItemValue := Deserialize(objClass, TclJSONObject(AJsonArray.Items[i])); - // end else - // if (elType.Kind in [tkString, tkLString, tkWString, tkUString]) then - // begin - // rItemValue := AJsonArray.Items[i].ValueString; - // end else - // if (elType.Kind = tkInteger) then - // begin - // rItemValue := StrToInt(AJsonArray.Items[i].ValueString); - // end else - // if (elType.Kind = tkInt64) then - // begin - // rItemValue := StrToInt64(AJsonArray.Items[i].ValueString); - // end else - // if (elType.Kind = tkEnumeration) - // and (elType = System.TypeInfo(Boolean)) - // and (AJsonArray.Items[i] is TclJSONBoolean) then - // begin - // rItemValue := TclJSONBoolean(AJsonArray.Items[i]).Value; - // end else - // begin - // raise EclJsonSerializerError.Create(cUnsupportedDataType); - // end; - rValue.SetArrayElement(i, rItemValue); end; @@ -260,6 +344,7 @@ function TclJsonSerializer.Deserialize(AObject: TObject; const AJson: TclJSONObj nonSerializable: Boolean; requiredAttr: TclJsonRequiredAttribute; propAttr: TclJsonPropertyAttribute; + xObject: TObject; begin Result := AObject; @@ -290,6 +375,17 @@ function TclJsonSerializer.Deserialize(AObject: TObject; const AJson: TclJSONObj tkClass: if (member.Value is TclJSONObject) then begin objClass := rProp.PropertyType.Handle^.TypeData.ClassType; + + // clean fields - old values of objects + rValue := rProp.GetValue(Result); + if not rValue.IsEmpty then + begin + xObject := rValue.AsObject; + FreeAndNil(xObject); + rProp.SetValue(Result, nil); + end; + // + rValue := Deserialize(objClass, TclJSONObject(member.Value)); rProp.SetValue(Result, rValue); end; @@ -323,44 +419,6 @@ function TclJsonSerializer.Deserialize(AObject: TObject; const AJson: TclJSONObj else raise EclJsonSerializerError.Create(cUnsupportedDataType); end; - - // if (rProp.PropertyType.TypeKind = tkDynArray) - // and (member.Value is TclJSONArray) then - // begin - // DeserializeArray(rProp, Result, TclJSONArray(member.Value)); - // end else - // if (rProp.PropertyType.TypeKind = tkClass) - // and (member.Value is TclJSONObject) then - // begin - // objClass := rProp.PropertyType.Handle^.TypeData.ClassType; - // rValue := Deserialize(objClass, TclJSONObject(member.Value)); - // rProp.SetValue(Result, rValue); - // end else - // if (rProp.PropertyType.TypeKind in [tkString, tkLString, tkWString, tkUString]) then - // begin - // rValue := member.ValueString; - // rProp.SetValue(Result, rValue); - // end else - // if (rProp.PropertyType.TypeKind = tkInteger) then - // begin - // rValue := StrToInt(member.ValueString); - // rProp.SetValue(Result, rValue); - // end else - // if (rProp.PropertyType.TypeKind = tkInt64) then - // begin - // rValue := StrToInt64(member.ValueString); - // rProp.SetValue(Result, rValue); - // end else - // if (rProp.PropertyType.TypeKind = tkEnumeration) - // and (rProp.GetValue(Result).TypeInfo = System.TypeInfo(Boolean)) - // and (member.Value is TclJSONBoolean) then - // begin - // rValue := TclJSONBoolean(member.Value).Value; - // rProp.SetValue(Result, rValue); - // end else - // begin - // raise EclJsonSerializerError.Create(cUnsupportedDataType); - // end; end; end; finally @@ -423,7 +481,8 @@ function TclJsonSerializer.Serialize(AObject: TObject): TclJSONObject; requiredAttr: TclJsonRequiredAttribute; propAttr: TclJsonPropertyAttribute; begin - if (AObject = nil) then begin + if (AObject = nil) then + begin Result := nil; Exit; end; @@ -463,9 +522,6 @@ function TclJsonSerializer.Serialize(AObject: TObject): TclJSONObject; tkFloat: Result.AddSingle(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsType); - tkRecord: - Result.AddMember(TclJsonPropertyAttribute(propAttr).Name, Serialize(rProp.GetValue(AObject))); - tkEnumeration: if rProp.GetValue(AObject).TypeInfo = System.TypeInfo(Boolean) then Result.AddBoolean(TclJsonPropertyAttribute(propAttr).Name, rProp.GetValue(AObject).AsBoolean()); @@ -529,33 +585,6 @@ procedure TclJsonSerializer.SerializeArray( else raise EclJsonSerializerError.Create(cUnsupportedDataType); end; - - // if (rValue.GetArrayElement(i).Kind = tkClass) then - // begin - // arr.Add(Serialize(rValue.GetArrayElement(i).AsObject())); - // end else - // if (rValue.GetArrayElement(i).Kind in [tkString, tkLString, tkWString, tkUString]) then - // begin - // if (Attribute is TclJsonStringAttribute) then - // begin - // arr.Add(TclJSONString.Create(rValue.GetArrayElement(i).AsString())); - // end else - // begin - // arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).AsString())); - // end; - // end else - // if (rValue.GetArrayElement(i).Kind in [tkInteger, tkInt64]) then - // begin - // arr.Add(TclJSONValue.Create(rValue.GetArrayElement(i).ToString())); - // end else - // if (rValue.GetArrayElement(i).Kind = tkEnumeration) - // and (rValue.GetArrayElement(i).TypeInfo = System.TypeInfo(Boolean)) then - // begin - // arr.Add(TclJSONBoolean.Create(rValue.GetArrayElement(i).AsBoolean())); - // end else - // begin - // raise EclJsonSerializerError.Create(cUnsupportedDataType); - // end; end; end; end; From efa5f39d6e7ee0de54bd28845d0557c630f57ad4 Mon Sep 17 00:00:00 2001 From: Arman Toximbayev Date: Sat, 25 Jul 2020 21:34:24 +0300 Subject: [PATCH 3/3] add work with dynamic array of dynamic array of ... --- json/clJsonSerializer.pas | 115 +++++++++++++++++----------------- json/clJsonSerializerBase.pas | 2 +- 2 files changed, 59 insertions(+), 58 deletions(-) diff --git a/json/clJsonSerializer.pas b/json/clJsonSerializer.pas index 81f4edc..89ee2f4 100644 --- a/json/clJsonSerializer.pas +++ b/json/clJsonSerializer.pas @@ -40,7 +40,7 @@ TclJsonSerializer = class(TclJsonSerializerBase) procedure SerializeArray(AProperty: TRttiProperty; AObject: TObject; Attribute: TclJsonPropertyAttribute; AJson: TclJsonObject); - procedure DeserializeArray(AProperty: TRttiProperty; AObject: TObject; AJsonArray: TclJSONArray); + procedure DeserializeArray(var rValue: TValue; AJsonArray: TclJSONArray); function Deserialize(AType: TClass; const AJson: TclJSONObject): TObject; overload; function Deserialize(AObject: TObject; const AJson: TclJSONObject): TObject; overload; @@ -86,34 +86,31 @@ constructor TclJsonParsedObject.Create; end; end; -destructor TclJsonParsedObject.Destroy; - procedure FreeAndNilArray(AProperty: TRttiProperty; AObject: TObject); - var - elType: PTypeInfo; - rValue, rItemValue: TValue; - i: Integer; - xObject: TObject; +procedure FreeAndNilArray(var rValue: TValue); +var + rItemValue: TValue; + i: Integer; + xObject: TObject; +begin + for i := 0 to rValue.GetArrayLength - 1 do begin - if (GetTypeData(AProperty.PropertyType.Handle).DynArrElType = nil) then Exit; - elType := GetTypeData(AProperty.PropertyType.Handle).DynArrElType^; - - if (elType.Kind = tkClass) then - begin - rValue := AProperty.GetValue(AObject); - if not rValue.IsEmpty then - for i := 0 to rValue.GetArrayLength - 1 do + rItemValue := rValue.GetArrayElement(i); + if rItemValue.IsEmpty then + Continue; + case rItemValue.Kind of + tkDynArray: + FreeAndNilArray(rItemValue); + tkClass: begin - rItemValue := rValue.GetArrayElement(i); - if not rItemValue.IsEmpty then - begin - xObject := rItemValue.AsObject; - FreeAndNil(xObject); - rValue.SetArrayElement(i, nil); - end; - AProperty.SetValue(AObject, nil); + xObject := rItemValue.AsObject; + FreeAndNil(xObject); + rValue.SetArrayElement(i, nil); end; end; end; +end; + +destructor TclJsonParsedObject.Destroy; var ctx: TRttiContext; rType: TRttiType; @@ -128,7 +125,14 @@ destructor TclJsonParsedObject.Destroy; for rProp in rType.GetProperties() do case rProp.PropertyType.TypeKind of tkDynArray: - FreeAndNilArray(rProp, Self); + begin + rValue := rProp.GetValue(Self); + if not rValue.IsEmpty then + begin + FreeAndNilArray(rValue); + rProp.SetValue(Self, nil); + end; + end; tkClass: begin @@ -177,48 +181,28 @@ function TclJsonSerializer.GetObjectClass(ATypeNameAttrs: TclJsonTypeNameMapAttr end; end; -procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; - AObject: TObject; AJsonArray: TclJSONArray); +procedure TclJsonSerializer.DeserializeArray(var rValue: TValue; AJsonArray: TclJSONArray); var elType: PTypeInfo; len: NativeInt; // using NativeInt for work in x32/x64 platforms - pArr: Pointer; - rValue, rItemValue: TValue; + pArr, pArrItem: Pointer; + rItemValue: TValue; i: Integer; objClass: TClass; - xObject: TObject; begin + FreeAndNilArray(rValue); + len := AJsonArray.Count; if (len = 0) then Exit; - if (GetTypeData(AProperty.PropertyType.Handle).DynArrElType = nil) then Exit; - - elType := GetTypeData(AProperty.PropertyType.Handle).DynArrElType^; + if rValue.TypeData.DynArrElType^ = nil then Exit; + elType := rValue.TypeData.DynArrElType^; pArr := nil; - // clean array's items - old values of objects - if (elType.Kind = tkClass) then - begin - rValue := AProperty.GetValue(AObject); - if not rValue.IsEmpty then - for i := 0 to rValue.GetArrayLength - 1 do - begin - rItemValue := rValue.GetArrayElement(i); - if not rItemValue.IsEmpty then - begin - xObject := rItemValue.AsObject; - FreeAndNil(xObject); - rValue.SetArrayElement(i, nil); - end; - AProperty.SetValue(AObject, nil); - end; - end; - // - - DynArraySetLength(pArr, AProperty.PropertyType.Handle, 1, @len); + DynArraySetLength(pArr, rValue.TypeInfo, 1, @len); try - TValue.Make(@pArr, AProperty.PropertyType.Handle, rValue); + TValue.Make(@pArr, rValue.TypeInfo, rValue); for i := 0 to AJsonArray.Count - 1 do begin @@ -248,6 +232,20 @@ procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; rItemValue := TclJSONBoolean(AJsonArray.Items[i]).Value; end; + tkDynArray: + if (AJsonArray.Items[i] is TclJSONArray) then + begin + len := 0; + pArrItem := nil; + DynArraySetLength(pArrItem, elType, 1, @len); + try + TValue.Make(@pArrItem, elType, rItemValue); + DeserializeArray(rItemValue, TclJSONArray(AJsonArray.Items[i])); + finally + DynArrayClear(pArrItem, elType); + end; + end; + else raise EclJsonSerializerError.Create(cUnsupportedDataType); end; @@ -255,9 +253,8 @@ procedure TclJsonSerializer.DeserializeArray(AProperty: TRttiProperty; rValue.SetArrayElement(i, rItemValue); end; - AProperty.SetValue(AObject, rValue); finally - DynArrayClear(pArr, AProperty.PropertyType.Handle); + DynArrayClear(pArr, rValue.TypeInfo); end; end; @@ -370,7 +367,11 @@ function TclJsonSerializer.Deserialize(AObject: TObject; const AJson: TclJSONObj case rProp.PropertyType.TypeKind of tkDynArray: if (member.Value is TclJSONArray) then - DeserializeArray(rProp, Result, TclJSONArray(member.Value)); + begin + rValue := rProp.GetValue(Result); + DeserializeArray(rValue, TclJSONArray(member.Value)); + rProp.SetValue(Result, rValue); + end; tkClass: if (member.Value is TclJSONObject) then begin diff --git a/json/clJsonSerializerBase.pas b/json/clJsonSerializerBase.pas index 782b170..b8f17d3 100644 --- a/json/clJsonSerializerBase.pas +++ b/json/clJsonSerializerBase.pas @@ -32,7 +32,7 @@ interface EclJsonSerializerError = class(Exception) end; - TclJsonPropertyAttribute = class (TCustomAttribute) + TclJsonPropertyAttribute = class(TCustomAttribute) strict private FName: string; public