MindStream. Как мы пишем ПО под FireMonkey. Часть 4 Serialization

в 20:48, , рубрики: Delphi, FireMonkey, open source, tdd, ооп, Проектирование и рефакторинг

Часть 1.
Часть 2.
Часть 3. DUnit + FireMonkey.
Часть 3.1. По мотивам GUIRunner.

Ещё в начале увлечения программированием мне нравилось работать с файлами. Работа, правда, в основном заключалась в чтении входных данных и записей результатов. Дальше была работа с БД, файлами я пользовался все реже. Максимум IniFile иногда. Поэтому задача сериализации была довольно интересной для меня.

Сегодня я расскажу о том, как мы добавили сериализацию в нашу программу, какие возникли трудности и как мы их преодолели. Так как материал уже не новый, то он скорее для новичков. Хотя, кое-какие приемы смогут почерпнуть покритиковать все.

image

Само понятие “сериализация” очень хорошо изложил gunsmoker у себя в блоге.

Я остановился на сериализации в JSON формат. Почему JSON? Он читабелен (я использую плагин для Notepad++), он позволяет описывать сложные структуры данных, ну и, наконец, в Rad Studio XE7 есть поддержка JSON из “коробки”.

Для начала напишем небольшой прототип, задачей которого будет сохранить некий объект:

...
type
  TmsShape = class
  private
    fInt: integer;
    fStr: String;
  public
    constructor Create(const aInt: integer; const aStr: String);
  end;

constructor TmsShape.Create(const aInt: integer; const aStr: String);
begin
  inherited
  fInt := aInt;
  fStr := aStr;
end;

procedure TForm2.btSaveJsonClick(Sender: TObject);
var
  l_Marshal: TJSONMarshal;
  l_Json: TJSONObject;

  l_Shape1: TmsShape;
  l_StringList: TStringList;
begin
  try
    l_Shape1 := TmsShape.Create(1, 'First');
    l_Marshal := TJSONMarshal.Create;
    l_StringList := TStringList.Create;

    l_Json := l_Marshal.Marshal(l_Shape1) as TJSONObject;
    Memo1.Lines.Text := l_Json.tostring;

    l_StringList.Add(l_Json.tostring);
    l_StringList.SaveToFile(с_FileNameSave);
  finally
    FreeAndNil(l_Marshal);
    FreeAndNil(l_StringList);
    FreeAndNil(l_Json);
    FreeAndNil(l_Shape1);
  end;
end;

В результате получим такой файл:

{
	"type": "uMain.TmsShape",
	"id": 1,
	"fields": {
		"fInt": 1,
		"fStr": "First"
	}
}

Следующим шагом сериализуем список фигур TmsShape; для этого добавим новый класс, у которого будет — поле “список”:

...
type
  TmsShapeContainer = class
  private
    fList: TList<TmsShape>;
  public
    constructor Create;
    destructor Destroy;
  end;

constructor TmsShapeContainer.Create;
begin
  inherited;
  fList := TList<TmsShape>.Create;
end;

destructor TmsShapeContainer.Destroy;
begin
  FreeAndNil(fList);
  inherited;
end;

В код сохранения добавим создание контейнера и добавим ему 2 объекта, а также изменим параметр вызова маршалинга (разница между маршалингом и сериализацией как раз и описана в статье GunSmoker’a):

…
    l_msShapeContainer := TmsShapeContainer.Create;
    l_msShapeContainer.fList.Add(l_Shape1);
    l_msShapeContainer.fList.Add(l_Shape2);
…
    l_Json := l_Marshal.Marshal(l_msShapeContainer) as TJSONObject;
...

Остальной код не менялся.
На выходе получим такой файл:

{
	"type": "uMain.TmsShapeContainer",
	"id": 1,
	"fields": {
		"fList": {
			"type": "System.Generics.Collections.TList<uMain.TmsShape>",
			"id": 2,
			"fields": {
				"FItems": [{
					"type": "uMain.TmsShape",
					"id": 3,
					"fields": {
						"fInt": 1,
						"fStr": "First"
					}
				},
				{
					"type": "uMain.TmsShape",
					"id": 4,	
					"fields": {
						"fInt": 2,
						"fStr": "Second"
					}
				}],
				"FCount": 2,
				"FArrayManager": {
					"type": "System.Generics.Collections.TMoveArrayManager<uMain.TmsShape>",
					"id": 5,
					"fields": {
						
					}
				}
			}
		}
	}
}

Как видим, в файл попало слишком много лишней информации. Получается так вследствие особенностей реализации обработки объектов для маршалинга в стандартной библиотеке Json для XE7. Дело в том, что в стандартной библиотеке для этого описано 8 видов стандартных конверторов (converter):

  //Convert a field in an object array
  TObjectsConverter = reference to function(Data: TObject; Field: String): TListOfObjects;
  //Convert a field in a strings array
  TStringsConverter = reference to function(Data: TObject; Field: string): TListOfStrings;
 
  //Convert a type in an objects array
  TTypeObjectsConverter = reference to function(Data: TObject): TListOfObjects;
  //Convert a type in a strings array  
  TTypeStringsConverter = reference to function(Data: TObject): TListOfStrings;
 
  //Convert a field in an object
  TObjectConverter = reference to function(Data: TObject; Field: String): TObject;
  //Convert a field in a string  
  TStringConverter = reference to function(Data: TObject; Field: string): string;
 
  //Convert specified type in an object
  TTypeObjectConverter = reference to function(Data: TObject): TObject;
  //Convert specified type in a string  
  TTypeStringConverter = reference to function(Data: TObject): string;

Более детально работу с конверторами описали тут.
Перевод, правда, с отсутствием форматирования тут.

В двух словах, есть 8 функций, которые умеют обрабатывать стандартные структуры данных. Однако, никто не мешает переопределить эти функции (они могут быть анонимные).

Попробуем?

…
    l_Marshal.RegisterConverter(TmsShapeContainer, 'fList',
      function(Data: TObject; Field: string): TListOfObjects
      var l_Shape : TmsShape;
          l_Index: integer;
      begin
        SetLength(Result, (Data As TmsShapeContainer).fList.Count);
        l_Index := 0;
        for l_Shape in (Data As TmsShapeContainer).fList do
        begin
          Result[l_Index] := l_Shape;
          Inc(l_Index);
        end;
      end
      );
...

На выходе получим несколько оптимальную версию:

{
	"type": "uMain.TmsShapeContainer",
	"id": 1,
	"fields": {
		"fList": [{
			"type": "uMain.TmsShape",
			"id": 2,
			"fields": {
				"fInt": 1,
				"fStr": "First"
			}
		},
		{
			"type": "uMain.TmsShape",
			"id": 3,
			"fields": {
				"fInt": 2,
				"fStr": "Second"
			}
		}]
	}
}

Всё, уже совсем хорошо. Но давайте представим, что нам необходимо сохранять строку и не сохранять число. Для этого воспользуемся атрибутами.

type
  TmsShape = class
  private
  [JSONMarshalled(False)]
    fInt: integer;
  [JSONMarshalled(True)]
    fStr: String;
  public
    constructor Create(const aInt: integer; const aStr: String);
  end;

На выходе получим:

{
	"type": "uMain.TmsShapeContainer",
	"id": 1,
	"fields": {
		"fList": [{
			"type": "uMain.TmsShape",
			"id": 2,
			"fields": {
				"fStr": "First"
			}
		},
		{
			"type": "uMain.TmsShape",
			"id": 3,
			"fields": {
				"fStr": "Second"
			}
		}]
	}
}

Полный код модуля:

unit uMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.StdCtrls,
  FMX.Layouts,
  FMX.Memo,
  Generics.Collections,
  Data.DBXJSONReflect
  ;

type
  TForm2 = class(TForm)
    SaveDialog1: TSaveDialog;
    Memo1: TMemo;
    btSaveJson: TButton;
    btSaveEMB_Example: TButton;
    procedure btSaveJsonClick(Sender: TObject);
    procedure btSaveEMB_ExampleClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TmsShape = class
  private
  [JSONMarshalled(False)]
    fInt: integer;
  [JSONMarshalled(True)]
    fStr: String;
  public
    constructor Create(const aInt: integer; const aStr: String);
  end;

  TmsShapeContainer = class
  private
    fList: TList<TmsShape>;
  public
    constructor Create;
    destructor Destroy;
  end;

var
  Form2: TForm2;

implementation

uses
  json,
  uFromEmbarcadero;

const
  с_FileNameSave = 'D:TestingJson.ms';
{$R *.fmx}
  { TmsShape }

constructor TmsShape.Create(const aInt: integer; const aStr: String);
begin
  fInt := aInt;
  fStr := aStr;
end;

procedure TForm2.btSaveEMB_ExampleClick(Sender: TObject);
begin
  Memo1.Lines.Assign(mainproc);
end;

procedure TForm2.btSaveJsonClick(Sender: TObject);
var
  l_Marshal: TJSONMarshal;
  l_Json: TJSONObject;

  l_Shape1, l_Shape2: TmsShape;
  l_msShapeContainer: TmsShapeContainer;
  l_StringList: TStringList;
begin
  try
    l_Shape1 := TmsShape.Create(1, 'First');
    l_Shape2 := TmsShape.Create(2, 'Second');

    l_msShapeContainer := TmsShapeContainer.Create;
    l_msShapeContainer.fList.Add(l_Shape1);
    l_msShapeContainer.fList.Add(l_Shape2);

    l_Marshal := TJSONMarshal.Create;
    l_StringList := TStringList.Create;

    l_Marshal.RegisterConverter(TmsShapeContainer, 'fList',
      function(Data: TObject; Field: string): TListOfObjects
      var l_Shape : TmsShape;
          l_Index: integer;
      begin
        SetLength(Result, (Data As TmsShapeContainer).fList.Count);
        l_Index := 0;
        for l_Shape in (Data As TmsShapeContainer).fList do
        begin
          Result[l_Index] := l_Shape;
          Inc(l_Index);
        end;
      end
      );

    l_Json := l_Marshal.Marshal(l_msShapeContainer) as TJSONObject;
    Memo1.Lines.Text := l_Json.tostring;

    l_StringList.Add(l_Json.tostring);
    l_StringList.SaveToFile(с_FileNameSave);
  finally
    FreeAndNil(l_Marshal);
    FreeAndNil(l_StringList);
    FreeAndNil(l_Json);
    FreeAndNil(l_Shape1);
    FreeAndNil(l_Shape2);
    FreeAndNil(l_msShapeContainer);
  end;
end;

{ TmsShapeContainer }

constructor TmsShapeContainer.Create;
begin
  inherited;
  fList := TList<TmsShape>.Create;
end;

destructor TmsShapeContainer.Destroy;
begin
  FreeAndNil(fList);
  inherited;
end;

end.

Пора добавить сериализацию в наше приложение.
Напомню читателям как выглядит приложение:

image

А также UML-диаграмму:

image

Нам необходимо сериализовать класс TmsDiagramm. Но не весь. Нам нужен только список фигур на диаграмме и название диаграммы.

...
type
 TmsShapeList = class(TList<ImsShape>)
 public
  function ShapeByPt(const aPoint: TPointF): ImsShape;
 end; // TmsShapeList

 TmsDiagramm = class(TmsInterfacedNonRefcounted, ImsShapeByPt, ImsShapesController, IInvokable)
 private
  [JSONMarshalled(True)]
  FShapeList: TmsShapeList;
  [JSONMarshalled(False)]
  FCurrentClass: RmsShape;
  [JSONMarshalled(False)]
  FCurrentAddedShape: ImsShape;
  [JSONMarshalled(False)]
  FMovingShape: TmsShape;
  [JSONMarshalled(False)]
  FCanvas: TCanvas;
  [JSONMarshalled(False)]
  FOrigin: TPointF;
  f_Name: String;
...

Добавим класс сериализации, у которого будет 2 статических функции:

type
 TmsSerializeController = class(TObject)
 public
  class procedure Serialize(const aFileName: string; const aDiagramm: TmsDiagramm);
  class function DeSerialize(const aFileName: string): TmsDiagramm;
 end; // TmsDiagrammsController

Функция сериализации такая же, как в примере выше. Но вместо файла на выходе я получал exception:

image

Дебагер обрадовал ограничениями функции библиотеки:

image

А дело всё в том, что наш список:

type
 TmsShapeList = class(TList<ImsShape>)
 public
  function ShapeByPt(const aPoint: TPointF): ImsShape;
 end; // TmsShapeList

Это список интерфейсов, которые не “кушает” Json из коробочки. Печально, но делать что-то надо.
Раз список интерфейсный, но объекты в нём реальные, а не сериализовать ли нам просто список объектов?
Сказано — сделано.

var
 l_SaveDialog: TSaveDialog;
 l_Marshal: TJSONMarshal; // Serializer

 l_Json: TJSONObject;
 l_JsonArray: TJSONArray;
 l_StringList: TStringList;
 l_msShape: ImsShape;
begin
 l_SaveDialog := TSaveDialog.Create(nil);
 if l_SaveDialog.Execute then
 begin
  try
   l_Marshal := TJSONMarshal.Create;

   l_StringList := TStringList.Create;
   l_JsonArray := TJSONArray.Create;
   for l_msShape in FShapeList do
   begin
    l_Json := l_Marshal.Marshal(TObject(l_msShape)) as TJSONObject;
    l_JsonArray.Add(l_Json);
   end;
   l_Json := TJSONObject.Create(TJSONPair.Create('MindStream', l_JsonArray));
   l_StringList.Add(l_Json.tostring);
   l_StringList.SaveToFile(l_SaveDialog.FileName);
  finally
   FreeAndNil(l_Json);
   FreeAndNil(l_StringList);
   FreeAndNil(l_Marshal);
  end;

 end
 else
  assert(false);

 FreeAndNil(l_SaveDialog);
end;

Идея, в общем, пройтись по списку и сохранить каждый объект.
Представил свое решение руководителю проекта. И?
В общем.
Получил я “по рукам”. За самодеятельность. Да и сам понимал, что десериализация теперь такая-же “ручная” получается.
Не подходит.
Руководитель, вмешавшись, посоветовал добавить каждому объекту метод HackInstance, который в последствии обретет вменяемое имя ToObject:

function TmsShape.HackInstance : TObject;
begin
 Result := Self;
end;

Научив контролер сериализации работать правильно с объектами, получим такой модуль:
unit msSerializeController;

unit msSerializeController;

interface

uses
  JSON,
  msDiagramm,
  Data.DBXJSONReflect;

type
  TmsSerializeController = class(TObject)
  public
    class procedure Serialize(const aFileName: string;
      const aDiagramm: TmsDiagramm);
    class function DeSerialize(const aFileName: string): TmsDiagramm;
  end; // TmsDiagrammsController

implementation

uses
  System.Classes,
  msShape,
  FMX.Dialogs,
  System.SysUtils;

{ TmsSerializeController }

class function TmsSerializeController.DeSerialize(const aFileName: string)
  : TmsDiagramm;
var
  l_UnMarshal: TJSONUnMarshal;
  l_StringList: TStringList;
begin
  try
    l_UnMarshal := TJSONUnMarshal.Create;

    l_UnMarshal.RegisterReverter(TmsDiagramm, 'FShapeList',
      procedure(Data: TObject; Field: String; Args: TListOfObjects)
      var
        l_Object: TObject;
        l_Diagramm: TmsDiagramm;
        l_msShape: TmsShape;
      begin
        l_Diagramm := TmsDiagramm(Data);
        l_Diagramm.ShapeList := TmsShapeList.Create;
        assert(l_Diagramm <> nil);

        for l_Object in Args do
        begin
          l_msShape := l_Object as TmsShape;
          l_Diagramm.ShapeList.Add(l_msShape);
        end
      end);

    l_StringList := TStringList.Create;
    l_StringList.LoadFromFile(aFileName);

    Result := l_UnMarshal.Unmarshal
      (TJSONObject.ParseJSONValue(l_StringList.Text)) as TmsDiagramm;

  finally
    FreeAndNil(l_UnMarshal);
    FreeAndNil(l_StringList);
  end;
end;

class procedure TmsSerializeController.Serialize(const aFileName: string;
const aDiagramm: TmsDiagramm);
var
  l_Marshal: TJSONMarshal; // Serializer
  l_Json: TJSONObject;
  l_StringList: TStringList;
begin
  try
    l_Marshal := TJSONMarshal.Create;

    l_Marshal.RegisterConverter(TmsDiagramm, 'FShapeList',
      function(Data: TObject; Field: string): TListOfObjects
      var
        l_Shape: ImsShape;
        l_Index: Integer;
      begin
        assert(Field = 'FShapeList');
        SetLength(Result, (Data As TmsDiagramm).ShapeList.Count);
        l_Index := 0;
        for l_Shape in (Data As TmsDiagramm).ShapeList do
        begin
          Result[l_Index] := l_Shape.HackInstance;
          Inc(l_Index);
        end; // for l_Shape
      end);

    l_StringList := TStringList.Create;
    try
      l_Json := l_Marshal.Marshal(aDiagramm) as TJSONObject;
    except
      on E: Exception do
        ShowMessage(E.ClassName + ' поднята ошибка с сообщением : ' +
          E.Message);
    end;

    l_StringList.Add(l_Json.tostring);
    l_StringList.SaveToFile(aFileName);
  finally
    FreeAndNil(l_Json);
    FreeAndNil(l_StringList);
    FreeAndNil(l_Marshal);
  end;
end;

end.

Посмотрим, что у нас получилось?

В Json это будет выглядеть так:

{
	"type": "msDiagramm.TmsDiagramm",
	"id": 1,
	"fields": {
		"FShapeList": [{
			"type": "msCircle.TmsCircle",
			"id": 2,
			"fields": {
				"FStartPoint": [[146,
				250],
				146,
				250],
				"FRefCount": 1
			}
		},
		{
			"type": "msCircle.TmsCircle",
			"id": 3,
			"fields": {
				"FStartPoint": [[75,
				252],
				75,
				252],
				"FRefCount": 1
			}
		},
		{
			"type": "msRoundedRectangle.TmsRoundedRectangle",
			"id": 4,
			"fields": {
				"FStartPoint": [[82,
				299],
				82,
				299],
				"FRefCount": 1
			}
		},
		{
			"type": "msRoundedRectangle.TmsRoundedRectangle",
			"id": 5,
			"fields": {
				"FStartPoint": [[215,
				225],
				215,
				225],
				"FRefCount": 1
			}
		},
		{
			"type": "msRoundedRectangle.TmsRoundedRectangle",
			"id": 6,
			"fields": {
				"FStartPoint": [[322,
				181],
				322,
				181],
				"FRefCount": 1
			}
		},
		{
			"type": "msUseCaseLikeEllipse.TmsUseCaseLikeEllipse",
			"id": 7,
			"fields": {
				"FStartPoint": [[259,
				185],
				259,
				185],
				"FRefCount": 1
			}
		},
		{
			"type": "msTriangle.TmsTriangle",
			"id": 8,
			"fields": {
				"FStartPoint": [[364,
				126],
				364,
				126],
				"FRefCount": 1
			}
		}],
		"fName": "Диаграмма №1"
	}
}

Пора заканчивать. Однако, в прошлых постах я описывал, как мы настроили инфраструктуру тестирования для нашего проекта. Поэтому напишем тесты. Фанаты TDD могут кинуть в меня “мокрой тряпкой”, и будут правы. Простите, Гуру. Я только учусь.
Для тестирования просто сохраним один объект (фигуру). И сравним его с оригиналом (то, что “я набрал руками”).
В общем:

unit TestmsSerializeController;
{

  Delphi DUnit Test Case
  ----------------------
  This unit contains a skeleton test case class generated by the Test Case Wizard.
  Modify the generated code to correctly setup and call the methods from the unit 
  being tested.

}

interface

uses
  TestFramework,
  msSerializeController,
  Data.DBXJSONReflect,
  JSON,
  FMX.Objects,
  msDiagramm
  ;

type
  // Test methods for class TmsSerializeController

  TestTmsSerializeController = class(TTestCase)
  strict private
    FmsDiagramm: TmsDiagramm;
    FImage: TImage;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestSerialize;
    procedure TestDeSerialize;
  end;

implementation

 uses
  System.SysUtils,
  msTriangle,
  msShape,
  System.Types,
  System.Classes
  ;

 const
  c_DiagramName = 'First Diagram';
  c_FileNameTest = 'SerializeTest.json';
  c_FileNameEtalon = 'SerializeEtalon.json';

procedure TestTmsSerializeController.SetUp;
begin
 FImage:= TImage.Create(nil);
 FmsDiagramm := TmsDiagramm.Create(FImage, c_DiagramName);
end;

procedure TestTmsSerializeController.TearDown;
begin
 FreeAndNil(FImage);
 FreeAndNil(FmsDiagramm);
end;

procedure TestTmsSerializeController.TestSerialize;
var
  l_FileSerialized, l_FileEtalon: TStringList;
begin
 FmsDiagramm.ShapeList.Add(TmsTriangle.Create(TmsMakeShapeContext.Create(TPointF.Create(10, 10),nil)));
  // TODO: Setup method call parameters
 TmsSerializeController.Serialize(c_FileNameTest, FmsDiagramm);
  // TODO: Validate method results
 l_FileSerialized := TStringList.Create;
 l_FileSerialized.LoadFromFile(c_FileNameTest);

 l_FileEtalon := TStringList.Create;
 l_FileEtalon.LoadFromFile(c_FileNameEtalon);

 CheckTrue(l_FileEtalon.Equals(l_FileSerialized));

 FreeAndNil(l_FileSerialized);
 FreeAndNil(l_FileEtalon);
end;

procedure TestTmsSerializeController.TestDeSerialize;
var
  ReturnValue: TmsDiagramm;
  aFileName: string;
begin
  // TODO: Setup method call parameters
  ReturnValue := TmsSerializeController.DeSerialize(aFileName);
  // TODO: Validate method results
end;

initialization
  // Register any test cases with the test runner
  RegisterTest(TestTmsSerializeController.Suite);
end.

Ссылки которые мне пригодились:
www.webdelphi.ru/2011/10/rabota-s-json-v-delphi-2010-xe2/#parsejson
edn.embarcadero.com/article/40882
www.sdn.nl/SDN/Artikelen/tabid/58/view/View/ArticleID/3230/Reading-and-Writing-JSON-with-Delphi.aspx
codereview.stackexchange.com/questions/8850/is-marshalling-converters-reverters-via-polymorphism-realistic
Json viewer plugin for Notepad++

Старший коллега, Александр, шагнул в разработке далеко вперед моей статьи. Ссылка на репозиторий. Все ваши замечания к коду оставляйте плз в BitBucket, благо репозиторий открытый. Все желающие попробовать себя в OpenSource — обращайтесь в личку.

Вот так выглядит диаграмма проекта сейчас:

image

Диаграмма тестов:

image

Автор: instigator21

Источник

* - обязательные к заполнению поля


https://ajax.googleapis.com/ajax/libs/jquery/3.4.1/jquery.min.js