PersistentClassAttribute = class sealed(TCustomAttribute)
strict private
fTableName : string;
public
constructor Create(const aTableName : string);
property TableName : string read fTableName;
end;
PersistentPropertyAttribute = class sealed(TCustomAttribute)
strict private
fColumnName : string;
fKey : Boolean;
public
constructor Create(const aColumnName : string; aKey : Boolean = False);
property ColumnName : string read fColumnName;
property Key : Boolean read fKey;
end;
Both fairly simple. The important things to not is that both inherit from TCustomAttribute, and their constructors dictate the way I will use them. I’m not going to bother showing the implementation of either of these classes. Both are very similar, in that the parameters passed to the constructors are stored in the corresponding private fields.
Now we’ve got our attributes set up, and our class has been duly decorated. How do we access that information? Well, you’ll notice that the class which we wish to persist inherits from TPersistable. This class will take care of getting the information we need from the attributes. Let’s start with the class map information.
We’ll create a class procedure on TPersistable to load our classmap.
var
ctx : TRttiContext;
t : TRttiType;
p : TRttiProperty;
a : TCustomAttribute;
begin
ctx := TRttiContext.Create;
t := ctx.GetType(Self);
for a in t.GetAttributes do
if a is PersistentClassAttribute then
begin
fTableName := PersistentClassAttribute(a).TableName;
Break;
end;
Anyone who has seen any code associated with the new RTTI functionality will be familiar with this code. We use the RTTIContext to get to the class information. We iterate over all the attributes on the class until we get to the PersistentClassAttribute. We could do this every time we needed the class map information, but we’re going to do this once, and then cache the information. The next step would be to get the list of properties which we want to persist. We’ll add a few more lines to the procedure above.
class procedure TPersistable.LoadClassmap;
var
ctx : TRttiContext;
t : TRttiType;
p : TRttiProperty;
a : TCustomAttribute;
Prop : IPropertyMap;
begin
ctx := TRttiContext.Create;
t := ctx.GetType(Self);
for a in t.GetAttributes do
if a is PersistentClassAttribute then
begin
fTableName := PersistentClassAttribute(a).TableName;
Break;
end;
for p in t.GetProperties do
for a in p.GetAttributes do
if (a is PersistentPropertyAttribute) then
begin
if not fPropertyList.ContainsKey(UpperCase(PersistentPropertyAttribute(a).ColumnName)) then
begin
Prop := TPropertyMap.Create(PersistentPropertyAttribute(a).ColumnName, P.PropertyType.TypeKind);
fPropertyList.Add(UpperCase(Prop.ColumnName), Prop);
end;
end;
end;
We’re doing exactly the same thing as before, except this time we’re iterating over the properties of the class, and checking the attributes of each property. If that attribute happens to be out PersistentAttributeProperty, we create a TPropertyMap class and add it to our list of properties. Once this class procedure has been executed, we now have a cache of information about our class and how we should go about persisting it. we could add a few class functions to help us access that information.
class function PropertyMap(const aName : string) : IPropertyMap;
class function TableName : string;
...
...
class function TPersistable.PropertyMap(const aName: string): IPropertyMap;
begin
fPropertyList.TryGetValue(UpperCase(aName), Result);
end;
...
...
class function TPersistable.TableName: String;
begin
Result := fTableName;
end;
We’re still a long way from persisting our objects, but we now have all the information we need. When I do implement the actual persistence, I’ll make sure it is extremely easy to change from persisting to SQL Server or to a simple XML file.
Posts
