Часть 1.
Часть 2.
Часть 3. DUnit + FireMonkey.
Часть 3.1. По мотивам GUIRunner.
Ещё в начале увлечения программированием мне нравилось работать с файлами. Работа, правда, в основном заключалась в чтении входных данных и записей результатов. Дальше была работа с БД, файлами я пользовался все реже. Максимум IniFile иногда. Поэтому задача сериализации была довольно интересной для меня.
Сегодня я расскажу о том, как мы добавили сериализацию в нашу программу, какие возникли трудности и как мы их преодолели. Так как материал уже не новый, то он скорее для новичков. Хотя, кое-какие приемы смогут почерпнуть покритиковать все.
Само понятие “сериализация” очень хорошо изложил 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.
Пора добавить сериализацию в наше приложение.
Напомню читателям как выглядит приложение:
А также UML-диаграмму:
Нам необходимо сериализовать класс 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:
Дебагер обрадовал ограничениями функции библиотеки:
А дело всё в том, что наш список:
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.
Посмотрим, что у нас получилось?
{
"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 — обращайтесь в личку.
Вот так выглядит диаграмма проекта сейчас:
Диаграмма тестов:
Автор: instigator21
