January 13, 2013

Using a custom attribute for data persistence


Custom attributes is a relatively new Delphi feature and is seldom used. To help you grasp the concept, this article will apply custom attributes to ease data persistence of a class.

What is a custom attribute?


Basically, a custom attribute is a simple class. What makes it special is how it is used within a Delphi program.

Annotating Types and Type Members


Custom attributes are used to annotate types and type members. The syntax is described in Delphi online help. In the context of this article we use a single custom attribute to annotate fields and properties of any class.

As a simple example, I will create a class TConfig and annotate some of it in order to be able to save or load it from an ini file. The code is very similar if we used xml, or a database or the registry. To keep it easy and short, I will only demonstrate using an ini file.

To annotate a property or field of a class, simple add the attribute name and optional parameters between angle brackets above the field of property:

type
  TConfig = class(TComponent)
  public
    [PersistAs('Config', 'Version', '1.0')]
    Version : String;
    [PersistAs('Config', 'Description', 'No description')]
    Description : String;
    FTest : Integer;
    // No attribute => not persistent
    Count : Integer;
    [PersistAs('Config', 'Test', '0')]
    property Test : Integer read FTest write FTest;
  end;

As you can see, the custom attribute is PersistAs. We'll see in a moment how to create and handle it. PersistAs is taking 3 parameters: a section name, a key name and a default value. Those parameters will be used to read/write the field or property to the storage, here to read/write to an ini file.

What does a custom attribute?


By itself, a custom attribute just do nothing! It is just an annotation. What to do with the attribute is up to you. You have to write code which makes use of the attribute.

The code using the attribute can be in the annotated class itself but is frequently in another class. In this article, the custom attribute is handled in a separate class named TPersistHandler which delegate part of the work to the user. I have separated the code processing the custom attribue from the code doing the actual persistence so that it is easy to apply it to whatever storage is required.

Delphi compile will compile a custom attribute as data attached to the executable and linked to the data type it belongs to. In other words, a custom attribute is compiled as part of the Run Time Type Information (RTTI) attached to the data type. To find out which attribute (custom or not) is attached to a data type or a type member (field or property), the developer must call RTTI functions which are located in the RTTI and TypInfo units.

How to declare a custom attribute?


A custom attribute is a simple class. The only requirement is that this class must derive from the existing TCustomAttribute class defined in the System unit. TCustomAttribute directly derive from TObject and is just empty.

The custom attribute class can be as simple as an empty class if the attribute has no parameter at all, or can contain data fields to store one or more parameters.

In our sample, we use 3 parameters: a section name, a key name and a default value. So let's write the class:

type
  PersistAs = class(TCustomAttribute)
  public
    Section  : String;
    Key      : String;
    DftValue : String;
    constructor Create(const ASection  : String;
                       const AKey      : String;
                       const ADftValue : String = '');
  end;

Very simple isn't it?

Note that we have not named the class TPersistAs as we would normally have done. This is because the class name is the attribute name and having a T in front of it is not conforming to custom attribute naming.

The constructor has to store the parameters in the fields:

constructor PersistAs.Create(const ASection, AKey, ADftValue: String);
begin
  Section  := ASection;
  Key      := AKey;
  DftValue := ADftValue;
end;

Of course, the class could have several constructors so that the number of parameters could vary. It's up to you to decide. For our simple usage here, the 3 parameters are perfect: they are required to read/write the ini file.

Using the attribute PersistAs


We have seen above that a custom attribute doesn't do anything by itself. It is simply stored along with other RTTI data. To use it we need to write some code.

Our goal here is to use the custom attribute to make some of the data within a class (Any class! Here applied to TConfig) persistent in an ini file or other similar storage such as the registry, and xml file or even a database.

To let you reuse as much as possible my code and still be able to select the proper storage you need, I have delegated the actual read/write outside of the handler class by the way of two procedures.

  TPersistHandler = class
  protected
    class function  GetValue(var AValue : TValue) : String;
    class function  GetPersistAs(Obj : TRttiObject) : PersistAs;
    class procedure SetValue(var AValue : TValue;
                             const AData : String);
  public
    class procedure Process(const Obj    : TObject;
                            const Writer : TPersistWriterProc); overload;
    class procedure Process(const Obj    : TObject;
                            const Reader : TPersistReaderProc); overload;
  end;

The interesting part is the overloaded procedure Process. There is one version to write data and another to read data.

In the demo application, they are used like this:

procedure TAttributesDemoForm.WriteButtonClick(Sender: TObject);
begin
  TPersistHandler.Process(FConfig, AttrWriter);
end;

procedure TAttributesDemoForm.ReadButtonClick(Sender: TObject);
begin
  TPersistHandler.Process(FConfig, AttrReader);
end;

FConfig is an instance of TConfig shown above; AttrReader and AttrWriter are two procedures we will see in details in a moment.

AttrReader and AttrWriter are the key to the code reuse. You - as a user of my code - have to write those procedures in the context of your own application to store the data where you need it and how you need it. The complex work of applying the custom attributes to any class is completely abstracted in TPersistHandler. You can reuse it without any change whatever class the custom attribute is used into.

AttrReader and AttrWriter must be declared to fit the declarations:

  TPersistState = (pstBeginUpdate,
                   pstReadField,  pstReadProp,
                   pstWriteField, pstWriteProp,
                   pstEndUpdate);

  TPersistWriterProc = procedure (const Obj       : TObject;
                                  const State     : TPersistState;
                                  const ASection  : String;
                                  const AKey      : String;
                                  const AValue    : String) of object;

  TPersistReaderProc = procedure (const Obj       : TObject;
                                  const State     : TPersistState;
                                  const ASection  : String;
                                  const AKey      : String;
                                  const ADftValue : String;
                                  out   AValue    : String) of object;

AttrReader and AttrWriter will be called several times in a loop by the Process procedure. It will always be call one time before and one time after the loop, and as much time as there are properties or fields to read/write.

The argument State will help you do the storage work. The first call will have state pstBeginUpdate, the last call will have pstEndUpdate and the call to read/write actual fields/properties will have the other values of the enumeration.

The argument Obj is the object from which data is extracted, the one passed to the Process procedure as first argument.

The other arguments are self-explanatory, they correspond the custom attribute parameters.

Having those information in mind, we can now look at the actual implementation:

procedure TAttributesDemoForm.AttrWriter(
  const Obj      : TObject;
  const State    : TPersistState;
  const ASection : String;
  const AKey     : String;
  const AValue   : String);
begin
  case State of
  pstBeginUpdate : FIniFile := TIniFile.Create(FIniFileName);
  pstWriteField,
  pstWriteProp   : FIniFile.WriteString(ASection, AKey, AValue);
  pstEndUpdate   : FreeAndNil(FIniFile);
  end;
end;

procedure TAttributesDemoForm.AttrReader(
  const Obj       : TObject;
  const State     : TPersistState;
  const ASection  : String;
  const AKey      : String;
  const ADftValue : String;
  out   AValue    : String);
begin
  case State of
  pstBeginUpdate : FIniFile := TIniFile.Create(FIniFileName);
  pstReadField,
  pstReadProp    : AValue := FIniFile.ReadString(ASection, AKey, ADftValue);
  pstEndUpdate   : FreeAndNil(FIniFile);
  end;
end;

FIniFile and FIniFileName are declared in the class TAttributesDemoForm.

The code is really simple. We make use of the State argument to know what to do: open the ini file, read or write data or close the ini file.

Obviously, AttrWrite receive the data value to write as a const parameter while AttrReader receive it as an out parameter.

If you want to store data into an xml file or the registry or a database, the code is very similar: whatever the storage is, you can easily start/open, read/write and stop/close the resource used for actual storage.

Now let's see the magic part: How does TPersistHandler process the custom attribute used to annotate an arbitrary class. The magic is behind the Process procedure. This is an overloaded procedure to ease use: we use the same procedure name for reading or writing data. The compiler is able to call the correct one because the second argument is different.

To start, let's see the data write part:

class procedure TPersistHandler.Process(
  const Obj    : TObject;
  const Writer : TPersistWriterProc);
var
  RttiCtx    : TRttiContext;
  RttiType   : TRttiType;
  RttiField  : TRttiField;
  RttiProp   : TRttiProperty;
  AttrValue  : TValue;
  Attr       : PersistAs;
  AttrString : String;
begin
  if (not Assigned(Obj)) or (not Assigned(Writer)) then
    Exit;

  Writer(Obj, pstBeginUpdate, '', '', '');
  try
    RttiCtx := TRttiContext.Create;
    try
      RttiType := RttiCtx.GetType(Obj.ClassInfo);
      for RttiProp in RttiType.GetProperties do begin
        Attr := GetPersistAs(RttiProp);
        if Assigned(Attr) then begin
          AttrValue  := RttiProp.GetValue(Obj);
          AttrString := GetValue(AttrValue);
          Writer(Obj, pstWriteProp,
                 Attr.Section, Attr.Key, AttrString);
        end;
      end;
      for RttiField in RttiType.GetFields do begin
        Attr := GetPersistAs(RttiField);
        if Assigned(Attr) then begin
          AttrValue  := RttiField.GetValue(Obj);
          AttrString := GetValue(AttrValue);
          Writer(Obj, pstWriteField,
                 Attr.Section, Attr.Key, AttrString);
        end;
      end;
    finally
      RttiCtx.Free;
    end;
  finally
    Writer(Obj, pstEndUpdate, '', '', '');
  end;
end;

The first thing the code is doing is to check the two arguments. If either is not assigned, then nothing is done. We could have raised an exception instead. It's just a matter of taste.

Then there are two try/finally constructs. The first make sure Write is always called before and after the actual data write; the second is to make sure the RTTI context is properly freed.

Inside the two try/finally constructs, we find two almost identical loops. The first loop handles the properties while the second handle the fields.

Inside the loops, we fetch the custom attribute using the helper function GetPersistAs. If we found it, this mean the member (property or field) has been annotated with PersistAs custom attribute. We get the value and call Writer (This is actually similar to an event) to write the data wherever it has to be written.

The read data part is very similar:

class procedure TPersistHandler.Process(
  const Obj    : TObject;
  const Reader : TPersistReaderProc);
var
  RttiCtx    : TRttiContext;
  RttiType   : TRttiType;
  RttiField  : TRttiField;
  RttiProp   : TRttiProperty;
  AttrValue  : TValue;
  Attr       : PersistAs;
  AttrString : String;
begin
  if (not Assigned(Obj)) or (not Assigned(Reader)) then
    Exit;

  Reader(Obj, pstBeginUpdate, '', '', '', AttrString);
  try
    RttiCtx := TRttiContext.Create;
      try
        RttiType := RttiCtx.GetType(Obj.ClassInfo);
        for RttiProp in RttiType.GetProperties do begin
          Attr := GetPersistAs(RttiProp);
          if Assigned(Attr) then begin
            AttrValue := RttiProp.GetValue(Obj);
            Reader(Obj, pstReadProp,
                   Attr.Section, Attr.Key, Attr.DftValue, AttrString);
            SetValue(AttrValue, AttrString);
            RttiProp.SetValue(Obj, AttrValue);
          end;
        end;
        for RttiField in RttiType.GetFields do begin
          Attr := GetPersistAs(RttiField);
          if Assigned(Attr) then begin
            AttrValue := RttiField.GetValue(Obj);
            Reader(Obj, pstReadField,
                   Attr.Section, Attr.Key, Attr.DftValue, AttrString);
            SetValue(AttrValue, AttrString);
            RttiField.SetValue(Obj, AttrValue);
          end;
        end;
      finally
        RttiCtx.Free;
      end;
    finally
      Reader(Obj, pstEndUpdate, '', '', '', AttrString);
    end;
end;
 
I won't describe it in details because it is merely the same as the writer except of course values are read instead of written. Reader takes one more parameter: the default value defined in the custom attribute. it is intended to be used by the reader code in case no data can be found in the storage.

More interesting, let's have a look at GetPersistAs function:

class function TPersistHandler.GetPersistAs(Obj: TRttiObject): PersistAs;
var
  Attr : TCustomAttribute;
begin
  Result := nil;
  for Attr in Obj.GetAttributes do begin
    if Attr is PersistAs then begin
      Result := PersistAs(Attr);
      break;
    end;
  end;
end;

GetPersistAs receive an RTTI object as parameter. This object is either describing a field or property in our application. A for..in construct is used to iterate thru all attributes and find the PersistAs attribute. Remember each attribute is a simple class so we can use the is operator to check the kind of attribute we are looking at. Once we got it, we return it. If we don't find one, we return nil.

Finally we have two more helper functions to get or set the data value:

class function TPersistHandler.GetValue(var AValue: TValue): String;
begin
  if AValue.Kind in [tkWChar, tkLString, tkWString, tkString,
                     tkChar,  tkUString, tkInteger, tkInt64, tkFloat,
                     tkEnumeration, tkSet] then
    Result := AValue.ToString
  else
    raise EPersistAs.Create(GetEnumName(TypeInfo(TTypeKind),
                                        Ord(AValue.Kind)) +
                            ': Type not Supported');
end;

class procedure TPersistHandler.SetValue(
  var   AValue : TValue;
  const AData  : String);
var
  NValue : Integer;
begin
  case AValue.Kind of
  tkWChar, tkLString, tkWString, tkString, tkChar, tkUString :
    AValue := AData;
  tkInteger, tkInt64 :
    AValue := StrToInt(AData);
  tkFloat :
    AValue := StrToFloat(AData);
  tkEnumeration :
    AValue := TValue.FromOrdinal(AValue.TypeInfo,
                                 GetEnumValue(AValue.TypeInfo, AData));
  tkSet :
    begin
      NValue := StringToSet(AValue.TypeInfo, AData);
      TValue.Make(@NValue, AValue.TypeInfo, AValue);
    end;
  else
    raise EPersistAs.Create(GetEnumName(TypeInfo(TTypeKind),
                                        Ord(AValue.Kind)) +
                            ': Type not Supported');
  end;
end;

Those functions receive a value descriptor (TValue data type) which is used by the RTTI system to describe a value. We use the Kind member to know what the underlying data type is and take appropriate action to get/set the value. I have not mentioned it, but everything is handled as string in TPersistHandler so we have to convert to/from the actual underlying data type here.

Note that I have not handled every possible data type and just raise a custom exception if the custom attribute is applied to an unsupported data type. It is worth noting I make use of GetEnumName to build a clear exception message showing the unsupported data type by name.

Source code


The actual complete source code is available from my website here
The article is here.
Find the Internet Component Suite (ICS) here.

Suggested readings


    Writing an iterator for a container
    Original method to iterate thru the bits of an integer
    Adding properties to a set
    Internet Component Suite (ICS)
    MidWare multi-tier framework

Follow me on Twitter

2 comments:

Jens Borrisholt said...

Would it be posible to get a copy of the complete example? Your download klink doesn't work

FPiette said...

The link has been fixed. Thanks.