mORMot Open Source

DigDiver

Member

Registered: 2013-04-29

Posts: 137

function TSQLRecord.CreateCopy and TPersistent property

It seems that in the new version the function TSQLRecord.CreateCopy does not copy the TPersistent property. In the previous version it worked fine.

The demo project to demonstrate problem:

unit Unit13;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, mORMot, Vcl.StdCtrls, SynCommons;

Type
 TAccountType = (act_notdefined, act_smpt, act_amazon_ses);

 Type
  TCommonProperties = class(TPersistent)
  private
    FMyBooleanValue    : Boolean;
    FMyStringValue     : String;
  published
   property MyBooleanValue : Boolean read FMyBooleanValue write FMyBooleanValue;
   property MyStringValue  : string  read FMyStringValue  write FMyStringValue;
 end;

 Type
  TISPProperties = class(TCommonProperties)
  private
   FSMTPServer     : String;
   FSMTPPort       : integer;
  published
   property SMTPServer   : String   read FSMTPServer    write FSMTPServer;
   property SMTPPort     : integer   read FSMTPPort      write FSMTPPort;
  end;

 Type
  TAmazonSESProperties = class(TCommonProperties)
  private
   FEndPoint    : String;
   FAccessKey   : String;
   FSecretKey   : String;
  published
   property EndPoint  : String read FEndPoint  write FEndPoint;
   property AccessKey : String read FAccessKey write FAccessKey;
   property SecretKey : String read FSecretKey write FSecretKey;
 end;


 Type
  TAccount = class(TSQLRecord)
   private
    FAccountName   : String;
    FAccountType   : TAccountType;
    FProperties    : TPersistent;
    function GetProperties: TPersistent;
    procedure SetAccountType(const Value: TAccountType);
   public
    constructor Create; override;
    destructor  Destroy; override;

   published
    property AccountName : String       read FAccountName  write FAccountName;
    property AccountType : TAccountType read FAccountType  write SetAccountType;
    property Properties  : TPersistent  read GetProperties write FProperties;
  end;

type
  TForm13 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form13: TForm13;

implementation

{$R *.dfm}

{ TAccount }

constructor TAccount.Create;
begin
  inherited;
  FAccountType :=  act_notdefined;
end;

destructor TAccount.Destroy;
begin
 if Assigned(FProperties) then
   FProperties.Free;
  inherited;
end;

function TAccount.GetProperties: TPersistent;
begin
 case FAccountType of
   act_smpt        : Result := TISPProperties(FProperties);
   act_amazon_ses  : Result := TAmazonSESProperties(FProperties);
 end;
end;

procedure TAccount.SetAccountType(const Value: TAccountType);
begin
 if Value <> FAccountType then
  begin
   FAccountType := Value;

   if Assigned(FProperties) then
    FProperties.Free;

    case FAccountType of
     act_smpt        : FProperties := TISPProperties.Create;
     act_amazon_ses  : FProperties := TAmazonSESProperties.Create;
    end;
  end;
end;

procedure TForm13.Button1Click(Sender: TObject);
var
 SourceAccount  : TAccount;
 TargetAccount  : TAccount;
 Prop           : TPersistent;
 FSourceJson    : RawUTF8;
 FTargetJson    : RawUTF8;
begin
 SourceAccount := TAccount.Create;
 SourceAccount.AccountType := act_smpt;
 SourceAccount.AccountName := 'Test Account';

 (SourceAccount.Properties as TISPProperties).SMTPServer := 'localhost';
 (SourceAccount.Properties as TISPProperties).SMTPPort   := 25;

 FSourceJson :=  ObjectToJSON(SourceAccount);

 TargetAccount := SourceAccount.CreateCopy as TAccount;
 TargetAccount.AccountType := SourceAccount.AccountType;

 FTargetJson  :=  ObjectToJSON(TargetAccount);

 ShowMessage(FSourceJson + #13#10+ '=============='#13#10 + FTargetJson );




end;

end.

DigDiver

Member

Registered: 2013-04-29

Posts: 137

Re: function TSQLRecord.CreateCopy and TPersistent property

I think that old code

    try
       D := ClassInstanceCreate(S.ClassType); // create new child instance
       CopyObject(S,D); // copy child content
      except
        FreeAndNil(D); // avoid memory leak if error during new instance copy
      end;
    SetInstance(Dest,D);

is more right way instead of new code

 SetInstance(Dest,TSQLPropInfoRTTIObject(DestInfo).PropInfo^.CopyToNewObject(S));

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,662

Website

Re: function TSQLRecord.CreateCopy and TPersistent property

Previous code was perhaps working, but it was "by chance", i.e. as a side effect, not as designed.

Your "TAccount.Properties" field is a TPersistent.
So there is no RTTI available to find out which kind of class is to be created...

Using a raw TPersistent in TSQLRecord does not make sense IMHO: the ORM won't be able to unserialize its content.
Even if the previous version of CreateCopy did work for the in-memory copy, I'm quite sure that your won't be able to read the TAccount.Properties value from the database via the ORM.
You have to define the actual class type to be used in the TSQLRecord published property.

If you want to store any kind of content, using a variant published field, and a TDocVariant custom type to store the object as JSON document, is a much better and safer alternative.

DigDiver

Member

Registered: 2013-04-29

Posts: 137

Re: function TSQLRecord.CreateCopy and TPersistent property

Using a raw TPersistent in TSQLRecord does not make sense IMHO: the ORM won't be able to unserialize its content.
Even if the previous version of CreateCopy did work for the in-memory copy, I'm quite sure that your won't be able to read the TAccount.Properties value from the database via the ORM.

In my application TAccount is stored in the database and it has the property AccountType

property AccountType : TAccountType read FAccountType  write SetAccountType;

I suppose that when ORM deserializes content of TAccount, the property "AccountType" is set before "Properties", and this calls the method TAccount.SetAccountType, in which the appropriate class is created:

case FAccountType of
 act_smpt        : FProperties := TISPProperties.Create;
 act_amazon_ses  : FProperties := TAmazonSESProperties.Create;
end;

Therefore the correct deserialization happens.

This even works in the connection: ObjectToJson->JSONToObject

For example ObjectToJson(Account):

{"ID":0,"AccountName":"Test Account","AccountType":1,"Properties":{"SMTPServer":"localhost","SMTPPort":25,"MyBooleanValue":false,"MyStringValue":""}}

after converting Json to Account:

JSONToObject(TargetAccount, Pointer(AccountJson), Valid);

I can read all properties:

 if TargetAccount.AccountType = act_smpt then
 begin
   server := (TargetAccount.Properties as TISPProperties).SMTPServer;
   port   := (TargetAccount.Properties as TISPProperties).SMTPPort;
   ...
   StartSendingViaSMTP; 
 end
else
 if TargetAccount.AccountType = act_amazon_ses then
 begin
  AccessKey := (TargetAccount.Properties as TAmazonSESProperties).AccessKey
  SecretKey := (TargetAccount.Properties as TAmazonSESProperties).SecretKey;
 ..
  StartSendingViaAmazonSES 
 end;

Probably I will use ObjectToJson->JSONToObject instead of TargetAccount := Account.CreateCopy as TAccount; to avoid problems in the future.

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,662

Website

Re: function TSQLRecord.CreateCopy and TPersistent property

Now I understand how it worked on your side!

I've reverted TSQLPropInfoRTTIObject.CopySameClassProp implementation so that the Source class type would be used for the new instance created for the Destination field.
See http://synopse.info/fossil/info/d065bc69e2

My previous modification using CopyToNewObject() is not mandatory in TSQLPropInfoRTTIObject.CopySameClassProp.

DigDiver

Member

Registered: 2013-04-29

Posts: 137

Re: function TSQLRecord.CreateCopy and TPersistent property

Thanks, ab

I think that we need the same modification in

procedure TPropInfo.CopyValue(Source, Dest: TObject; DestInfo: PPropInfo);
..

 obj:    S := GetObjProp(Source);
          if (DestInfo=@self) or
             ((kD=tkClass) and (DestInfo^.PropType^.ClassSQLFieldType=ft)) then begin
            D := DestInfo.GetObjProp(Dest);
{$ifndef LVCL}
            if S.InheritsFrom(TCollection) then
              CopyCollection(TCollection(S),TCollection(D)) else
{$endif}    begin
              D.Free; // release previous D instance then set a new copy of S
 
// Insert :
              if S=nil then
                D := nil else begin
                D := ClassInstanceCreate(S.ClassType);
                CopyObject(S,D);
              end;
              DestInfo.SetOrdProp(Dest,PtrInt(D));

// instead of:

//              DestInfo.SetOrdProp(Dest,PtrInt(DestInfo^.CopyToNewObject(S))); // - this line
..