tiofp documentation - building an abstract bom with the composite pattern.htm

tiOPF 面向对象的数据库持久层持久层开发的框架

  // Create a string list to hold the published property names
  lsl := TStringList.Create ;
  try
    // Populate the string list with the published property names
    tiGetPropertyNames( self, lsl, ctkSimple ) ;
    // Scan the list of property names
    for i := 0 to lsl.Count - 1 do
    // Call the SetPropValue and GetPropValue methods found in
    // Delphi 5's TypInfo.pas
    SetPropValue( Self,
    lsl.Strings[i],
    GetPropValue( Source, lsl.Strings[i] )) ;
  finally
    // Clean up
    lsl.Free ;
  end ;
end;</PRE>
<P>The last change we must make to assign is to change its signature from 
Assign( Source : TPersistent ) to Assign( Source : TPerObjAbs ). This appears 
easy enough to do like this:</P><PRE>TPerObjAbs = class( TVisited )
public
  procedure Assign( Source : TPerObjAbs ) ; override ;
end ;</PRE>
<P>but we get the compile time error:</P>
<P><IMG height=76 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image001_0012.gif" 
width=531> </P>
<P>If we remove the override directive like this:</P><PRE>TPerObjAbs = class( TVisited )
public
  procedure Assign( Source : TPerObjAbs ) ; 
end ;</PRE>
<P>then we get this compiler warning:</P>
<P><IMG height=62 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image001_0013.gif" 
width=531> </P>
<P>The solution is to use the reintroduce directive like this:</P><PRE>TPerObjAbs = class( TVisited )
public
  procedure Assign( Source : TPerObjAbs ) ; reintroduce ;
end ;</PRE>
<P>Re-declaring a method to change its signature by using reintroduce to hide 
the compiler warning has some side effects. The Delphi help tells this about 
overriding versus hiding:</P>
<P>If a method declaration specifies the same method identifier and parameter 
signature as an inherited method, but doesn’t include override, the new 
declaration merely hides the inherited one without overriding it. Both methods 
exist in the descendant class, where the method name is statically bound. For 
example:</P><PRE>type
  T1 = class(TObject)
    procedure Act; virtual;
  end;
  T2 = class(T1)
    procedure Act; // Act is redeclared, but not overridden
 end;
 
var
  SomeObject: T1;
begin
  SomeObject := T2.Create;
  SomeObject.Act; // calls T1.Act
end;</PRE>
<P>So we can safely do this:</P><PRE>type
  TPerObjAbs = class( TVisited )
  public
    procedure Assign( Source : TPerObjAbs ) ; reintroduce ;
  end ;
<PRE>TMyClass = class( TPerObjAbs ) ;
var
  lObj1 : TPerObjAbs ;
  lObj2 : TPerObjAbs ;
begin
  lObj1 := TMyClass.Create ;
  lObj2 := TMyClass.Create ;
  lObj1.Assign( lObj2 ) ; // This will call Assign on TPerObjAbs as expected
end ;</PRE>
<P>which is exactly what we do in the framework.</P>
<P>Early on, I was seduced by the idea of redeclaring Clone and Assign in the concrete classes so I did not have to type cast them when I was using these classes in applications. My mistake was to do this:</P>
<PRE>TMyClass = class( TPerObjAbs )
public
  procedure Assign( Source : TMyClass ) ; reintroduce ;
  functinon Clone : TMyClass ; reintroduce ;
end ;</PRE>
<P>As we will see in the next section, there are times when Assign has to be overriden to implement special behaviour to handle class type properties. In the framework, I have a generic edit dialog that takes an instance of TPerObjAbs as a parameter, makes a clone, lets the user edit the clone, then Assigns the buffer back to the original object. Calling TPerObjAbs.Assign caused the wrong assign to be executed. This was a silly mistake to make but it still took me ages to debug and then understand. So, we can safely change the signature of Assign when subclassing from TPersistent to TVisited to TPerObjAbs, but we cant change the signature of Assign from this level down.</P>
<H2>Implementing a generic clone method</H2>
<P>Now that we have introduced a generic Assign method, we can have a shot at writing a generic Clone method that will return a copy of the object being cloned. We shall use the same test stub code for evaluating Clone as we did for Assign, except that the call to Assign:</P>
<PRE>// Create another instance of TAdrs for copying to
lAdrsTo := TAdrs.Create ;
// Perform the Assign
lAdrsTo.Assign( lAdrsFrom ) ;</PRE>
<P>will be replaced with a call to clone like this:</P>
<PRE>// Create another instance of TAdrs by calling clone
lAdrsTo := TAdrs( lAdrsFrom.Clone ) ;</PRE>
<P>Notice that we have to type cast the result of Clone to TAdrs in the client code as we can't override Clone in the concrete class. The code that is implemented in Clone looks like this:</P>
<PRE>function TPerObjAbs.Clone: TPerObjAbs;
var
  lClass : TPerObjAbsClass ;
begin
  lClass := TPerObjAbsClass( ClassType ) ;
  result := TPerObjAbs( lClass.Create );
  result.Assign( self ) ;
end;</PRE>
<P>The beauty of this code is that it will generically clone whatever class it is called on. It will also ensure that any code in the concrete classes Create method is called. We can test this code and find that it will work reliably as long as we have correctly implemented Assign on concrete classes that contain object properties.</P>
<H2>The problem with assigning object type properties</H2>
<P>Implementing Assign on a class that contains object type properties like TPeople with its properties AdrsList : TAdrsList and EAdrsList : TEAdrsList requires a little more thought. There are times when we will want Assign clone any classes that it owns. This is required for our TPerson class where the TPerson owns the addresses and EAddresses. If the TPerson where associated with another object by a mapping type relationship, rather that an ownership type relationship, we would probably want to copy pointers rather that clone objects. This is summarised below:</P>
<P>&#8226; Clone owned objects: This is useful when one class owns an instance of another, for example the TPerson class owns instances of TAdrsList and TEAdrsList, therefore it is logical to clone these classes when cloning the TPerson class. The implementation of Clone to achieve this is shown below:</P>
<PRE>procedure TPerson.Clone(pSource: TPerObjAbs);
begin
  FEAdrsList := TPerson( pSource ).EAdrsList.Clone;
  FAdrsList := TPerson( pSource).AdrsList.Clone;
end;</PRE>
<P>&#8226; Copy pointers: This is done when one class has a reference to another class, for example many classes may have references to the shared class. This may happen when you have a TSex object which can either be Male, Female or Unknown. It is possible that an application would have a single instance of a list of TSex objects that are shared among TPerson instances. This could be implemented like this:</P>
<PRE>// We have a list of TSex objects that is shared between instances of TPerson(s)
TSex = class( TPerObjAbs )
published
  property TextShort : string read FTextShort write FTextShort ; // 'M', 'F', etc
  property TextLong : string read FTextLong write FTextLong ; // 'Male', 'Female'
end ;</PRE>
<P>Each TPerson has a pointer to one of the shared TSex objects like this:</P>
<PRE>TPerson = class( TPerObjAbs )
public
  procedure Assign( Source : TPerObjAbs ) ;
published
  property Sex : TSex read FSex write FSex ;
end ;</PRE>
<P>The assign method would be implemented by copying the pointer to the shard TSex object, not by creating a new owned instance of TSex.</P>
<PRE>procedure TPerson.Assign( Source : TPerObjAbs ) ;
begin
  inherited Assign( Source ) ;
  FSex := TPerson( Source ).Sex ;
end ;</PRE>
<P>The challenge is to find an elegant way of implementing these two cases and this is discussed next.</P>
<H2>How to assign object propety types</H2>
<P>The properties that a TPerObjAbs descendant can have will fall into one of three categories:</P>
<P>1. Public properties like OID and ObjectState</P>
<P>2. Published 'Flat' properties with data types like String, Integer, Real, TDateTime or Boolean. These can be copied from one instance of an object to another by using the generic RTTI Assign method we looked at earlier.</P>
<P>3. Class type properties that can be cloned or assigned by either copying a pointer to a shared instanced, or by cloning the class property and creating another instance.</P>
<P>The first step is to refactor the TPerObjAbs class (using the Template Method pattern as a basis) and break Assign up into three steps: AssignPublicProps, AssignPublishedProps and AssignClassProps, with Assign calling the three methods in sequence. This lets us override just the AssignClassProps in any concrete classes that that have object type properties. The new interface of TPerObjAbs is shown below:</P>
<PRE>TPerObjAbs = class( TVisited )
protected
  procedure AssignPublicProps(pSource: TPerObjAbs);
  procedure AssignPublishedProps(pSource: TPerObjAbs; pPropFilter: TTypeKinds = [] );
  // You must override this in the concrete if there are class properties
  procedure AssignClassProps(pSource: TPerObjAbs); virtual ;
public
  procedure Assign( pSource : TPerObjAbs ) ; reintroduce ;
end ;</PRE>
<P>And the implementation of Assign, inspired by the Template Method pattern is shown next:</P>
<PRE>procedure TPerObjAbs.Assign(pSource: TPerObjAbs);
begin
  AssignPublicProps( pSource ) ;
  AssignPublishedProps( pSource ) ;
  AssignClassProps( pSource ) ;
  // When you create a concrete class that contains object type properties
  // you will have to override AssignClassProps( ) and implement
  // the necessary behaviour to copy pointers or create new instances
  // of these properties.
end;</PRE>
<P>First of all, Assign calls AssignPublicProps which is simple to implement by hard coding the mapping of properties to the current object (self) from the one being passed as a parameter (pSource) and this is shown below:</P>
<PRE>procedure TPerObjAbs.AssignPublicProps(pSource: TPerObjAbs);
begin
  OID := pSource.OID ;
  ObjectState := pSource.ObjectState ;
  Owner := pSource.Owner ;
end;</PRE>
<P>Next, Assign calls AssignPublishedProps, which is a generic routine that copies all 'flat' or 'simple' property types. We developed this code earlier in the section on implementing a generic Assign method.</P>
<P>Finally, Assign calls AssignClassProps, which contains some code to raise an exception in the abstract class. This will remind the developer of the concrete class that he has forgotten to implement the custom AssignClassProps as required. The implementation of AssignClassProps that can be found in TPerObjAbs looks like this:</P>
<PRE>procedure TPerObjAbs.AssignClassProps(pSource: TPerObjAbs);
begin
  Assert( CountPropsByType( pSource, [tkClass] ) = 0,
    'Trying to call ' + ClassName + '.Assign( ) on a class that contains ' +
    'object type properties. AssignClassProps( ) must be overridden in the ‘ +
    'concrete class.' ) ;
end;</PRE>
<P>This reminds us that we have to copy pointers, or clone objects in the concrete class like this:</P>
<PRE>procedure TPerson.AssignClassProps(pSource: TPerObjAbs);
begin
  FEAdrsList.Assign( TPerson( pSource ).EAdrsList ) ;
  FAdrsList.Assign( TPerson( pSource ).AdrsList ) ;
end;</PRE>
<P>In TPerson.AssingClassProps, we want to clone the objects, not copy pointers. TPerson creates an owned instance of both TEAdrsList and TAdrsList in its constructor so we do not have to call clone in AssignClassProps. Calling FEAdrsList.Assign( ) has the same effect as calling FEAdrsList := pSource.Clone here, except that it avoids the possibility of a memory leak.</P>
<P>This ends our discussion on how to assign and clone objects. An example of this in use can be found in the address book application that comes with the tiOPF source code. Next we will look at three helper methods which we use on the TPerObjList and TPerObjAbs to iterate without creating a TVisitor, or to help search for an object with certain properties.</P>
<H2>Iterating without creating a TVisitor with ForEach( )</H2>
<P>We have seen how to user a TVisitor descendent to iterate over all the nodes in a hierarchy of objects that is constructed based on GoF’s Composite Pattern. This can be very convenient if you know you want to touch all the objects in a hierarchy, but sometimes the programmer knows he only wants to iterate over the objects in a certain list, and is not interested in touching child objects. This is where a ForEach method becomes useful. For example, say we want to extend our business object model so the TPerson class has an Salary property, and the TPeople class knows how to increase the salary by say, 10% for all the people in the list. The modified interface of TPerson and TPeople might look like this:</P>
<PRE>TPeople = class( TPerObjList )
published
  procedure IncreaseSalary ;
end ;

TPerson = class( TPerObjAbs )
private
  FSalary : real ;
published
  property Salary : real read FSalary write FSalary ;
end ;</PRE>
<P>and the implementation of TPeople.IncreaseSalary looks like this:</P>
<PRE>procedure TPeople.IncreaseSalary;
var
  i : integer ;
begin
  for i := 0 to Count - 1 do
  TPerson( Items[i] ).Salary := TPerson( Items[i] ).Salary * 1.1 ;
end;</PRE>
<P>There are two things I don'like about this code:</P>
<OL>
  <LI>1. We have to manually iterate over the owned objects; and
  <LI>2. We have to type cast each Items[i] call as a TPerson.
</LI></OL>
<P>We discussed the problem of having to manually iterate over the elements in a list in chapter #2 ‘The Visitor Framework’ and went to some lengths to understand how to use the Visitor pattern to generically solve this problem. Along the way though, we looked at passing a method pointer to each element in the collection. We shall revisit this approach here as it is simpler to code than the Visitor when we only want to touch the elements in a single list. The Visitor pattern helps us maintain state information as we move from one object to another and as state information is not important here, the method pointer approach shall be ideal.</P>
<P>As discussed in chapter #2, we move the for i := 0 to Count logic into a method on the TPerObjList class and have the specialist business logic in one of the concrete classes. The TPerObjList.ForEach method is shown below:</P>
<PRE>procedure TPerObjList.ForEach(pMethod: TPerObjAbsMethod);
var
  i : integer ;
begin
  for i := 0 to Count - 1 do
    pMethod( Items[i] ) ;
end;</PRE>
<P>and the modified TPeople class with its two procedures IncreaseSalay, which is public and can be called by a client application, and DoIncreaseSalary which is private and gets called by IncreaseSalary.</P>
<PRE>TPeople = class( TPerObjList )
private
  procedure DoIncreaseSalary( pData : TPerObjAbs ) ;
published
  procedure IncreaseSalary ;
end ;</PRE>
<P>DoIncreaseSalary contains the code to perform the calculation:/p&gt;
<PRE>procedure TPeople.DoIncreaseSalary(pData: TPerObjAbs);
begin
  TPerson( pData ).Salary := TPerson( pData ).Salary * 1.1 ;
end;</PRE>
<P>And IncreaseSalary contains a call to ForEach with DoIncreaseSalary being passed as a parameter.</P>
<PRE>procedure TPeople.IncreaseSalary;
begin
  ForEach( DoIncreaseSalary ) ;
end;</PRE>
<P>This might look like an unnecessarily complex way of achieving something that can be done with a For i := 0 to Count - 1 loop, and for this example it probably is. The ForEach method becomes really useful when you want perform more complex logic on significantly more complex object models of nested objects.</P>
<P>The other problem this example highlighted is the need to typecast each call to Items[I] to a TPerson before we could access any methods that are found in TPerson but not in TPerObjAbs.</P>
<P>Type casting Items[i] in the concrete class</P>
<P>Sup