Snippets

Stefan Glienke JsonDataObjectUnmarshall

Created by Stefan Glienke
unit JsonDataObjectUnmarshall;

interface

type
  JSONNameAttribute = class(TCustomAttribute)
  private
    fName: string;
  public
    constructor Create(const name: string);
    property Name: string read fName;
  end;

  JSONClassAttribute = class(TCustomAttribute)
  private
    fItemClass: TClass;
  public
    constructor Create(itemClass: TClass);
    property ItemClass: TClass read fItemClass;
  end;

procedure Unmarshall(const obj: TObject; const data: string); overload;

implementation

uses
  JsonDataObjects,
  Rtti,
  TypInfo;

{ JSONNameAttribute }

constructor JSONNameAttribute.Create(const name: string);
begin
  fName := name;
end;

{ JSONClassAttribute }

constructor JSONClassAttribute.Create(itemClass: TClass);
begin
  fItemClass := itemClass;
end;

procedure Unmarshall(const obj: TObject; const jsonObj: TJsonObject); overload;

  function FieldByJsonName(t: TRttiType; const name: string): TRttiField;
  var
    a: TCustomAttribute;
  begin
    for Result in t.GetFields do
      for a in Result.GetAttributes do
        if (a is JSONNameAttribute) and (JSONNameAttribute(a).Name = name) then
          Exit;
    Result := nil;
  end;

  function GetClassByAttribute(f: TRttiField): TClass;
  var
    a: TCustomAttribute;
  begin
    for a in f.GetAttributes do
      if a is JSONClassAttribute then
        Exit(JSONClassAttribute(a).ItemClass);
    Result := nil;
  end;

  function GetDefaultCtor(t: TRttiType): TRttiMethod;
  begin
    for Result in t.GetMethods do
      if (Result.MethodKind = mkConstructor) and (Length(Result.GetParameters) = 0) then
        Exit;
    Result := nil;
  end;

var
  item: PJsonDataValue;
  ctx: TRttiContext;
  t: TRttiType;
  f: TRttiField;
  i: Integer;
  subObj: TObject;
  subIntf: IInterface;
  itemClass: TClass;
  ctor: TRttiMethod;
  v: TValue;
begin
  t := ctx.GetType(obj.ClassInfo);
  for i := 0 to jsonObj.Count - 1 do
  begin
    f := FieldByJsonName(t, jsonObj.Names[i]);
    if Assigned(f) then
    begin
      item := jsonObj.Items[i];

      // TODO: support all kinds of types
      case item.Typ of
        jdtObject:
        begin
          case f.FieldType.TypeKind of
            tkClass:
            begin
              subObj := f.GetValue(obj).AsObject;
              if subObj <> nil then
                Unmarshall(subObj, item.ObjectValue)
              else
              begin
                itemClass := GetClassByAttribute(f);
                if itemClass <> nil then
                begin
                  ctor := GetDefaultCtor(ctx.GetType(itemClass));
                  if ctor <> nil then
                  begin
                    subObj := ctor.Invoke(itemClass, []).AsObject;
                    Unmarshall(subObj, item.ObjectValue);
                    f.SetValue(obj, subObj);
                  end;
                end;
              end;
            end;
            tkInterface:
            begin
              subIntf := f.GetValue(obj).AsInterface;
              if subIntf <> nil then
                Unmarshall(subIntf as TObject, item.ObjectValue)
              else
              begin
                itemClass := GetClassByAttribute(f);
                if itemClass <> nil then
                begin
                  ctor := GetDefaultCtor(ctx.GetType(itemClass));
                  if ctor <> nil then
                  begin
                    subObj := ctor.Invoke(itemClass, []).AsObject;
                    Unmarshall(subObj, item.ObjectValue);
                    subObj.GetInterface(TRttiInterfaceType(f.FieldType).GUID, subIntf);
                    TValue.Make(@subIntf, f.FieldType.Handle, v);
                    f.SetValue(obj, v);
                  end;
                end;
              end;
            end;
          end;
        end;
        jdtString: f.SetValue(obj, item.Value);
      end;
    end;
  end;
end;

procedure Unmarshall(const obj: TObject; const data: string); overload;
var
  jsonObj: TJsonObject;
begin
  jsonObj := TJsonObject.Parse(data) as TJsonObject;
  try
    Unmarshall(obj, jsonObj);
  finally
    jsonObj.Free;
  end;
end;

end.

Comments (0)