Wiki
Clone wikiMindStream / Статьи на русском / MindStream. Как мы пишем ПО под FireMonkey. Часть 4 Serialization
Ещё в начале увлечения программированием мне нравилось работать с файлами. Работа, правда, в основном заключалась в чтении входных данных и записей результатов. Дальше была работа с БД, файлами я пользовался все реже. Максимум IniFile иногда. Поэтому задача сериализации была довольно интересной для меня.
Сегодня я расскажу о том, как мы добавили сериализацию в нашу программу, какие возникли трудности и как мы их преодолели. Так как материал уже не новый, то он скорее для новичков. Хотя, кое-какие приемы смогут почерпнуть покритиковать все.
Само понятие “сериализация” очень хорошо изложил gunsmoker у себя в блоге.
Я остановился на сериализации в JSON формат. Почему JSON? Он читабелен (я использую плагин для Notepad++), он позволяет описывать сложные структуры данных, ну и, наконец, в Rad Studio XE7 есть поддержка JSON из “коробки”.
Для начала напишем небольшой прототип, задачей которого будет сохранить некий объект:
#!delphi ... 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;
#!json { "type": "uMain.TmsShape", "id": 1, "fields": { "fInt": 1, "fStr": "First" } }
Следующим шагом сериализуем список фигур TmsShape; для этого добавим новый класс, у которого будет — поле “список”:
#!delphi ... 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):
#!delphi ... 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; ...
Остальной код не менялся. На выходе получим такой файл:
#!json { "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):
#!delphi //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 функций, которые умеют обрабатывать стандартные структуры данных. Однако, никто не мешает переопределить эти функции (они могут быть анонимные).
Попробуем?
#!delphi ... 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 ); ...
#!json { "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" } }] } }
Всё, уже совсем хорошо. Но давайте представим, что нам необходимо сохранять строку и не сохранять число. Для этого воспользуемся атрибутами.
#!delphi type TmsShape = class private [JSONMarshalled(False)] fInt: integer; [JSONMarshalled(True)] fStr: String; public constructor Create(const aInt: integer; const aStr: String); end;
На выходе получим:
#!json { "type": "uMain.TmsShapeContainer", "id": 1, "fields": { "fList": [{ "type": "uMain.TmsShape", "id": 2, "fields": { "fStr": "First" } }, { "type": "uMain.TmsShape", "id": 3, "fields": { "fStr": "Second" } }] } }
Пора добавить сериализацию в наше приложение. Напомню читателям как выглядит приложение:
А также UML-диаграмму:
Нам необходимо сериализовать класс TmsDiagramm. Но не весь. Нам нужен только список фигур на диаграмме и название диаграммы.
#!delphi ... 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 статических функции:
#!delphi type TmsSerializeController = class(TObject) public class procedure Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); class function DeSerialize(const aFileName: string): TmsDiagramm; end; // TmsDiagrammsController
Функция сериализации такая же, как в примере выше. Но вместо файла на выходе я получал exception:
Дебагер обрадовал ограничениями функции библиотеки:
А дело всё в том, что наш список:
#!delphi type TmsShapeList = class(TList<ImsShape>) public function ShapeByPt(const aPoint: TPointF): ImsShape; end; // TmsShapeList
Это список интерфейсов, которые не “кушает” Json из коробочки. Печально, но делать что-то надо. Раз список интерфейсный, но объекты в нём реальные, а не сериализовать ли нам просто список объектов? Сказано — сделано.
#!delphi 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:
#!delphi function TmsShape.HackInstance : TObject; begin Result := Self; end;
Научив контролер сериализации работать правильно с объектами, получим такой модуль:
#!delphi 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 это будет выглядеть так:
#!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 могут кинуть в меня “мокрой тряпкой”, и будут правы. Простите, Гуру. Я только учусь. Для тестирования просто сохраним один объект (фигуру). И сравним его с оригиналом (то, что “я набрал руками”). В общем:
#!delphi 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 — обращайтесь в личку.
Вот так выглядит диаграмма проекта сейчас:
Диаграмма тестов:
Updated