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

    Часть 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
    Поделиться публикацией
    Похожие публикации
    AdBlock похитил этот баннер, но баннеры не зубы — отрастут

    Подробнее
    Реклама
    Комментарии 0

    Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.