Smart Pascal RTTI Persistence

Updated: For some odd reason, the RTTI option in the last two Smart Mobile Builds have been ignored. Meaning that the compiler doesnt generate the RTTI metadata (except for custom attributes). We are looking into this. It seems to be a very, very small issue where the properties set in the project options is not transfered to the code-generator. The issue will be fixed promptly and in the upcoming 2.2 release.

Quite a few people have asked about RTTI and Smart Mobile Studio, and while the Wikipedia article about Smart Pascal is a great read – it is mistaken regarding lack of RTTI. Smart Pascal has full support for RTTI, allowing you to enumerate properties, methods and extract type information.

In this short article I will introduce a new RTL class, one that I have proposed for inclusion (with some modifications) in the official Smart Pascal RTL. It should be introduced  as the ancestor of TW3TagObj – from which all non visual and visual components derive. This will ensure that all Smart Pascal components can be saved and loaded as you expect.

Another way is to introduce this as helper classes to avoid unwanted dependency injection for apps that doesn’t need RTTI.

As always with RTTI based persistence, only published properties are automatically serialized. I will no doubt add support for more complex storage, much like Delphi’s TFiler architecture, but as a demonstration of RTTI under Smart Pascal this is more than enough.

unit w3persistent;

interface

uses
  W3System;

  type

  EPersistent = Class(EW3Exception);

  IPersistent = Interface
    function  objToString:String;
    procedure objFromString(const aData:String);
    procedure objReset;
  end;

  TPersistent = Class(TObject,IPersistent)
  private
    (* Implements:: IPersistent *)
    function  objToString:String;
    Procedure objFromString(const aData:String);
    procedure objReset;
  protected
    Procedure AssignTo(const aTarget:TPersistent);virtual;
  public
    Procedure Assign(const aSource:TPersistent);virtual;
  End;

  TNamedValuePair = Record
    nvName:   String;
    nvValue:  Variant;
  End;
  TNamedValuePairArray = Array of TNamedValuePair;

  TPersistentHelper = Class helper for TPersistent
  public
    class function  getRTTIProperties(var aPairs:TNamedValuePairArray):Integer;
    class procedure setRTTIProperties(const aPairs:TNamedValuePairArray);
  end;

implementation

resourcestring
CNT_ERR_TPERSISTENT_READ  = 'Persistent read error [%s]';
CNT_ERR_TPERSISTENT_WRITE = 'Persistent write error [%s]';

//#############################################################################
// TPersistentHelper
//#############################################################################

class procedure TPersistentHelper.setRTTIProperties
      (const aPairs:TNamedValuePairArray);
var
  mRTTI:  Array of TRTTIRawAttribute;
  mAttrib:  TRTTIRawAttribute;
  mTypeId:  TRTTITypeInfo;
  x,y:  Integer;
Begin
  if aPairs.length>0 then
  begin
    for y:=aPairs.low to aPairs.high do
    Begin
      mTypeId:=TypeOf(self.classtype);
      mRTTI:=RTTIRawAttributes;
      if mRtti.length>0 then
      Begin
        for x:=mRtti.low to mRtti.high do
        begin
          mAttrib:=mRtti[x];
          if  (mAttrib.T = mTypeId)
          and (mAttrib.A is RTTIPropertyAttribute) then
          begin
            var prop := RTTIPropertyAttribute(mAttrib.A);
            if prop.name = aPairs[y].nvName then
            prop.setter(variant(self),aPairs[y].nvValue);
          end;
        end;
      end;
    end;
  end;
end;

class function TPersistentHelper.getRTTIProperties
         (var aPairs:TNamedValuePairArray):Integer;
var
  mRTTI:  Array of TRTTIRawAttribute;
  mAttrib:  TRTTIRawAttribute;
  mTypeId:  TRTTITypeInfo;
  x:  Integer;
  mPair: TNamedValuePair;
Begin
  aPairs.clear;
  result:=-1;

  mTypeId:=TypeOf(self.classtype);

  mRTTI:=RTTIRawAttributes;
  if mRtti.Length>0 then
  begin
    for x:=mRtti.Low to mRtti.High do
    begin
      mAttrib:=mRtti[x];
      if  (mAttrib.T = mTypeId)
      and (mAttrib.A is RTTIPropertyAttribute) then
      begin
        var prop := RTTIPropertyAttribute(mAttrib.A);
        mPair.nvName:=prop.name;
        mPair.nvValue:=Prop.Getter(Variant(self));
        aPairs.add(mPair);
      end;
    end;
    result:=aPairs.length;
  end;
end;

//#############################################################################
// TPersistent
//#############################################################################

procedure TPersistent.objReset;
var
  mData:  TNamedValuePairArray;
  x:  Integer;
Begin
  if getRTTIProperties(mData)>0 then
  begin
    for x:=mData.low to mData.high do
    mData[x].nvValue:=undefined;
    setRTTIProperties(mData);
  end;
end;

function TPersistent.objToString:String;
var
  mData:  TNamedValuePairArray;
  mCount: Integer;
  x:  Integer;
Begin
  mCount:=getRTTIProperties(mData);
  if mCount>0 then
  begin
    try
      asm
        @Result = JSON.stringify(@mData);
      end;
    finally
      mData.clear;
    end;
  end
end;

Procedure TPersistent.objFromString(const aData:String);
var
  mData:  TNamedValuePairArray;
Begin
  if length(aData)>0 then
  Begin
    asm
      @mData = JSON.parse(@aData);
    end;

    if mData.length>0 then
    Begin
      setRTTIProperties(mData);
      mData.clear;
    end;
  end else
  objReset;
end;

Procedure TPersistent.Assign(const aSource:TPersistent);
Begin
  if aSource<>NIL then
  Begin
    try
      objFromString(aSource.objToString);
    except
      on e: exception do
      Raise EPersistent.CreateFmt(CNT_ERR_TPERSISTENT_READ,[e.message]);
    end;
  end;
end;

procedure TPersistent.AssignTo(const aTarget: TPersistent);
begin
  if aTarget<>NIL then
  begin
    try
      aTarget.objFromString(objToString);
    except
      on e: exception do
      Raise EPersistent.CreateFmt(CNT_ERR_TPERSISTENT_WRITE,[e.message]);
    end;
  end;
end;

end.

Using the system

Using the class is more or less identical to Delphi. Simply derive your class from TPersistent, and all published properties can be transfered via the Assign() and AssignTo() methods. You can also access the serialization methods directly via the IPersistent interface.

Notes

The above is only a rough scetch of the final version. It does not check datatypes before trying to serialize so only use it with ordinal types (string, boolean, word, integer etc). Neither does it check for arrays.

But yes, Smart Pascal supports RTTI