Deserialize Class With Property Backed By Methods - two examples

DeserializeClassWithPropertyBackedByMethods1.dpr

program DeserializeClassWithPropertyBackedByMethods1;

{$APPTYPE CONSOLE}

uses
  FastMM4,
  SysUtils,
  Types,
  SynCommons,
  mORMot;
  
type
{$M+}
  TMyObj = class
  private
    FArrProp: TIntegerDynArray;
    function GetPropBackedByMethod: TIntegerDynArray;
    procedure SetPropBackedByMethod(const Val: TIntegerDynArray);
  public
    procedure Add(const Val: Integer);
  published
    property PropBackedByMethod: TIntegerDynArray read GetPropBackedByMethod write SetPropBackedByMethod;
    property PropBackedByField: TIntegerDynArray read FArrProp;
  end;

{ TMyObj }

function TMyObj.GetPropBackedByMethod: TIntegerDynArray;
begin
  Result := Copy(FArrProp);
end;

procedure TMyObj.SetPropBackedByMethod(const Val: TIntegerDynArray);
begin
  FArrProp := Copy(Val);
end;

procedure TMyObj.Add(const Val: Integer);
var
  L: Integer;
begin
  L := Length(FArrProp);
  SetLength(FArrProp,L+1);
  FArrProp[L] := Val;
end;

var
  JsonName: string;
  JsonRaw: RawByteString;
  JsonUTF8: RawUTF8;
  JsonUTF8Buf: PUTF8Char;
  JsonValid: Boolean;
  JsonWriterOptions: TTextWriterWriteObjectOptions;
  MyObj: TMyObj;

begin
  try
    JsonName := 'heheha.txt';
    TJSONSerializer.RegisterClassForJSON([TMyObj]);
    try
      MyObj := TMyObj.Create;
      try
        MyObj.Add(1);
        MyObj.Add(2);
        MyObj.Add(3);

        JsonWriterOptions := [
          woHumanReadable
          //, woFullExpand
          , woStoreClassName
          //, woHumanReadableFullSetsAsStar
          //, woHumanReadableEnumSetAsComment
        ];
        JsonUTF8 := ObjectToJSON(MyObj, JsonWriterOptions);
        JsonRaw := CurrentAnsiConvert.UTF8ToAnsi(JsonUTF8);
        SynCommons.FileFromString(JsonRaw, JsonName);
      finally
        MyObj.Free;
      end;

      JsonRaw := SynCommons.StringFromFile(JsonName);
      JsonUTF8 := CurrentAnsiConvert.AnsiToUTF8(JsonRaw);
      JsonUTF8Buf := @JsonUTF8[1];
      (*
          Since GetDynArray sets fValue to nil, LoadFromJSON concludes all of the remaining JSON is invalid.
          It seems more proper if LoadFromJSON only skips the specific property.
          ...
          if (From^ in ['[','{']) {$ifndef NOVARIANTS}and (Kind<>tkVariant){$endif} then begin
            if Kind=tkDynArray then begin
              P^.GetDynArray(Value,DynArray);
              From := DynArray.LoadFromJSON(From);
          ...
      *)
      MyObj := JSONToNewObject(JsonUTF8Buf, JsonValid) as TMyObj;
      try
        Assert(JsonValid, Format('"%s" is not valid json', [JsonUTF8]));
      finally
        MyObj.Free;
      end;
    finally
      (* modify mORMot.pas to add the methods below to enable UnRegisterClassForJson
        ...
        procedure TJSONSerializerRegisteredClass.RemoveOnce(aItemClass: TClass);
        begin
          fSafe.Lock;
          try
            if PtrUIntScanExists(pointer(List),Count,PtrUInt(aItemClass)) then begin
              Remove(aItemClass);
              if fLastClass = aItemClass then
                fLastClass := nil;
            end;
          finally
            fSafe.UnLock;
          end;
        end;
        ...
        class procedure TJSONSerializer.UnRegisterClassForJSON(aItemClass: TClass);
        begin
          if JSONSerializerRegisteredClass=nil then
            GarbageCollectorFreeAndNil(JSONSerializerRegisteredClass,
              TJSONSerializerRegisteredClass.Create);
          JSONSerializerRegisteredClass.RemoveOnce(aItemClass);
        end;

        class procedure TJSONSerializer.UnRegisterClassForJSON(const aItemClass: array of TClass);
        var i: integer;
        begin
          for i := 0 to high(aItemClass) do
            UnRegisterClassForJSON(aItemClass[i]);
        end;
        ...
      *)

      TJSONSerializer.UnRegisterClassForJSON([TMyObj]);
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

DeserializeClassWithPropertyBackedByMethods2.dpr

program DeserializeClassWithPropertyBackedByMethods2;

{$APPTYPE CONSOLE}

uses
  FastMM4,
  SysUtils,
  Types,
  SynCommons,
  mORMot;
  
type
{$M+}
  TMyObj = class
  private
    FArrProp: TIntegerDynArray;         
    FObjName: string;
    function GetPropBackedByMethod: TIntegerDynArray;
    procedure SetPropBackedByMethod(const Val: TIntegerDynArray);
  public
    procedure Add(const Val: Integer);
  published
    property PropBackedByMethod: TIntegerDynArray read GetPropBackedByMethod write SetPropBackedByMethod;  
    property ObjName: string read FObjName write FObjName; 
  end;

{ TMyObj }

function TMyObj.GetPropBackedByMethod: TIntegerDynArray;
begin
  Result := Copy(FArrProp);
end;

procedure TMyObj.SetPropBackedByMethod(const Val: TIntegerDynArray);
begin
  FArrProp := Copy(Val);
end;

procedure TMyObj.Add(const Val: Integer);
var
  L: Integer;
begin
  L := Length(FArrProp);
  SetLength(FArrProp,L+1);
  FArrProp[L] := Val;
end;

var
  JsonName: string;
  JsonRaw: RawByteString;
  JsonUTF8: RawUTF8;
  JsonUTF8Buf: PUTF8Char;
  JsonValid: Boolean;
  JsonWriterOptions: TTextWriterWriteObjectOptions;
  MyObj: TMyObj;

begin
  try
    JsonName := 'heheha.txt';
    TJSONSerializer.RegisterClassForJSON([TMyObj]);
    try
      MyObj := TMyObj.Create;
      try
        MyObj.Add(1);
        MyObj.Add(2);
        MyObj.Add(3);  
        MyObj.ObjName := 'Random Name'; 

        JsonWriterOptions := [
          woHumanReadable
          //, woFullExpand
          , woStoreClassName
          //, woHumanReadableFullSetsAsStar
          //, woHumanReadableEnumSetAsComment
        ];
        JsonUTF8 := ObjectToJSON(MyObj, JsonWriterOptions);
        JsonRaw := CurrentAnsiConvert.UTF8ToAnsi(JsonUTF8);
        SynCommons.FileFromString(JsonRaw, JsonName);
      finally
        MyObj.Free;
      end;

      JsonRaw := SynCommons.StringFromFile(JsonName);
      JsonUTF8 := CurrentAnsiConvert.AnsiToUTF8(JsonRaw);
      JsonUTF8Buf := @JsonUTF8[1];
      (*
          Since GetDynArray sets fValue to nil, LoadFromJSON concludes all of the remaining JSON is invalid.
          It seems more proper if LoadFromJSON only skips the specific property.
          ...
          if (From^ in ['[','{']) {$ifndef NOVARIANTS}and (Kind<>tkVariant){$endif} then begin
            if Kind=tkDynArray then begin
              P^.GetDynArray(Value,DynArray);
              From := DynArray.LoadFromJSON(From);
          ...
      *)
      MyObj := JSONToNewObject(JsonUTF8Buf, JsonValid) as TMyObj;
      try
        Assert(JsonValid, Format('"%s" is not valid json', [JsonUTF8]));
      finally
        MyObj.Free;
      end;
    finally
      (* modify mORMot.pas to add the methods below to enable UnRegisterClassForJson
        ...
        procedure TJSONSerializerRegisteredClass.RemoveOnce(aItemClass: TClass);
        begin
          fSafe.Lock;
          try
            if PtrUIntScanExists(pointer(List),Count,PtrUInt(aItemClass)) then begin
              Remove(aItemClass);
              if fLastClass = aItemClass then
                fLastClass := nil;
            end;
          finally
            fSafe.UnLock;
          end;
        end;
        ...
        class procedure TJSONSerializer.UnRegisterClassForJSON(aItemClass: TClass);
        begin
          if JSONSerializerRegisteredClass=nil then
            GarbageCollectorFreeAndNil(JSONSerializerRegisteredClass,
              TJSONSerializerRegisteredClass.Create);
          JSONSerializerRegisteredClass.RemoveOnce(aItemClass);
        end;

        class procedure TJSONSerializer.UnRegisterClassForJSON(const aItemClass: array of TClass);
        var i: integer;
        begin
          for i := 0 to high(aItemClass) do
            UnRegisterClassForJSON(aItemClass[i]);
        end;
        ...
      *)

      TJSONSerializer.UnRegisterClassForJSON([TMyObj]);
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.