Generics and Marshal / UnMarshal. What am I missing here? PART #2 :-)

Following up on my earlier question : Generics and Marshal / UnMarshal. What am I missing here?

In "part #1" (the link above) TOndrej provided a nice solution - that failed on XE2. Here I provide corrected source to correct that.

And I feel the need to expan开发者_Python百科d this issue a bit more. So I would like to hear you all how to do this :

First - To get the source running on XE2 and XE2 update 1 make these changes :

Marshal.RegisterConverter(TTestObject,
  function (Data: TObject): String // <-- String here
  begin
    Result := T(Data).Marshal.ToString; // <-- ToString here
  end
  );

Why ?? The only reason I can see must be related to XE2 is having a lot more RTTI information available. And hence it will try and marshal the TObject returned. Am I on the right track here? Please feel free to comment.

More important - the example does not implement an UnMarshal method. If anyone can produce one and post it here I would love it :-)

I hope that you still have interest in this subject.

Kind Regards Bjarne

In addition to the answer to this question, I've posted a workaround to your previous question here: Generics and Marshal / UnMarshal. What am I missing here?

For some reason, using the non-default constructor of the TJsonobject causes the issue in XE2 - using the default constructor "fixed" the problem.

First, you need to move your TTestobject to its own unit - otherwise, RTTI won't be able to find/create your object when trying to unmarshal.

    unit uTestObject;

    interface

    uses
      SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections, DbxJson, DbxJsonReflect;

    type
      {$RTTI EXPLICIT METHODS([]) PROPERTIES([vcPublished]) FIELDS([vcPrivate])}
      TTestObject=class(TObject)
      private
        aList:TStringList;
      public
        constructor Create; overload;
        constructor Create(list: array of string); overload;
        constructor Create(list:TStringList); overload;
        destructor Destroy; override;
        function Marshal:TJSonObject;
        class function Unmarshal(value: TJSONObject): TTestObject;
      published
        property List: TStringList read aList write aList;
      end;

    implementation

    { TTestObject }

    constructor TTestObject.Create;

    begin
      inherited Create;
      aList:=TStringList.Create;
    end;

    constructor TTestObject.Create(list: array of string);

    var
      I:Integer;

    begin
      Create;
      for I:=low(list) to high(list) do
        begin
          aList.Add(list[I]);
        end;
    end;

    constructor TTestObject.Create(list:TStringList);

    begin
      Create;
      aList.Assign(list);
    end;

    destructor TTestObject.Destroy;

    begin
      aList.Free;
      inherited;
    end;

    function TTestObject.Marshal:TJSonObject;

    var
      Mar:TJSONMarshal;

    begin
      Mar:=TJSONMarshal.Create();
      try
        Mar.RegisterConverter(TStringList,
          function(Data:TObject):TListOfStrings

          var
            I, Count:Integer;
          begin
            Count:=TStringList(Data).Count;
            SetLength(Result, Count);
            for I:=0 to Count-1 do
              Result[I]:=TStringList(Data)[I];
          end);
        Result:=Mar.Marshal(Self) as TJSonObject;
      finally
        Mar.Free;
      end;
    end;

    class function TTestObject.Unmarshal(value: TJSONObject): TTestObject;

    var
      Mar: TJSONUnMarshal;
      L: TStringList;

    begin
      Mar := TJSONUnMarshal.Create();
      try
        Mar.RegisterReverter(TStringList,
          function(Data: TListOfStrings): TObject

          var
            I, Count: Integer;
          begin
            Count := Length(Data);
            Result:=TStringList.Create;
            for I := 0 to Count - 1 do
              TStringList(Result).Add(string(Data[I]));
          end
        );
        //UnMarshal will attempt to create a TTestObject from the TJSONObject data
        //using RTTI lookup - for that to function, the type MUST be defined in a unit
        Result:=Mar.UnMarshal(Value) as TTestObject;
      finally
        Mar.Free;
      end;
    end;

    end.

Also note that the constructor has been overloaded - this allows you to see that the code is functional without pre-pouplating the data in the object during creation.

Here is the implementation for the generic class list object

    unit uTestObjectList;

    interface

    uses
      SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections,
      DbxJson, DbxJsonReflect, uTestObject;

    type
      {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
      TTestObjectList<T:TTestObject,constructor> = class(TObjectList<T>)
      public
        function Marshal: TJSonObject;
        constructor Create;
        class function Unmarshal(value: TJSONObject): TTestObjectList<T>; static;
      end;

    //Note: this MUST be present and initialized/finalized so that
    //delphi will keep the RTTI information for the generic class available
    //also, it MUST be "project global" - not "module global"
    var
      X:TTestObjectList<TTestObject>;

    implementation

    { TTestObjectList<T> }
    constructor TTestObjectList<T>.Create;
    begin
      inherited Create;
      //removed the add for test data - it corrupts unmarshaling because the data is already present at creation
    end;

    function TTestObjectList<T>.Marshal: TJSonObject;
    var
      Marshal: TJsonMarshal;
    begin
      Marshal := TJSONMarshal.Create;
      try
        Marshal.RegisterConverter(TTestObjectList<T>,
          function(Data: TObject): TListOfObjects
          var
            I: integer;

          begin
            SetLength(Result,TTestObjectlist<T>(Data).Count);
            for I:=0 to TTestObjectlist<T>(Data).Count-1 do
              Result[I]:=TTestObjectlist<T>(Data)[I];
          end
        );
        Result := Marshal.Marshal(Self) as TJSONObject;
      finally
        Marshal.Free;
      end;
    end;

    class function TTestObjectList<T>.Unmarshal(value: TJSONObject): TTestObjectList<T>;

    var
      Mar: TJSONUnMarshal;
      L: TStringList;

    begin
      Mar := TJSONUnMarshal.Create();
      try
        Mar.RegisterReverter(TTestObjectList<T>,
          function(Data: TListOfObjects): TObject
          var
            I, Count: Integer;
          begin
            Count := Length(Data);
            Result:=TTestObjectList<T>.Create;
            for I := 0 to Count - 1 do
              TTestObjectList<T>(Result).Unmarshal(TJSONObject(Data[I]));
          end
        );
        //UnMarshal will attempt to create a TTestObjectList<TTestObject> from the TJSONObject data
        //using RTTI lookup - for that to function, the type MUST be defined in a unit,
        //and, because it is generic, there must be a GLOBAL VARIABLE instantiated
        //so that Delphi keeps the RTTI information avaialble
        Result:=Mar.UnMarshal(Value) as TTestObjectList<T>;
      finally
        Mar.Free;
      end;
    end;


    initialization
      //force delphi RTTI into maintaining the Generic class information in memory
      x:=TTestObjectList<TTestObject>.Create;

    finalization
      X.Free;

    end.

There are several things that are important to note: If a generic class is created at runtime, RTTI information is NOT kept unless there is a globally accessible object reference to that class in memory. See here: Delphi: RTTI and TObjectList<TObject>

So, the above unit creates such a variable and leaves it instantiated as discussed in the linked article.

The main procedure has been updated that shows both marshaling and unmarshaling the data for both objects:

    procedure Main;
    var
      aTestobj,
      bTestObj,
      cTestObj : TTestObject;
      aList,
      bList : TTestObjectList<TTestObject>;
      aJsonObject,
      bJsonObject,
      cJsonObject : TJsonObject;

      s: string;

    begin
      aTestObj := TTestObject.Create(['one','two','three','four']);
      aJsonObject := aTestObj.Marshal;
      s:=aJsonObject.ToString;
      Writeln(s);

      bJsonObject:=TJsonObject.Create;
      bJsonObject.Parse(BytesOf(s),0,length(s));

      bTestObj:=TTestObject.Unmarshal(bJsonObject) as TTestObject;
      writeln(bTestObj.List.Text);

      writeln('TTestObject marshaling complete.');
      readln;

      aList := TTestObjectList<TTestObject>.Create;
      aList.Add(TTestObject.Create(['one','two']));
      aList.Add(TTestObject.Create(['three']));
      aJsonObject := aList.Marshal;
      s:=aJsonObject.ToString;
      Writeln(s);

      cJSonObject:=TJsonObject.Create;
      cJSonObject.Parse(BytesOf(s),0,length(s));
      bList:=TTestObjectList<TTestObject>.Unmarshal(cJSonObject) as TTestObjectList<TTestObject>;
      for cTestObj in bList do
        begin
          writeln(cTestObj.List.Text);
        end;

      writeln('TTestObjectList<TTestObject> marshaling complete.');
      Readln;
    end;

Here is my own solution.

As I am very fond of polymorphism, I actually also want a solution that can be built into an object hierarchy. Lets say TTestObject and TTestObjectList is our BASE object. And from that we descend to TMyObject and also TMyObjectList. And furthermore I've made changes to both Object and List - added properties for Marshaller/UnMarshaller

TMyObject = class(TTestObject) and TMyObjectList<T:TMyObject> = class(TTestObjectList)

With this we now introduce some new problems. Ie. how to handle marshalling of different types between lines in the hierarchy and how to handle TJsonMarshal and TJsonUnMarshal as properties on TTestObject and List.

This can be overcome by introducing two new methods on TTestObject level. Two class functions called RegisterConverters and RegisterReverters. Then we go about and change the marshal function of TTestObjectList into a more simpel marshalling.

Two class functions and properties for both object and List.

class procedure RegisterConverters(aClass: TClass; aMar: TJSONMarshal); virtual;
class procedure RegisterReverters(aClass: TClass; aUnMar: TJSONUnMarshal); virtual;

property Mar: TJSONMarshal read FMar write SetMar;
property UnMar: TJSONUnMarshal read FUnMar write SetUnMar;

The Marshal function of List can now be done like this:

function TObjectList<T>.Marshal: TJSONObject;
begin
  if FMar = nil then
    FMar := TJSONMarshal.Create(); // thx. to SilverKnight
  try
    RegisterConverters; // Virtual class method !!!!
    try
      Result := FMar.Marshal(Self) as TJSONObject;
    except
      on e: Exception do
        raise Exception.Create('Marshal Error : ' + e.Message);
    end;
  finally
    ClearMarshal; // FreeAndNil FMar and FUnMar if assigned.
  end;
end;

Sure we can still have a marshaller for our TTestObject - but the Marshal function of TTestObjectList will NOT use it. This way only ONE Marshaller will get created when calling Marshal of TTestObjectList (or descendants). And this way we end up getting marshalled ONLY the information we need to recreate our structure when doing it all backwards - UnMarshalling :-)

Now this actually works - but I wonder if anyone has any comments on this ?

Lets add a property "TimeOfCreation" to TMyTestObject: property TimeOfCreation : TDateTime read FTimeOfCreation write FTimeOfCreation;

And set the property in the constructor.

FTimeofCreation := now;

And then we need a Converter so we override the virtual RegisterConverters of TTestObject.

class procedure TMyTestObject.RegisterConverters(aClass: TClass; aMar: TJSONMarshal);
begin
  inherited;  // instanciate marshaller and register TTestObject converters
  aMar.RegisterConverter(aClass, 'FTimeOfCreation',
    function(Data: TObject; Field: String): string
    var
      ctx: TRttiContext;
      date: TDateTime;
    begin
      date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<TDateTime>;
      Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', date);
    end);
end;

I end up with Very simple source like using TTestObject ie.

aList := TMyTestObjectList<TMyTestObject>.Create;
      aList.Add(TMyTestObject.Create(['one','two']));
      aList.Add(TMyTestObject.Create(['three']));
      s := (aList.Marshal).ToString;
      Writeln(s);

And now I have succeded in marshalling with polymorphism :-)

This also works with UnMarshalling btw. And Im in the process of rebuilding my FireBird ORM to produce source for all my objects like this.

The current OLD version can be found here : http://code.google.com/p/objectgenerator/ Remember that it only works for FireBird :-)