1. Alex Lulin Avatar Alex Lulin
  2. Untitled project
  3. MindStream

Wiki

Clone wiki

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

View History

Предыдущая статья

Ещё в начале увлечения программированием мне нравилось работать с файлами. Работа, правда, в основном заключалась в чтении входных данных и записей результатов. Дальше была работа с БД, файлами я пользовался все реже. Максимум 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.

Ссылки которые мне пригодились:

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

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

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

Updated