MindStream. Как мы пишем ПО под FireMonkey. Часть 4 Serialization10.12.2014 08:33

Часть 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; public constructor Create; destructor Destroy; end;

constructor TmsShapeContainer.Create; begin inherited; fList:= TList.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», «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», «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; 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.Create; end;

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

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

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

… type TmsShapeList = class (TList) 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) 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/#parsejsonedn.embarcadero.com/article/40882www.sdn.nl/SDN/Artikelen/tabid/58/view/View/ArticleID/3230/Reading-and-Writing-JSON-with-Delphi.aspxcodereview.stackexchange.com/questions/8850/is-marshalling-converters-reverters-via-polymorphism-realisticJson viewer plugin for Notepad++Старший коллега, Александр, шагнул в разработке далеко вперед моей статьи. Ссылка на репозиторий. Все ваши замечания к коду оставляйте плз в BitBucket, благо репозиторий открытый. Все желающие попробовать себя в OpenSource — обращайтесь в личку.

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

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

image

© Habrahabr.ru