Snippets

Stefan Glienke JsonDataObjectUnmarshall

Created by Stefan Glienke
View revision

File JsonDataObjectUnmarshall.pas Added

  • Ignore whitespace
  • Hide word diff 
+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.
HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.