Про сериализацию, Delphi и RTTI

[esyr]

Собственно, есть задача: уметь делать передачу каких-то структур по сети и сохранять их на диске. В С++ подобная задача очень элегантно решается через темплейты, напрмер, есть луноликая _Winnie Serialization Library. Но в Delphi такого мощного инструмента нет. Зато есть кое-какие другие.

Когда передо мной встала сначала такая задача, я начал решать её довольно криво: подготавливал в памяти буфер, в него складывал сериализованную структуру и потом уже кидал его по сети или сохранял на диск. Делалось это очень криво и через такую жопу, что я даже вспоминать боюсь (да и код я уже этот похерил). Соответственно, у такого подхода ряд недостатков:

• Надо заранее знать размер буфера, что, в общем случае, нетривиально. Или делать аццкие реаллоки, что тоже не есть много хорошего
• Надо процедурам сохранения кусков структур передавать много лишнего
• Сам код достаточно кривой получается

В итоге, от сего счастья, к счастью, пришлось отказаться.

Тут вспомнилось, что в Delphi есть много чего хорошего в её бездонной VCL/RTL, например, такая абстракция как поток (TStream). Кроме того, Delphi она ж объектно ориентированная, посему логично обернуть сериализуемыю структуру в класс. Сделано это было приблизительно следующим образом (спасибо DRKB за многое количество полезной информации):

TSerializableObject = class(TPersistent)
  protected
    procedure WriteBool(const b : boolean; Stream : TStream);
    procedure WriteInt(const i : integer; Stream : TStream);
    procedure WriteExt(const e : extended; Stream : TStream);
    procedure WriteStr(const s : string; Stream : TStream);
    //Здесь может быть ещё пачка функций для сохранения примитивов, мне же хватило этих трёх
    procedure WriteObject(const obj : TSerializableObject; Stream : TStream);

    function ReadInt(Stream : TStream) : integer;
    function ReadExt(Stream : TStream) : extended;
    function ReadStr(Stream : TStream) : string;
    //...
    function ReadObject(Stream : TStream) : TSerializableObject;

  public
    constructor CreateFromStream(Stream: TStream);

    procedure SaveToStream(Stream : TStream); virtual; abstract;
    procedure LoadFromStream(Stream : TStream); virtual; abstract;
  end;

Теперь можно унаследовать от него, переписать SaveToStream/LoadFromStream и будет счастье. Причём, что приятно, они выглядят приблизительно следующим образом:

procedure TMessage.LoadFromStream(Stream: TStream);
begin
  FMessageType := TMessageType(ReadInt(Stream));
  FClientID := ReadInt(Stream);
  FMsg := ReadObject(Stream);
end;

procedure TMessage.SaveToStream(Stream: TStream);
begin
  WriteInt(ord(FMessageType), Stream);
  WriteInt(FClientID, Stream);
  WriteObject(FMsg, Stream);
end;

Да, ещё же нам надо сериализовывать списки. Это тоже решается довольно красиво, и тут уже нам требуется RTTI для воссоздания класса по сохранённому в потоке его имени (собственно, получание ссылки на класс по её имени в ReadObject):

TSerializableObjectClass = class of TSerializableObject;

  TSerializableList = class(TSerializableObject)
  protected
    FItems: TObjectList;

    function GetCount: LongInt;
    function GetObject(Index : Integer): TSerializableObject;
    procedure SetObject(Index : Integer; Objects : TSerializableObject);

  public
    constructor Create;
    constructor CreateFromStream(Stream: TStream);
    destructor Destroy; override;

    function FindClass(const AClassName: String): TSerializableObjectClass;
    //...
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property Objects[Index: Integer]: TSerializableObject read GetObject write SetObject; default;
    property Count: LongInt read GetCount;
  end;

function TSerializableObject.ReadObject(
  Stream: TStream): TSerializableObject;
var
  S : string;
  ClassRef : TSerializableObjectClass;

begin
  S := ReadStr(Stream);
  ClassRef := TSerializableObjectClass(FindClass(S));
  Result := ClassRef.CreateFromStream(Stream);
end;

procedure TSerializableObject.WriteObject(const obj: TSerializableObject;
  Stream: TStream);
begin
  WriteStr(obj.ClassName, Stream);
  obj.SaveToStream(Stream);
end;

function TSerializableList.FindClass(
  const AClassName: String): TSerializableObjectClass;
begin
  Result :=  TSerializableObjectClass(Classes.FindClass(AClassName));
end;

procedure TSerializableList.LoadFromStream(Stream: TStream);
var
  StreamCount : Integer;
  I : Integer;

begin
  StreamCount := ReadInt(Stream);
  for I := 0 to StreamCount - 1 do
  begin
    Add(ReadObject(Stream));
  end;
end;

procedure TSerializableList.SaveToStream(Stream: TStream);
var
  I: Integer;

begin
  WriteInt(Count, Stream);
  for I := 0 to Count - 1 do
  begin
    WriteObject(Objects[I], Stream);
  end;
end;

Приятно то, что список является сериализуемым объектом, поэтому в save/load для него можно вызвать WriteObject/ReadObject и он кошерно сериализует себя вместе со своими элементами, которые также могут быть списками, и так далее.

Но есть у подобного подхода свои недостатки (исправляемые, как будет видно далее, эволюционными методами):

• Надо для каждого класса расписывать Save/Load, а он в 99 процентах случаев однотипен: нетривиально его пришлось писать только для списка, в остальных случаях это просто сохранение/загрузка примитивов
• Код save/load в этих 99 процентах случаев один и тот же в том смысле, что сначала в какой-то последовательности объекты сохраняются, а потом в той же восстанавливаются — дублирование кода и источник ошибок (перепутал порядок загрузки, забыл загрузить или сохранить, и так далее)
• Случилось так, что в этих же 99 процентах сохраняются исключительно проперти объекта (плюс, возможно, некоторые private поля)

Теперь начинается самое интересное. Очевидно, что для решения перечисленных проблем нам нужно нечто, которое сериализует все проперти класса. И оно было написано как метод корневого класса TSerializableObject (показан только код LoadFromStream, SaveToStream аналогичен, только вместо SetType(ReadType(Stream), PropList^[I].Name); стоит WriteType(GetType(PropList^[I].Name), Stream);):

procedure TSerializableObject.LoadFromStream(Stream: TStream);
var
  I, Count: Integer;
  PropList: PPropList;

begin
  Count := GetTypeData(Self.ClassInfo)^.PropCount;

  if Count > 0 then
  begin
     GetMem(PropList, Count * SizeOf(Pointer));
     try
       GetPropInfos(Self.ClassInfo, PropList);
       for I := 0 to Count - 1 do
       begin
         case PropList^[I].PropType^.Kind of
           tkInteger: SetInt(ReadInt(Stream), PropList^[I].Name);
           tkFloat:   SetExt(ReadExt(Stream), PropList^[I].Name);
           tkString:  SetStr(ReadStr(Stream), PropList^[I].Name);
           tkClass:   SetObject(ReadObject(Stream), PropList^[I].Name);
         end;
       end;
     finally
       FreeMem(PropList, Count * SizeOf(Pointer));
     end;
  end;
end;

Теперь, можно просто объявить потомок в виде

TMessage = class(TSerializableObject)
  private
    FMessageType : TMessageType;
    FClientID : Integer;
    FMsg : TSerializableObject;

  published
    property MessageType : TMessageType read FMessageType write FMessageType;
    property ClientID : Integer read FClientID write FClientID;
    property Msg : TSerializableObject read FMsg write FMsg;
  end;

и всё будет работать. Даже методов писывать не надо. Если же надо что-то записать дополнительно, то можно это сделать следующим образом:

procedure TQuestion.SaveToStream(Stream: TStream);
begin
  inherited; //будет выполнен метод TSerializableObject, который сохранит все пибличные property

  WriteStr(FMyPrivateString, Stream); //а тут мы сохраняем нечто приватное
end;

На данный момент осталась проблема дублирования кода (как save/load, так и для каждого примитива), но это я попытаюсь решить введением ещё одного слоя абстракции типа procedure SerializeEntity();.

Пока вот так. //Ох и полетят же сейчас в меня камни и насмешки...

Comments

[heavior.livejournal.com]

С чего это ты на Делфи кодишь? Бери Билдер и будет тебе счастье!

[heavior.livejournal.com]

или прикруте небольшую сишную либку.

[netp-npokon.livejournal.com]

А вай бы и нот? Не сошелся же свет клином на плюсах. Тем более, если задача неплохо решается на дельфи, зачем чего-то прикручивать?

[heavior.livejournal.com]

Плохо себе представляю задачу, которая на Делфи решалась бы удобнее, чем на плюсах, если учесть существование этого самого Билдера, который полностью повторяет систему объектов Делфи и сохраняет достоинства плюсов....