Blog

All Blog Posts  |  Next Post  |  Previous Post

Diving deeper: JSON persistence, part 2/4: Collections

Bookmarks: 

Friday, August 5, 2022

TMS Software Delphi  Components

Collections

In the previous blog post, we talked about the basics for saving and loading objects to and from JSON data. Today, we are going a step further and will look at collections. To demonstrate this, we are going to add a TPersonRelations collection and a TPersonRelation TCollectionItem to our TPerson class.

TPersonRelation = class(TCollectionItem)
private
  FName: string;
  FDescription: string;
published
  property Name: string read FName write FName;
  property Description: string read FDescription write FDescription;
end;

TPersonRelations = class(TCollection)
private
  function GetItem(Index: Integer): TPersonRelation;
  procedure SetItem(Index: Integer; const Value: TPersonRelation);
public
  constructor Create;
  property Items[Index: Integer]: TPersonRelation read GetItem write SetItem; default;
end;
TPerson = class(TPersistent)
private
  FAddress: TPersonAddress;
  FColleagues: TStringList;
  FBirthDate: string;
  FName: string;
  FEmail: string;
  FTelephone: string;
  FGender: string;
  FNationality: string;
  FJobTitle: string;
  FURL: string;
  FRelations: TPersonRelations;
public
  constructor Create;
  destructor Destroy; override;
published
  property Address: TPersonAddress read FAddress;
  property Colleagues: TStringList read FColleagues;
  property Email: string read FEmail write FEmail;
  property JobTitle: string read FJobTitle write FJobTitle;
  property Name: string read FName write FName;
  property BirthDate: string read FBirthDate write FBirthDate;
  property Gender: string read FGender write FGender;
  property Nationality: string read FNationality write FNationality;
  property Telephone: string read FTelephone write FTelephone;
  property URL: string read FURL write FURL;
  property Relations: TPersonRelations read FRelations;
end;

After creating our TPerson object, we load the default JSON data and add 2 items to the newly added collection.

var
  p: TPerson;
  r: TPersonRelation;
begin
  p := TPerson.Create;
  try
    p.JSON := jsonSample;

    r := p.Relations.Add;
    r.Name := 'John Doe';
    r.Description := 'Brother';

    r := p.Relations.Add;
    r.Name := 'Mia Reyes';
    r.Description := 'Mother';

    p.Log;
  finally
    p.Free;
  end;
end;

Saving a collection

The output of the log statement is

{
  "$type": "TPerson",
  "Address": {
    "$type": "TPersonAddress",
    "AddressLocality": "Colorado Springs",
    "AddressRegion": "CO",
    "PostalCode": "80840",
    "StreetAddress": "100 Main Street"
  },
  "BirthDate": "1979-10-12",
  "Colleagues": [],
  "Email": "info@example.com",
  "Gender": "female",
  "JobTitle": "Research Assistant",
  "Name": "Jane Doe",
  "Nationality": "Albanian",
  "Relations": [
    {
      "$type": "TPersonRelation",
      "Description": "Brother",
      "Name": "John Doe"
    },
    {
      "$type": "TPersonRelation",
      "Description": "Mother",
      "Name": "Mia Reyes"
    }
  ],
  "Telephone": "(123) 456-6789",
  "URL": "http://www.example.com"
}

As you can see, the Relations property of type TPersonRelations is generated as an array of JSON objects, each object represents a TCollectionItem of type TPersonRelation.

Loading a collection without "$type"

The object that loads the JSON defines the property type, which means that even when a JSON array can be loaded in a TStringList, a TList, or a TCollection, TPersonRelations is of type TCollection and the JSON array loading will be mapped on a TCollection. When a JSON object is loaded from inside the JSON array, the "$type" property defines the object type. In the first blog post, we explain what the "$type" property does and why it is important to register your class. When changing our jsonSample const to include relations, but leaving out all "$type" properties the initial output of our TPerson object will have an empty relations collection.

const
  jsonSample =
    '{' +
      '"address":{' +
        '"addressLocality":"Colorado Springs",' +
        '"addressRegion":"CO",' +
        '"postalCode":"80840",' +
        '"streetAddress":"100 Main Street"' +
      '},' +
      '"colleague":[' +
        '"http://www.example.com/JohnColleague.html",' +
        '"http://www.example.com/JameColleague.html"' +
      '],' +
      '"email":"info@example.com",' +
      '"jobTitle":"Research Assistant",' +
      '"name":"Jane Doe",' +
      '"birthDate":"1979-10-12",' +
      '"gender":"female",' +
      '"nationality":"Albanian",' +
      '"relations": ['+
        '{'+
          '"Description": "Brother",'+
          '"Name": "John Doe"'+
        '},'+
        '{'+
          '"Description": "Mother",'+
          '"Name": "Mia Reyes"'+
        '}'+
      '],'+
      '"telephone":"(123) 456-6789",' +
      '"url":"http://www.example.com"' +
    '}';

This is because the way the JSON is loaded. When using the class helpers, the "$type" property is ignored. Basically, it is adapted to make sure it can load any kind of JSON, whether it's JSON coming directly from a predefined object structure, or an unknown structure that needs to be mapped on the object, without knowing the class types of the JSON objects inside the JSON structure. To fix this, we need to implement an interface on our TPersonRelations collection class, named ITMSFNCBaseListIO.

ITMSFNCBaseListIO = interface
['{FAB1D21E-D798-4CE0-B17B-9D75E4456AB4}']
  function GetItemClass: TClass;
end;

The ITMSFNCBaseListIO interface requests from the TCollection class, what the base class is for an item. When the "$type" property is missing, the interface can be used to return the correct class. Implementing this on our TPersonRelations collection implies the default interface implementation requirements as shown below.

TPersonRelations = class(TCollection, ITMSFNCBaseListIO)
private
  function GetItem(Index: Integer): TPersonRelation;
  procedure SetItem(Index: Integer; const Value: TPersonRelation);
  function GetItemClass: TClass;
  function QueryInterface(const IID: TGUID; out obj): HResult; stdcall;
  function _AddRef: Integer; stdcall;
  function _Release: Integer; stdcall;
public
  constructor Create;
  property Items[Index: Integer]: TPersonRelation read GetItem write SetItem; default;
  function Add: TPersonRelation;
end;
Now, to make sure the item is created and is properly added to the collection, we need to add the ITMSFNCBasePersistenceIO interface.

ITMSFNCBasePersistenceIO = interface
  ['{91DEAFC3-8932-45F4-A3ED-5AAA0C0E9250}']
  function CreateObject(const AClassName: string; const ABaseClass: TClass): TObject;
end;

This interface needs to be added to the root object, because the root object TPerson is our reference for any JSON saving and loading actions.

TPerson = class(TInterfacedPersistent, ITMSFNCBasePersistenceIO)
...
protected
  function CreateObject(const AClassName: string; const ABaseClass: TClass): TObject;
public
...

and the implementation

function TPerson.CreateObject(const AClassName: string;
  const ABaseClass: TClass): TObject;
begin
  Result := nil;
  if AClassName = 'TPersonRelation' then
    Result := TPersonRelation.Create(Relations);
end;

To load the data, we can now use our class helper and make sure we register our TPersonRelation class.

var
  p: TPerson;
begin
  p := TPerson.Create;
  try
    p.JSON := jsonSample;
    p.Log;
  finally
    p.Free;
  end;
end;
RegisterClass(TPersonRelation);
Loading a collection with "$type"

When our JSON sample data contains the "$type" properties for each object, including the root object, it's not required to define the ITMSFNCBaseListIO and ITMSFNCBasePersistenceIO interfaces to load the data. The data can be mapped directly on the object, but the class helpers cannot be used as they will ignore the "$type" properties. The code will change to

var
  p: TPerson;
begin
  p := TPerson.Create;
  try
    TTMSFNCObjectPersistence.LoadObjectFromString(p, jsonSample);
    p.Log;
  finally
    p.Free;
  end;
end;

Feedback

Next up will be how to handle generic lists, so stay tuned for more to come! As always, please leave a comment or if you have any questions, don't hesitate to ask us!



Pieter Scheldeman


Bookmarks: 

This blog post has not received any comments yet.



Add a new comment

You will receive a confirmation mail with a link to validate your comment, please use a valid email address.
All fields are required.



All Blog Posts  |  Next Post  |  Previous Post