Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects:[880] trunk/Source/Core
|
From: <wp...@us...> - 2009-12-21 09:14:00
|
Revision: 880
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=880&view=rev
Author: wp2udk
Date: 2009-12-21 09:13:48 +0000 (Mon, 21 Dec 2009)
Log Message:
-----------
Added support for Custom Attributes in InstantObjects. In the future this initiative (custom attributes) might replace Metadata comments (See post "info: Fix for Delphi 2010 Custom Attributes"). This is a fairly new implementation and it NEEDS a great amount of DESIGN and TEST. Below you'll see a code example on how things might be implemented in the future.
Model implementation:
TContact = class(TInstantObject)
{IOMETADATA stored;
Address: Part(TAddress);
Name: String(30);
Phones: Parts(TPhone); }
[IOATTRIBUTE(atPart, -1, TAddress)]
_Address: TInstantPart;
[IOATTRIBUTE(atString, 30, nil)]
_Name: TInstantString;
[IOATTRIBUTE(atParts, -1, TPhone)]
_Phones: TInstantParts;
private
function GetAddress: TAddress;
function GetName: string;
function GetPhoneCount: Integer;
function GetPhones(Index: Integer): TPhone;
procedure SetAddress(Value: TAddress);
procedure SetName(const Value: string);
procedure SetPhones(Index: Integer; Value: TPhone);
public
function AddPhone(Phone: TPhone): Integer;
procedure ClearPhones;
procedure DeletePhone(Index: Integer);
function IndexOfPhone(Phone: TPhone): Integer;
procedure InsertPhone(Index: Integer; Phone: TPhone);
function RemovePhone(Phone: TPhone): Integer;
property PhoneCount: Integer read GetPhoneCount;
property Phones[Index: Integer]: TPhone read GetPhones write SetPhones;
published
property Address: TAddress read GetAddress write SetAddress;
property Name: string read GetName write SetName;
end;
Custom Attribute implementation:
IOATTRIBUTE = class(TInstantRttiFieldAttribute)
private
FAttributeType: TInstantAttributeType;
FDataSize: Integer;
FRef: TInstantObjectClass;
protected
procedure InternalChange(AObject: TInstantObject; AField: TRttiField); override;
public
constructor Create(AAttributeType: TInstantAttributeType; ADataSize: Integer;
ARef: TInstantObjectClass = nil);
property AttributeType: TInstantAttributeType read FAttributeType write FAttributeType;
property DataSize: Integer read FDataSize write FDataSize;
property ARef: TInstantObjectClass read FRef write FRef;
end;
implementation
{ IOATTRIBUTE }
constructor IOATTRIBUTE.Create(AAttributeType: TInstantAttributeType;
ADataSize: Integer; ARef: TInstantObjectClass = nil);
begin
FAttributeType := AAttributeType;
FDataSize := ADataSize;
FRef := ARef;
end;
procedure IOATTRIBUTE.InternalChange(AObject: TInstantObject;
AField: TRttiField);
var
Attribute: TInstantAttribute;
begin
inherited;
Attribute := AField.GetValue(AObject).AsObject as TInstantAttribute;
with Attribute.Metadata do
begin
AttributeType := FAttributeType;
DataSize := FDataSize;
if FAttributeType in [atPart, atParts, atReference, atReferences] then
ObjectClassName := FRef.ClassName;
end;
end;
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
Added Paths:
-----------
trunk/Source/Core/InstantRttiAttributes.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-12-21 04:52:06 UTC (rev 879)
+++ trunk/Source/Core/InstantPersistence.pas 2009-12-21 09:13:48 UTC (rev 880)
@@ -1610,6 +1610,9 @@
{$ELSE}
Mask,
{$ENDIF}
+{$IFDEF D14+}
+ RTTI, InstantRttiAttributes,
+{$ENDIF}
InstantUtils, {InstantRtti, }InstantDesignHook, InstantCode;
var
@@ -2440,7 +2443,48 @@
end;
procedure TInstantAttribute.Initialize;
+
+{$IFDEF D14+}
+ procedure InitializeRttiAttributes;
+
+ procedure InvokeRttiAttribute(RttiMember: TRttiMember);
+ var
+ CustomAttribute: TCustomAttribute;
+ begin
+ for CustomAttribute in RttiMember.GetAttributes do
+ if CustomAttribute is TInstantRttiAttribute then
+ TInstantRttiAttribute(CustomAttribute).Change(Self, RttiMember);
+ end;
+
+ var
+ RttiContext: TRttiContext;
+ RttiType: TRttiType;
+ RttiField: TRttiField;
+ RttiMethod: TRttiMethod;
+ RttiProperty: TRttiProperty;
+ begin
+ RttiContext := TRttiContext.Create;
+ try
+ RttiType := RttiContext.GetType(Self.ClassType);
+
+ for RttiField in RttiType.GetFields do
+ InvokeRttiAttribute(RttiField);
+
+ for RttiMethod in RttiType.GetMethods do
+ InvokeRttiAttribute(RttiMethod);
+
+ for RttiProperty in RttiType.GetProperties do
+ InvokeRttiAttribute(RttiProperty);
+ finally
+ RttiContext.Free
+ end;
+ end;
+{$ENDIF}
+
begin
+{$IFDEF D14+}
+ InitializeRttiAttributes;
+{$ENDIF}
end;
procedure TInstantAttribute.ReadName(Reader: TInstantReader);
Added: trunk/Source/Core/InstantRttiAttributes.pas
===================================================================
--- trunk/Source/Core/InstantRttiAttributes.pas (rev 0)
+++ trunk/Source/Core/InstantRttiAttributes.pas 2009-12-21 09:13:48 UTC (rev 880)
@@ -0,0 +1,94 @@
+(*
+ * InstantObjects
+ * Delphi 2010 Custom Attributes framework
+ *)
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is: Brian Andersen
+ *
+ * The Initial Developer of the Original Code is: Seleqt
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2001-2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * Brian Andersen
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantRttiAttributes;
+
+interface
+
+uses
+ InstantPersistence, Rtti;
+
+type
+ TInstantRttiAttribute = class(TCustomAttribute)
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); virtual; abstract;
+ end;
+
+ TInstantRttiAttributeClass = class of TInstantRttiAttribute;
+
+ TInstantRttiFieldAttribute = class(TInstantRttiAttribute)
+ protected
+ procedure InternalChange(AObject: TInstantObject; AField: TRttiField); virtual; abstract;
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); override;
+ end;
+
+ TInstantRttiMethodAttribute = class(TInstantRttiAttribute)
+ protected
+ procedure InternalChange(AObject: TInstantObject; AMethod: TRttiMethod); virtual; abstract;
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); override;
+ end;
+
+ TInstantRttiPropertyAttribute = class(TInstantRttiAttribute)
+ protected
+ procedure InternalChange(AObject: TInstantObject; AProperty: TRttiProperty); virtual; abstract;
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); override;
+ end;
+
+
+implementation
+
+{ TInstantRttiFieldAttribute }
+
+procedure TInstantRttiFieldAttribute.Change(AObject: TInstantObject;
+ AMember: TRttiMember);
+begin
+ InternalChange(AObject, AMember as TRttiField);
+end;
+
+{ TInstantRttiMethodAttribute }
+
+procedure TInstantRttiMethodAttribute.Change(AObject: TInstantObject;
+ AMember: TRttiMember);
+begin
+ InternalChange(AObject, AMember as TRttiMethod);
+end;
+
+{ TInstantRttiPropertyAttribute }
+
+procedure TInstantRttiPropertyAttribute.Change(AObject: TInstantObject;
+ AMember: TRttiMember);
+begin
+ InternalChange(AObject, AMember as TRttiProperty);
+end;
+
+end.
\ No newline at end of file
Property changes on: trunk/Source/Core/InstantRttiAttributes.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
|
