Decorating With This Access

(Updated: 2006.12.05 10:40:30 AM)

Edit -Find- Recent Changes Categories Road Map [A-F] [G-P] [Q-Z] New Topic Home

Category 3 Star Topics

Consider how easy it is to create a universal decorator in VFP

*=====================================
DEFINE CLASS Decorator AS Relation
*=====================================
  oDecorated= .NULL.

  FUNCTION INIT( toDecorated)
  THIS.oDecorated = toDecorated


  FUNCTION THIS_ACCESS( tcMember)
  IF PEMSTATUS(THIS,UPPER(tcMember),5)
    RETURN THIS
  ELSE
    RETURN THIS.oDecorated
  ENDIF
  ENDFUNC

  FUNCTION DESTROY()
  This.oDecorated = .null.
ENDDEFINE

Category VFP Bugs since this is broken in VFP 7 and VFP 8, including VFP 8 SP1. See __ Decorating With This Access. -- Steven Black

All this now works in VFP 9.

"One of the difficulties of managing a decorator is maintaining its interface in sync with the objects to be decorated." -- Steven Black

(See below for how to easily solve this difficulty)
For example, to use the examples from Steven Black 's excellent write up on the Decorator Pattern in VFP, consider the following abstract class.

*=====================================
DEFINE CLASS AbstractFrog AS CUSTOM
*=====================================
  cBestFriend = ''
  cColor      = ''
  DIMENSION aFriends[2]

  FUNCTION Jump(nValue)
  FUNCTION Eat()

ENDDEFINE

From which we can derive the real thing:

*=====================================
DEFINE CLASS ConcreteFrog AS AbstractFrog
*=====================================

  FUNCTION Jump(nValue)
  	Wait Window "Frog Jumping "+ALLTRIM(STR(nValue))+" feet."

  FUNCTION Eat()
  	Wait Window "Frog Eating"

ENDDEFINE

And, as mentioned in Steve's writeup, the Abstract class makes a good basis for the decorator since the interface will be inherited by the decorator automatically.

*=====================================
DEFINE CLASS DecoFrog AS AbstractFrog
*=====================================
  oRealFrog = .NULL.

  FUNCTION INIT( oFrog)
  THIS.oRealFrog = oFrog

  FUNCTION DESTROY()
  This.oRealFrog = .null.

ENDDEFINE

However, inheriting the interface is only half the work. The pass-through to the decorated object must be wired as needed. So, our DecoFrog class might look like this in the end.

*=====================================
DEFINE CLASS DecoFrog AS AbstractFrog
*=====================================
  oRealFrog= .NULL.

  FUNCTION INIT( oFrog)
  THIS.oRealFrog = oFrog

  FUNCTION Jump(n)
  THIS.oRealFrog.Jump(n)

  FUNCTION Eat()
  THIS.oRealFrog.Eat()

  FUNCTION  DESTROY()
  This.oRealFrog = .null.

ENDDEFINE

Note the properties are not wired as yet, this could be done via _ACCESS and _ASSIGN methods in the DecoFrog class, or by implementing "get" and "set" methods in the Frog class for each property, and rigging the requisite pass-through functions in the DecoFrog class as I have done here with Jump and Eat.

Either way, there is work to be done in maintaining the Decorator so that it properly wraps the Decorated.

But, VFP 6 gives us a cool method in THIS_ACCESS.

From the MSDN docs: (emphasis mine)

A THIS_ACCESS method is created in code within a DEFINE CLASS command, or in the New Method or Edit Properties dialog boxes for .vcx visual class libraries. A THIS_ACCESS method must always return an object reference, otherwise an error is generated. The THIS object reference is typically returned. A THIS_ACCESS method must also include a parameter to accept the name of the member of the object that is changed or queried.

Given this, and an educated guess about how THIS_ACCESS works, the following alternative decorator seems like a reasonably cheap lunch.

*=====================================
DEFINE CLASS LC_DecoFrog AS CUSTOM
*=====================================
  oRealFrog= .NULL.

  FUNCTION INIT( oFrog)
  THIS.oRealFrog = oFrog

  FUNCTION THIS_ACCESS( tcMember)
	
	IF PEMSTATUS(THIS,UPPER(tcMember),5)
		RETURN THIS
	ELSE
		RETURN THIS.oRealFrog
	ENDIF
  ENDFUNC

  FUNCTION  DESTROY()
  This.oRealFrog = .null.

ENDDEFINE

Or, more generally:

*=====================================
DEFINE CLASS Decorator AS CUSTOM
*=====================================
  oDecorated= .NULL.

  FUNCTION INIT( toDecorated)
  THIS.oDecorated = toDecorated

  FUNCTION THIS_ACCESS( tcMember)
	
	IF PEMSTATUS(THIS,UPPER(tcMember),5)
		RETURN THIS
	ELSE
		RETURN THIS.oDecorated
	ENDIF
  ENDFUNC

  FUNCTION DESTROY()
  This.oDecorated = .null.
ENDDEFINE

Thus, one can wrap pretty much anything. CUSTOM might not be the best baseclass, RELATION might be better, whatever, build to suit. - ?lc

First, note the LC_DecoFrog is not based on AbstractFrog. But, THIS_ACCESS will pipe any requests for members not defined in LC_DecoFrog over to the wrapped object. Essentially, the THIS_ACCESS function is doing all the wrapping for us at the cost of a PEMSTATUS() each time the object is hit (thus the lunch is not quite free).

Let's extend a bit, to make this worthwhile:

*=====================================
DEFINE CLASS DancingFrog AS LC_DecoFrog
*=====================================

  FUNCTION Dance()
  	This.Jump(+2)
  	This.Jump(-2)
  	This.Jump(+3)
  	
ENDDEFINE

Then consider the following code:

oFrog = CREATEOBJECT("ConcreteFrog")
oDancingFrog = CREATE("DancingFrog",oFrog)
oDancingFrog.cColor = "GREEN"
oDancingFrog.Jump(5)
oDancingFrog.Eat()
oDancingFrog.aFriends[1] = "ELMO"

oDancingFrog.aFriends[2] = "GONZO"
oDancingFrog.cBestFriend = "MISS PIGGY"
oDancingFrog.Dance()

The array propery was included to because I wasn't sure it would work, but everything in the code above seems to function just fine.

I've not seen this idea written up before, so I thought I'd submit it here for comment. -- lc

This looks like a much more sucessful use of this_access than my attempt. I was trying to create a container(textbox+button) thing that would pass all of the calls to the container through to the textbox. It didn't work very well, but for reasonable reasons, like the container's methods that referenced This got redirected to the textbox, etc. Once I was done fiddling, I realized that my approach was not too well thought out.

But this looks really nice. -- CFK

This is a really sweet implementation! ~~But I believe CFK raises a definite potential difficulty.~~ What I at first thought was a difficulty really isn't too hard to work out (it may even be obvious to some, but it wasn't to me at first): If you need to, in the decorator class, override a property or method of the decorated class, just name it the same thing. Anytime outside the decorator class that the property/method is referred to, the decorator class's member gets accessed. It is impossible, even inside the decorator to get to the wrapped class's property/method using THIS.whatever ... However, OF COURSE the decorator can just refer to the decorated class BY NAME; ie. THIS.oRealFrog.Whatever ... It is a Truly Elegant implementation for Decorator Pattern! -- ?wgcs
Not sure what you mean by "...It is impossible, even inside the decorator to get to the wrapped class's property/method using THIS.whatever..." isn't that what's happening in the Dance method above? Jump is a member of oRealFrog, but the DancingFrog class gets to refer to it via THIS.JUMP , what you can't do is have a Jump() method on the decorator and expect to get to the wrapped class's Jump() unless you get explicit with this.oRealFrog.Jump() Ahh.. maybe that's what you mean. {s} In this case, the explicit call to This.oRealFrog.Jump() would sort of take the place of a DODEFAULT() call in a regular subclass. -
- ?lc
Yes! That is what I mean: It hit me in a similar way... it seemed like a gotcha at first, but then it dawned on me how elegant it is... nothing's missing. I thought it might lurk as an uncertain unconcious averance in other's minds, where they aren't sure why they don't trust it, so I wanted to point out how, really, nothing's missing! -- wgcs

I must admit to having a bit of worry that this would actually work in practice, but yesterday I tore into a decorator I had been using to wrap a generic data access class (in this case, adding HTML services). The result: about 60 lines of pass-through code (and the ongoing maintenance of same) gone and no noticable performance hit. At this point I'm pretty happy with it, but I'm sure there are some "gotcha's" lurking... One thing, it occurs to me that some interesting things could be done by basing your decorator on something useful (rather than some base class like CUSTOM). Also, consider some more logic in the THIS_ACCESS (CASE statement?) that delegates to one of possibly many member objects... Probably too much of a good thing... I don't really know what multiple inheritance is, but wouldn't that be a close approximation? - lc

Here's a perfect use for this generic decorator class: SCATTER NAME objects! These objects created by the SCATTER NAME command aren't "normal" VFP objects, that is, they don't have Add Property(), Class, Parent Class, Base Class, etc. members, and (because of the missing Add Property() ) they can't easily have more information attached to them without wrapping them, so here's my RecordDecorator class (based on the standard "Decorator" class above):

DEFINE CLASS RecordDecorator AS Session
  DataSession = 1 && Default
  oRecord = .NULL.

  PROCEDURE Scatter
    SCATTER NAME THIS.oRecord
  ENDPROC
  PROCEDURE Gather
    GATHER NAME THIS.oRecord
  ENDPROC

  FUNCTION THIS_ACCESS( tcMember)
    IF PEMSTATUS(THIS,UPPER(tcMember),5)
      RETURN THIS
    ELSE
      RETURN THIS.oRecord
	ENDIF
  ENDFUNC

  FUNCTION DESTROY()
    This.oRecord = .null.
  ENDFUNC
ENDDEFINE

Some ideas on how to use this is to subclass it and add access or assignment methods to produce calculated values based on the data of the record, or to split up a complicated value (string) into its atomic data pieces. (I created a Description method that takes the data from my record and formulates it into a human-readable description to put into a listbox). With Poly Morphism you can make similar decorators that decorate dissimiar records, yet all have a "Description" method and can be listed in the same listbox with no adjustment to the List Box's "FillList" method (or whatever you want to call it). -- wgcs

New development: Apparently and object reference in an Array stores the value for "THIS" and doesn't call THIS_ACCESS when trying to dereference the object. For example, using the RecordDecorator above:


USE myTable && Assume this has a MEMO field called MemoField
oRec = CREATEOBJECT('RecordDecorator')
oRec.Scatter
WAIT WINDOW oRec.MemoField  && This works fine!

DIMENSION myArr[3]
myArr[1] = CREATEOBJECT('RecordDecorator')
myArr[1].Scatter
WAIT WINDOW myArr[1].MemoField  && This fails with "Property 'MemoField' is not found"
oRec2 = myArr[1]
WAIT WINDOW oRec2.MemoField  && This works fine!

A little inconsistant, but at least there's a workaround. - ?wgcs

I just ran into this again: Very Irritating! THIS_ACCESS is not called when Dereferencing the object in the array.

Given the "standard" decorator class you've provided, i can easely achive multi-inheritence ^_^
So .. give your thought to this:

*=====================================
DEFINE CLASS Decorator AS Relation
*=====================================
  oDecorated[1]= .NULL.
  nDeco=0
  c_accessed=""    && i added this just in case you need to know wich class was accessed last :)
  *-
  FUNCTION INIT( toDecorated)
    THIS.oDecorated[1] = toDecorated
    THIS.nDeco=1
  ENDFUNC
  *-
  FUNCTION Add_Decorated( toDecorated)
    THIS.nDeco=THIS.nDeco+1
    DIMENSION THIS.oDecorated[ THIS.nDeco]
    THIS.oDecorated[ THIS.nDeco]= toDecorated
  ENDFUNC
  *-
  FUNCTION THIS_ACCESS( tcMember)
    IF PEMSTATUS(THIS,UPPER(tcMember),5)
      THIS.c_accessed = THIS.class
      RETURN THIS
    ELSE
      LOCAL i, ox
      FOR i=1 TO THIS.nDeco
        ox=THIS.oDecorated[ i]    && there are some isues with arrays ref
        IF PEMSTATUS(ox,UPPER(tcMember),5)
           THIS.c_accessed = THIS.oDecorated.class
           RETURN THIS.oDecorated
        ENDIF
    ENDIF
  ENDFUNC
  *-
  FUNCTION DESTROY()
    LOCAL i
    FOR i=1 TO THIS.nDeco
      This.oDecorated[ i] = .null.
    ENDFOR
  ENDFUNC
ENDDEFINE

now, consider having two classes "piggy" and "ugly_duck"

oCritter = CreateObject("Decorator",CreateObject("piggy"))
oCritter.Add_Decorated("ugly_duck")
oCritter.fly()        && Hey look! Pigs can fly :)
*-
oCritter.Add_Decorated("DancingFrog")
oCritter.Dance()      && i don't know how on earth can it fly and dance at the same time, but look at him ;)

On the other hand you have to be careful to the order of adding decorated items, to exclude confusion regarding same-name properties and/or methods. But that's the closest to multi-inheritance i can imagine.
- ?edyshor

Very impressive, but is this just an academic discussion of a VFP implementation of decoration, or is it actually useful in real-world VFP? -- Alan Bourke

Good question. Personally, I keep this in my "quick and dirty" tool box. If I identify that a decorator pattern is likely to be the best solution to a given problem, I'll often take this approach as a first pass at getting tests to pass. Then, later on, I may refactor into a more traditional approach to gain some performance and avoid some of the minor debugging hassles that come with THIS_ACCESS approaches. Mainly, it really helps cut down on the interface maintenance while development progresses. - ?lc

08/08/2006 - The proposed THIS_ACCESS method doesn't work for me beyond the second level deep in VFP 6+SP5. I've reworked it like this and now there is no depth limit:

FUNCTION THIS_ACCESS
   LPARAMETERS cMember

   LOCAL loDecorated
   loDecorated = THIS
   DO WHILE NOT ISNULL(loDecorated)
      IF PEMSTATUS(loDecorated, UPPER(m.cMember), 5)
         RETURN loDecorated
      ELSE
         loDecorated = loDecorated.oDecorated
      ENDIF
   ENDDO
   RETURN THIS
ENDFUNC

Fernando D Bozzo

Contributors: Lauren Clarke, CFK, wgcs

Also See: Decorating for the Busy Developer

Category Design Patterns, Category Code Samples

Edit -Find- Recent Changes Categories Road Map [A-F] [G-P] [Q-Z] New Topic Home

http://fox.wikis.com - a low-impedance, fat-free Visual Foxpro site.

- 2010.02.09 10:11:26 AM EST