https://github.com/danieleteti/delphimvcframework/issues/553

2024-11-15 07:45:54 +01:00 · 2022-08-12 10:50:46 +02:00 · 2022-08-12 10:50:46 +02:00 · f8501a8db5
commit f8501a8db5
parent f79f4722d9
4 changed files with 268 additions and 40 deletions
--- a/README.md
+++ b/README.md
@ -528,7 +528,7 @@ The current beta release is named 3.2.2-nitrogen. If you want to stay on the-edg

 - ✅ Improved! Now `TMVCStaticFileMiddleware` is able to manage high-level criteria to show/hide/mask specific files in the documetn web root. Check [Issue 548](https://github.com/danieleteti/delphimvcframework/issues/548) and the updated sample `samples\middleware_staticfiles\` for more info.

-  ✅ Improved! In case of multiple MVCPath, Swagger consider only the first one (Thanks to V. Ferri and our sponsors)
+- ✅ Improved! In case of multiple MVCPath, Swagger consider only the first one (Thanks to V. Ferri and our sponsors)

 - ⚡New! Mechanism to customize the JWT claims setup using the client request as suggested in [issue495](https://github.com/danieleteti/delphimvcframework/issues/495)

@ -540,6 +540,8 @@ The current beta release is named 3.2.2-nitrogen. If you want to stay on the-edg

 - ⚡ New! Added partitioning for `TMVCActiveRecord descendants` (more info ASAP)

+- ✅ Dramatically improved all "JSON-To-DataSet" operations (1 order of magnitude c.a.). Thanks to [MPannier](https://github.com/MPannier) and [David Moorhouse](https://github.com/fastbike) for their detailed analysis - More info [here](https://github.com/danieleteti/delphimvcframework/issues/553).
+
 - ✅ Improved! After a big refactoring (*"I love to delete code" -- cit. Daniele Teti*), support a new SQLGenerator is just 2 (two) methods away! Just as example, this is the current version of `TMVCSQLGeneratorPostgreSQL`

    ```delphi
--- a/sources/MVCFramework.Serializer.Abstract.pas
+++ b/sources/MVCFramework.Serializer.Abstract.pas
@ -48,13 +48,13 @@ type
    FConfig: TMVCConfig;
    function GetRttiContext: TRttiContext;
    function GetSerializationType(const AObject: TObject; const ADefaultValue: TMVCSerializationType = stDefault): TMVCSerializationType;
-    function GetNameCase(const AObject: TObject; const ADefaultValue: TMVCNameCase = ncAsIs): TMVCNameCase; overload;
-    function GetNameCase(const AComponent: TComponent; const ADefaultValue: TMVCNameCase = ncAsIs): TMVCNameCase; overload;
    function GetDataType(const AOwner: TComponent; const AComponentName: string; const ADefaultValue: TMVCDataType): TMVCDataType;
-    function GetNameAs(const AOwner: TComponent; const AComponentName: string; const ADefaultValue: string): string;
-    function IsIgnoredAttribute(const AAttributes: TMVCIgnoredList; const AName: string): Boolean;
-    function IsIgnoredComponent(const AOwner: TComponent; const AComponentName: string): Boolean;
  public
+    class function IsIgnoredAttribute(const AAttributes: TMVCIgnoredList; const AName: string): Boolean;
+    class function IsIgnoredComponent(const AOwner: TComponent; const AComponentName: string): Boolean;
+    class function GetNameCase(const AComponent: TComponent; const ADefaultValue: TMVCNameCase = ncAsIs): TMVCNameCase; overload;
+    class function GetNameCase(const AObject: TObject; const ADefaultValue: TMVCNameCase = ncAsIs): TMVCNameCase; overload;
+    class function GetNameAs(const AOwner: TComponent; const AComponentName: string; const ADefaultValue: string): string;
    function GetTypeSerializers: TDictionary<PTypeInfo, IMVCTypeSerializer>;
    procedure RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer);
    function GetObjectTypeOfGenericList(const ATypeInfo: PTypeInfo; out ARttiType: TRttiType): Boolean; overload;
@ -93,16 +93,26 @@ begin
  inherited Destroy;
 end;

-function TMVCAbstractSerializer.GetNameCase(const AObject: TObject; const ADefaultValue: TMVCNameCase): TMVCNameCase;
+class function TMVCAbstractSerializer.GetNameCase(const AObject: TObject; const ADefaultValue: TMVCNameCase): TMVCNameCase;
 var
  ObjType: TRttiType;
  Att: TCustomAttribute;
+  RTTIContext: TRttiContext;
 begin
  Result := ADefaultValue;
-  ObjType := GetRttiContext.GetType(AObject.ClassType);
-  for Att in ObjType.GetAttributes do
-    if Att is MVCNameCaseAttribute then
-      Exit(MVCNameCaseAttribute(Att).KeyCase);
+  RTTIContext := TRttiContext.Create;
+  try
+    ObjType := RTTIContext.GetType(AObject.ClassType);
+    for Att in ObjType.GetAttributes do
+    begin
+      if Att is MVCNameCaseAttribute then
+      begin
+        Exit(MVCNameCaseAttribute(Att).KeyCase);
+      end;
+    end;
+  finally
+    RTTIContext.Free;
+  end;
 end;

 function TMVCAbstractSerializer.GetDataType(const AOwner: TComponent; const AComponentName: string; const ADefaultValue: TMVCDataType)
@ -124,39 +134,63 @@ begin
  end;
 end;

-function TMVCAbstractSerializer.GetNameAs(const AOwner: TComponent; const AComponentName, ADefaultValue: string): string;
+class function TMVCAbstractSerializer.GetNameAs(const AOwner: TComponent; const AComponentName, ADefaultValue: string): string;
 var
  ObjType: TRttiType;
  ObjFld: TRttiField;
  Att: TCustomAttribute;
+  RTTIContext: TRttiContext;
 begin
  Result := ADefaultValue;
  if Assigned(AOwner) then
  begin
-    ObjType := GetRttiContext.GetType(AOwner.ClassType);
-    ObjFld := ObjType.GetField(AComponentName);
-    if Assigned(ObjFld) then
-      for Att in ObjFld.GetAttributes do
-        if Att is MVCNameAsAttribute then
-          Exit(MVCNameAsAttribute(Att).Name);
+    RTTIContext := TRttiContext.Create;
+    try
+      ObjType := RTTIContext.GetType(AOwner.ClassType);
+      ObjFld := ObjType.GetField(AComponentName);
+      if Assigned(ObjFld) then
+      begin
+        for Att in ObjFld.GetAttributes do
+        begin
+          if Att is MVCNameAsAttribute then
+          begin
+            Exit(MVCNameAsAttribute(Att).Name);
+          end;
+        end;
+      end;
+    finally
+      RTTIContext.Free;
+    end;
  end;
 end;

-function TMVCAbstractSerializer.GetNameCase(const AComponent: TComponent; const ADefaultValue: TMVCNameCase): TMVCNameCase;
+class function TMVCAbstractSerializer.GetNameCase(const AComponent: TComponent; const ADefaultValue: TMVCNameCase): TMVCNameCase;
 var
  ObjType: TRttiType;
  ObjFld: TRttiField;
  Att: TCustomAttribute;
+  RTTIContext: TRttiContext;
 begin
  Result := ADefaultValue;
  if Assigned(AComponent) and Assigned(AComponent.Owner) then
  begin
-    ObjType := GetRttiContext.GetType(AComponent.Owner.ClassType);
-    ObjFld := ObjType.GetField(AComponent.Name);
-    if Assigned(ObjFld) then
-      for Att in ObjFld.GetAttributes do
-        if Att is MVCNameCaseAttribute then
-          Exit(MVCNameCaseAttribute(Att).KeyCase);
+    RTTIContext := TRttiContext.Create;
+    try
+      ObjType := RTTIContext.GetType(AComponent.Owner.ClassType);
+      ObjFld := ObjType.GetField(AComponent.Name);
+      if Assigned(ObjFld) then
+      begin
+        for Att in ObjFld.GetAttributes do
+        begin
+          if Att is MVCNameCaseAttribute then
+          begin
+            Exit(MVCNameCaseAttribute(Att).KeyCase);
+          end;
+        end;
+      end;
+    finally
+      RTTIContext.Free;
+    end;
  end;
 end;

@ -276,7 +310,7 @@ begin
  Result := FTypeSerializers;
 end;

-function TMVCAbstractSerializer.IsIgnoredAttribute(const AAttributes: TMVCIgnoredList; const AName: string): Boolean;
+class function TMVCAbstractSerializer.IsIgnoredAttribute(const AAttributes: TMVCIgnoredList; const AName: string): Boolean;
 var
  I: Integer;
 begin
@ -286,21 +320,33 @@ begin
      Exit(True);
 end;

-function TMVCAbstractSerializer.IsIgnoredComponent(const AOwner: TComponent; const AComponentName: string): Boolean;
+class function TMVCAbstractSerializer.IsIgnoredComponent(const AOwner: TComponent; const AComponentName: string): Boolean;
 var
  ObjType: TRttiType;
  ObjFld: TRttiField;
  Att: TCustomAttribute;
+  RTTIContext: TRttiContext;
 begin
  Result := False;
  if Assigned(AOwner) then
  begin
-    ObjType := GetRttiContext.GetType(AOwner.ClassType);
-    ObjFld := ObjType.GetField(AComponentName);
-    if Assigned(ObjFld) then
-      for Att in ObjFld.GetAttributes do
-        if Att is MVCDoNotSerializeAttribute then
-          Exit(True);
+    RTTIContext := TRttiContext.Create;
+    try
+      ObjType := RTTIContext.GetType(AOwner.ClassType);
+      ObjFld := ObjType.GetField(AComponentName);
+      if Assigned(ObjFld) then
+      begin
+        for Att in ObjFld.GetAttributes do
+        begin
+          if Att is MVCDoNotSerializeAttribute then
+          begin
+            Exit(True);
+          end;
+        end;
+      end;
+    finally
+      RTTIContext.Free;
+    end;
  end;
 end;

--- a/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas
+++ b/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas
@ -38,7 +38,8 @@ uses
  MVCFramework.Serializer.Intf,
  MVCFramework.Serializer.Commons,
  JsonDataObjects,
-  MVCFramework.Commons, MVCFramework.Serializer.JsonDataObjects;
+  MVCFramework.Commons,
+  MVCFramework.Serializer.JsonDataObjects;

 type

--- a/sources/MVCFramework.Serializer.JsonDataObjects.pas
+++ b/sources/MVCFramework.Serializer.JsonDataObjects.pas
@ -69,6 +69,20 @@ type
    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;
@ -141,7 +155,9 @@ type
    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);
+      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;
@ -1270,12 +1286,23 @@ procedure TMVCJsonDataObjectsSerializer.JsonArrayToDataSet(const AJsonArray: TJD
  const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
 var
  I: Integer;
+  lSerializationMetaInfo: TSerializationMetaInfo;
 begin
-  for I := 0 to Pred(AJsonArray.Count) do
+  if AJsonArray.Count > 0 then
  begin
-    ADataSet.Append;
-    JsonObjectToDataSet(AJsonArray.Items[I].ObjectValue, ADataSet, AIgnoredFields, ANameCase);
-    ADataSet.Post;
+    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;

@ -2091,6 +2118,132 @@ begin
  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
@ -2109,7 +2262,7 @@ begin
      if (IsIgnoredAttribute(AIgnoredFields, lName)) or (IsIgnoredComponent(ADataSet.Owner, Field.Name)) then
        continue;

-      lName := TMVCSerializerHelper.ApplyNameCase(GetNameCase(ADataSet, ANameCase), lName { Field.FieldName } );
+      lName := TMVCSerializerHelper.ApplyNameCase(GetNameCase(ADataSet, ANameCase), lName);

      if not AJSONObject.Contains(lName) then
        continue;
@ -3950,4 +4103,30 @@ 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.