Version: 2.00.00 - last update: Friday, March 28, 2014, 2:48:00
This is about a useful, generic protection scheme you may want to add to your Base Classes.
Intro
Encapsulating data is one of the basics of OOP design. Protecting a property is called information hiding. Sometimes we do not want data to be totally hidden but accessible without loosing control over its integrity. That's the point when read-only properties come into play. There is no mystery about how to write protect a property in VFP. Just add an _Assign() method to it and you're almost done… unless you have to grant write access for an elected set of other objects, also called Friends.
Once upon a time…
… I started trying something like this:
Define Class MySpecialOne As Custom yResult = $0.0000 Protected Procedure yResult_Assign Lparameters tyResult As Currency Error 1740, "yResult" && "name" is a read-only property Endproc Enddefine
Apparently too much of a good thing. Now, the property value couldn't be changed at all. After that first try I changed my class design to use a protected property. But then, read access was lost for all other external class instances. What a mess, I had to add Getter/Setter functions accordingly to solve that:
Define Class MySpecialThree As Custom Protected yResult yResult = $0.0000 Protected Procedure Set_yResult Lparameters tyResult As Currency *\\ A typical private Setter This.yResult = m.tyResult Endproc Function Get_yResult() As Currency *\\ A typical public getter Return This.yResult Endproc Enddefine
At that point, because VFP doesn't support the uniform access principle, my modification broke the inner workings of my application because I changed the interface of one class without reflecting that all over the place.
A Better Approach(?)
Finally, I returned to my unprotected property. This time, I created a protected flag variable in my class that had to be set before assigning a new value to my yResult property to signal write access granted:
Define Class MySpecialFour As Custom yResult = $0.0000 Protected lWriteGranted lWriteGranted = .F. Protected Procedure yResult_Assign Lparameters tyResult As Currency If Not This.lWriteGranted Error 1740, "yResult" && "name" is a read-only property Else This.yResult = m.tyResult Endif Endproc Procedure CalculateWhatEver() As Void *\\ Do some wild things here... *\\ ... then store result This.lWriteGranted = .T. This.yResult = m.lyLocalValue *\\ Never forget to reset flag! This.lWriteGranted = .F. Endproc Enddefine
This approach worked better, but there were three drawbacks: You had to write 2 additional lines of code (point one and two:-) and, if you forgot to reset the flag property at the end of your processing the whole write protection scheme rendered useless (point three). At least, the code had little impact on performance.
Refinement
After a while I came up with the following neat solution to solve all of the above problems.
Define Class MySpecialFive As Custom yResult = $0.0000 Protected lWriteGranted lWriteGranted = .F. Protected Procedure yResult_Assign Lparameters tyResult As Currency; , tlInternal As Boolean If Not (This.lWriteGranted Or m.tlInternal) Error 1740, "yResult" && "name" is a read-only property Else This.lWriteGranted = m.tlInternal This.yResult = m.tyResult Endif Endproc Procedure CalculateWhatEver() As Void *\\ Do some wild things again... *\\ ... then store result This.yResult_Assign(m.lyLocalValue, .T.) *// Endproc Enddefine
I must admit, I liked that solution, because it reduced the value assignment code down to one line again.
In fact, the code works well but takes twice as long to complete (no lunch for free)! Maybe you have to play with the class and watch the assignments in your debugger to understand what I mean. The slight performance degradation isn't noticeable on todays machines, all what remains is the clumpy assignment call. Anyway, write access can only be granted to methods of the class. All other external classes cannot write to the yResult property without additional arrangements are made for it.
Generic Getters/Setters
One way to jump over that hurdle is to create a pair of generic methods like shown below. We also have to create one additional security property in our classes to hold our 'grant access token'. In the class MyBaseCustom below it is called eSecToken and may hold any kind of value you might consider useful.
Define Class MyBaseCustom As Custom *\\ test properties Dimension aTest[1,2] cTest = "Hello World" *\\ class access security token Protected eSecToken eSecToken = "Secret" *// Procedure SetValue Lparameters tcName As String; , teValue As Variant@; , teSecToken As Variant If Not This.eSecToken == m.teSecToken *\\ This.eSecToken holds class-global security *\\ token granting write access Error "Security token wrong or missing" *// Else *\\ Write access granted tcName = Alltrim(Transform(m.tcName)) If Not (Pemstatus(This, m.tcName, 5) And ; PemStatus(This, m.tcName,3) == "Property") Error "Property not found" Else If Type("This." + m.tcName, 1) == "A" And; Type("m.teValue", 1) == "A" *\\ array -> array handling Dimension ("This."+m.tcName+"[1]") Local lcTmp As String lcTmp = "This."+m.tcName *\\ I do HATE macro substitution! But in *\\ this case we have to use it! Acopy(teValue, &lcTmp.) Else *\\ all other (scalar) teValue handling Store teValue To ("This."+m.tcName) Endif Endif Endif Endproc Function GetValue Lparameters tcName As String; , teSecToken As Variant; , tnResult As Integer@ && in/out tnResult = 0 && := scalar value will be returned Local leRetVal As Variant; && scalar return value , llSilent As Integer && no parameter errors leRetVal = .Null. llSilent = Pcount() > 2 If Not This.eSecToken == m.teSecToken *\\ The .eSecToken property holds class-global *\\ security token granting write access tnResult = -1 && error If Not m.llSilent Error "Security token wrong or missing" Endif *// Else *\\ Read access granted tcName = Alltrim(Transform(m.tcName)) If Type("This."+m.tcName)== "U" *\\ Use Type() testing because we can be asked *\\ to return a single array element, too! tnResult = -2 && := error If Not m.llSilent Error "Property not found" Endif *// Else *\\ Don't forget: VFP 9 is able to return arrays! If Pemstat(This, m.tcName, 5) And ; Type("This." + m.tcName, 1) == "A" *\\ full array was requested! Local lcTmp As String lcTmp = "This." + m.tcName tnResult = 1 && := just an info - no error! *\\ I do HATE macro substitution! But in *\\ this case we have to use it! Return @&lcTmp. && >>>>>>>>>>>>>>>>>>>>>>>>> Else *\\ property or single array element request leRetVal = Evaluate("This."+m.tcName) Endif Endif Endif *\\ at this point we will always return a non-scalar value Return m.leRetVal Endfunc Enddefine
Introducing the new GetValue() / SetValue() method pair we now have a generic, secured way to grant or revoke read/write access to our properties based upon a security token. This might be a string, a number or even an object. Our properties can be either natively PROTECTED properties, or properties decorated with an _ASSIGN() method as discussed at the beginning.
Raising an Event
I would like to show you another possible implementation of read-only properties based on VFP's Event Binding. Because Event Binding is dynamically established at runtime it can be switched On and Off at will. Let's have a peek at the demo code:
Define Class EvtBindAccess As Custom *\\ Write Protected property cTest = "sensitive content" *\\ 'Grant Access' security token TypeOf(CHAR[20]) Protected eSecTokens eSecTokens = "TeStaBChElLo123ItsME!" *// Protected Function Init() *\\ Enable 'Bypass Write Protection' by default This.ByPassSwitch("ON") *// Return .T. Endfunc Protected Procedure ByPassSwitch(tcOnOff As String) As Void If m.tcOnOff == "ON" = Bindevent(This, "cTest", This, "cTest_Enabler", 2) Else = Unbindevent(This, "cTest", This, "cTest_Enabler") Endif Endproc Protected Procedure cTest_Assign(tcTest As String) As Void *\\ wellknown write protection implementation If Vartype(m.VeryComplexAndSecretVariableName) == "U" Error 1740, "tcTest" && "name" is a read-only property Else This.cTest = m.tcTest Endif Endproc Protected Procedure cTest_Enabler(tcValue As String; , tcSecToken As Sting) As Void tcSecToken = Alltrim(Transform(m.tcSecToken)) If Len(m.tcSecToken) > 4 And ; At(m.tcSecToken, This.eSecTokens) > 0 Private VeryComplexAndSecretVariableName VeryComplexAndSecretVariableName = .T. Endif *\\ assig value This.cTest = m.tcValue *// Endproc Enddefine
There is a property called eSecTokens which holds a string (used as an array of characters) that offers 15 different security tokens each of five characters (an arbitrary length in this example). The protected method BypassSwitch() is called from object's Init() to bind the cTest_Enabler() event handler to the cTest property. Therefor, the 'bypass write protection' feature is enabled by default. Have a closer look at the event handler's signature: the cTest_Enabler() method accepts TWO parameters although it is only bound to a scalar property! If you're not sure what I'm pointing you to, go and read this post first!
Raising an event on the cTest property will raise the bound cTest_Enabler() event handler if we call it this way: RaiseEvent(m.loEvtBindAccess,"cTest","New Precious Value","TeStaB")
We pass two parameters to our cTest_Enabler() event handler. The event handler, in turn, checks the minimum security token length, and then verifies the token. If both tests pass it creates a PRIVATE (secret) variable and finally does the assignment. If the tests do not pass, no private variable is created – that's the only difference. Assigning the new value to our property raises the cTest_Assign() method which, in turn, checks if the secret variable exists…
Things to mention
If you ever read VFP's BINDEVENT help topic from start to end reflecting on each single sentence, like I did, you might wonder why I'm trying to bind to a PROTECTED method in my EvtBindAccess Class. VFP's help states:
You can bind to any valid Visual FoxPro object event, property, or method, including the Access and Assign methods. However, the event and delegate methods must be public, not protected or hidden, members of the class.
VoilĂ , we've just encountered another ambiguity in VFP's help files! You do can bind to any property of your own class from within your own class. The help file statement "must be public, not protected or hidden…" applies to external objects at runtime only!
The cTest_Assign() method that implements the write protection now looks for a variable named VeryComplexAndSecretVariableName to be defined to grant write access. This differs from all previous examples and will also be used in our final implementation…
Friends
I used the write protection scheme shown in the MySpecialFour class above a long time, until I encountered Unit-Testing. Suddenly, my herds of read-only (and protected) PEMs were no longer a proof of good OOP design only, but actively hindered my Unit-Test routines modifying object internals to successfully complete their tasks.
A Unit-Test instance is nothing else but another external object seen from the perspective of the class instance being tested. Thus, the Unit-Test instance cannot write to the tested classes' read-only properties as long as you use any of the approaches described above! The Unit-Test instance should be considered "a friend" of your class, that is, the Unit-Test object should be granted read/write access to ALL of your test classes' PEMs! And, the Unit-Test scenario is only a representative for many others sharing the same 'design problem'!
Friends Class Instances
A Friends Class Instance (let's name them Friends from now on) should be able to access otherwise locked PEMs of another Friend. The only way to get there is to use variables. Lets script a first draft:
Define Class MySpecialSix As Custom yResult = $0.0000 Procedure yResult_Assign Lparameters tyResult As Currency If Type("SECRET_FLAG") == "U" Error 1740, "yResult" && "name" is a read-only property Else This.yResult = m.tyResult Endif Endproc Procedure CalculateWhatEver() As Void *\\ Do some wild things here... *\\ ... then store result Private SECRET_FLAG SECRET_FLAG = .T. This.yResult = -4654.1234 *// Endproc Enddefine
Sidekick: Have a look at the MySpecialFive class above: Type("SECRET_FLAG") == "U" isn't the fastest way to check for existence of a memory variable! Using Vartype(m.SECRET_FLAG) == "U" does the same job but executes faster!
Nice: Because the private variable goes out of scope when we returning from the method it was created in, we cannot forget to reset it.
Drawbacks: We have to assign a value to a private variable to really 'create' it. The instruction 'Private SECRET_FLAG' differs from 'Local SECRET_FLAG' in that the latter does create a (boolean) variable for us, the Private statement only declares that we are going to do so!
Extending the Scheme
Let's play on the fact that we have to store a value to our private variable to create it. Instead of just storing a .T. or .F. in it we could add more 'friendship' information there. But there is more we should consider! Think about a chain of subsequent calls to sub-routines. A private variable stays in scope form the point we created it along the following calls to sub-methods, even if some of the subsequent calls jump out of your object's boundaries.
Breaking Encapsulation with Intend
If you create a private variable and then call a method of another (external) object, or access one of its properties, your private variable still is visible there. That's why you should otherwise avoid using private variables in OOP, because that's how they break encapsulation!
In our case this is just what we want to achieve: Establishing a controlled way to bypass object encapsulation!
Shadowing
One 'feature' of private variables in VFP is called shadowing. If you are going to create a generic protection algorithm based on "carrying private variables around", this feature comes in handy! Think about the following scenario:
You have three different classes called Class_A, Class_B, and Class_C all stemming from the same superclass. Thus, they all implement the same protection algorithm (behavior). Depending on the roles they play at runtime Class_A should be a friend of Class_B and Class_B in turn should be a friend of Class_C. Class_A should be granted read/write access to one or more PEMs of Class_B, but not to PEMs of Class_C; Class_B should be granted read/write access to one or more PEMs of Class_C.
Now, if Class_A writes to a property of Class_B from within one of its methods like this…
Procedure CallFriend(tcMyFriendsName As String) As Void Local loMyFriend As Object loMyFriend = This.GetRefFromName(m.tcMyFriendsName) If Vartype(m.loMyFriend) == "O" *\\ enable bypassing write protection Private pcSECRET_FLAG pcSECRET_FLAG = This.Name *\\ write to the r/o property m.loMyFriend.cProtectedValue = This.cProtectedValue Endif Endproc
… then the assignment could trigger a subsequent message from Class_B to Class_C like so:
Procedure cProtectedValue_Assign(tcNewVal As String) As Void If Vartype(m.pcSECRET_FLAG) == "C" And; Len(m.pcSECRET_FLAG) > 7 And ; At(m.pcSECRET_FLAG, This.cMyFriendsNames) > 0 *\\ assign value This.cProtectedValue = m.tcNewVal *\\ cascade message to my friend This.CallFriend(This.cMyFriendsName) Else Error 1740, "cProtectedValue" && r/o property Endif Endproc
The method CallFriend() of the Class_B instance that gets called from its own cProtectedValue_Assign() method will create a new private variable pcSECRET_FLAG, now holding the name of Class_B. This private variable, although it has the same name, does not simply overwrite the content of the first one created by the Class_A instance, but overlays it opaquely. In fact, at the moment when our Class_B instance assigns its value to the Class_C instance, two pcSECRET_FLAG variables exist, where the second one SHADOWS the first one created by the Class_A instance. When returning from the CallFriend() method of the Class_B instance the second pcSECRET_FLAG variable goes out of scope. Thus, the first is not longer shadowed, it becomes visible/accessible again.
Nice: VFP's shadowing feature of private variables frees us from taking care about name clashes!
Identifying Friends
Sometimes it is not enough to know that an object sending a message is the instance of a friends class. Maybe hundreds of instances of the same class exist at the same time and we only want to grant write access to few of them depending on the role they play. The question is, how can we identify a unique instance without having its object reference to compare to?
Object Identity
It is said that an object is described by three attributes: State, Behavior, and Identity. Let's focus on the aspect of object identity. VFP gives each object a unique identity. In fact, when we compare objects with each other using the equal operator (=) we are comparing their Identities! VFP has another CompObj() function that allows us to compare objects' State & Appearance instead.
Examples
Type in the following lines in your command window and watch the results echoed to your VFP's desktop:
goX = CreateObject("container") goY = CreateObject("container") ? m.goX = m.goY && .F. ? m.goX = m.goX && .T. ? m.goY = m.goY && .T. ? Compobj(m.goX, m.goY) && .T. same state and appearance *\\ changing the appearance goY.Top = 10 ? Compobj(m.goX, m.goY) && .F. appearance differs ? m.goY = m.goY && .T. always *\\ reset appearance goY.Top = 0 ? Compobj(m.goX, m.goY) && .T. same appearance again *\\ changing appearance Addpropery(m.goY, "Bottom", m.goY.Top+m.goY.Height) ? Compobj(m.goX, m.goY) && .F. appearance differs *\\ assign object reference to another variable m.goX = m.goY ? m.goX = m.goY && .T. both variables pointing to the same object ? Compobj(m.goX, m.goY) && .T. of course
Drawback: We must use object references to compare these special object attributes. Another important thing to keep in mind is that State & Appearance, Behavior, and Identity are runtime related attributes in this context. We are not talking about our classes, but about their instances!
Text-Based Object Identifiers
What we need is some simple representation of an Object's Identity. Surely, we could generate GUIDs and store them in each class instance we create. But that would be too much of a good thing because GUIDs are long and time-consuming to create. We do not need a worldwide unique identifier to tag our instances, but a tinier one, only scoped to the running VFP session where our objects live. The following class definition shows a short excerpt of my solution:
Define Class _CustomTest As Custom Protected cCls2015, cSys2015 cCls2015 = Sys(2015) Function Init() As Boolean This.cSys2015 = Sys(2015) Return .T. Endfunc Function GetIdentity(tcCaller As String) As String *\\ protection scheme left out in this demo Return This.cCls2015+This.cSys2015 Endfunc Enddefine
The value assignment cCls2015 = Sys(2015) stores a unique procedure name (10 characters) to VFP's ClassTemplate Object. Thus, ALL instances of that class will have the same ID that was generated when the first object of that class was instantiated in the current VFP process. The (second) value assignment cSys2015 = Sys(2015) stores a unique procedure name (10 characters) to each Individual Instance. Thus, we will end up returning a 20 character string from the GetIdentity() method which is the Identity (string) we need. We now can use LEFT(m.cID, 10) to query the unique runtime ID of the class template. Using RIGHT(m.ID, 10) will return the unique runtime ID of the class instance instead.
BTW: In our case it is absolutely sufficient to use SYS(2015) generated values because we only need unique IDs generated within the same VFP process. And that is exactly what SYS(2015) does!
Generic Implementation
There is nothing bad about using private variables within our OOP environment in a controlled manner. It is a design decision we make to simplify some generic implementation issues. Let's gather our requirements encountered so far.
- First, we need an Access Protection Scheme (read-write, read-only, write-only, internal-only) that incorporates our Friends Access Pattern.
- In addition to that it would be nice to be able to Signal a given State while running along an execution path without the need to pass the state information through additional parameters from method to method.
- Finally, these requirements should work seamlessly with our concept of Text-based Object Identifiers.
Text-Based Object Identifiers are build upon VFP's Sys(2015) function and are always stored in protected properties of our classes. Once the classes' ID keys are created they must not change - under no circumstances! We will implement a Secured Getter to enable Friends Classes to read each other's Object Identifier values. In addition to that we will implement Secured Setters to enable classes to establish a Friends Link among each others at runtime.
Therefor, we have to define a Common Security ID. This Global Security Token should be stored in a global include file which will be included in all classes that are using our Friends Classes Scheme. Using a well-designed hierarchy of include files can help us achieving our goals without much work.
The following function shows how the Common Security ID is passed in and then gets compared against the object's own copy of it:
Function AGetFriends(tcAuthorityID As String) As Array tcAuthorityID = Transform(m.tcAuthorityID) If m.tcAuthorityID == This.cAutId Return @This.aFriends Endif Endfunc
Two Different Kinds of Private Variables
We will implement two different ways of wrapping our sensitive information in private variables. The first will use static variable names to benefit from VFP's shadowing feature, the other will use secret variable names based on the Object Identifiers Naming Scheme. The first will be used to pass the Secret Object Identifiers around, the second will be used to pass around arbitrary data of any type. The _Custom class below is a 'ready to use' SuperClass with behavior that can be transferred to other VFP base class types, too.
Define Class _Custom As Custom *\\ Public interface eWhatever = .Null. oParent = .Null. *\\ Protected (internal only) Protected Array aFriends[1] Dimension aFriends[1] Protected cCls2015, cSys2015, cAutId, cAutCnt cCls2015 = Sys(2015) cSys2015 = "" cAutId = "{B02103F0-1AA8-4cda-9CCA-DEB455BB9574}" cAutCnt = "pcAuthorityContainer" *\\ Hidden (this classLevel only) *\\ --- none --- *//______________________________________________________ Protected Function Init(teWhatEver As Variant) As Boolean Private pcWorkInProgress Store "INIT" To m.pcWorkInProgress Local llOkay As Boolean llOkay = .T. With This .aFriends[1] = "" .eWhatever = m.teWhatEver .cSys2015 = Sys(2015) Endwith If This.InitBefore(@llOkay) llOkay = This.InitDo(m.llOkay) Endif This.InitAfter(@llOkay) This.eWhatever = .Null. Return m.llOkay Endfunc Protected Function InitBefore(tlOkay As Boolean@) As Boolean Endfunc Protected Function InitDo(tlOkay As Boolean) As Boolean Return m.tlOkay Endfunc Protected Procedure InitAfter(tlOkay As Boolean) As Void Endproc *\\______________________________________________________ Protected Function Destroy() As Void Private pcWorkInProgress Store "DESTROY" To m.pcWorkInProgress If This.DestroyBefore() This.DestroyDo() Endif This.DestroyAfter() Endfunc Protected Function DestroyBefore() As Boolean Endfunc Protected Procedure DestroyDo() As Void Endfunc Protected Procedure DestroyAfter() As Void Endproc *\\______________________________________________________ Function GetIdentity(tcAuthorityID As String) As String Return Iif(Trans(m.tcAuthorityID) == This.cAutId,; This.cCls2015+This.cSys2015, "") Endfunc *\\______________________________________________________ Protected Function IsFriend(tcIdentity As String) As Boolean Return Ascan(This.aFriends, m.tcIdentity,1,-1,1,2+4) > 0 Endfunc *\\______________________________________________________ Procedure AddFriend(tcAuthorityID As String ; , tcIdentity As String) As Void tcAuthorityID = Transform(m.tcAuthorityID) tcIdentity = Transform(m.tcIdentity) If m.tcAuthorityID == This.cAutId Or ; m.tcAuthorityID == This.cCls2015+This.cSys2015 If Empty(This.aFriends[1]) This.aFriends[1] = m.tcIdentity Else If Not This.IsFriend(m.tcIdentity) Local lnNewFriendsCount As Integer lnNewFriendsCount = Alen(This.aFriends) + 1 Dimension This.aFriends[m.lnNewFriendsCount] This.aFriends[m.lnNewFriendsCount] = m.tcIdentity Endif Endif Endif Endproc *\\______________________________________________________ Function GetFriendByIndex(tcAuthorityID As String ; ,tnIndex As Integer) As String tcAuthorityID = Transform(m.tcAuthorityID)
Local lcIdentity As String
lcIdentity = "" If m.tcAuthorityID == This.cAutId Or ; m.tcAuthorityID == This.cCls2015+This.cSys2015 Do Case Case Empty(This.aFriends[1]) Case Not Vartype(m.tnIndex) == "N" Case Not Between(m.tnIndex, 1, Alen(This.aFriends)) Otherwise lcIdentity = This.aFriends[m.tnIndex] Endcase Endif Return m.lcIdentity Endfunc *\\______________________________________________________ Function AGetFriends(tcAuthorityID As String) As Array tcAuthorityID = Transform(m.tcAuthorityID) If m.tcAuthorityID == This.cAutId Return @This.aFriends Endif Endfunc *\\______________________________________________________ Procedure ResetObject(m.tcIdentity As String) As Void Local lcMode As String *\\ get mode; flag unauthorized calls lcMode = Iif(Not (m.tcIdentity == This.cAutId Or; m.tcIdentity == This.cCls2015+This.cSys2015); , "REJECT" ; , Iif(Vartype(m.pcWorkInProgress) == "U" ; , "FULL", m.pcWorkInProgress)) If m.lcMode == "REJECT" Return && >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Endif With This *\\ nullify properties that may hold external references Store .Null. To .oParent Endwith If m.lcMode == "DESTROY" *\\ we're done Return && >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Endif If Not m.lcMode == "INIT" *\\ do NOT redimension array properies when called *\\ from INIT() because they are preset in class Dimension This.aFriends[1] Endif *\\ run (the rest of) full object reset from here on With This Store "" To .aFriends Store .Null. To .eWhatever Endwith *// Endproc Enddefine
Actually, the ResetObject() method does not belong to the core of our Friends Classes concept, but shows how a private variable with a fixed name (m.pcWorkInProgress) can be utilized to pass around additional process attributes without using a property one could forget to reset at the end of the process.
That's all for now
Hope I could help to enlighten you a little bit :-) To be honest, there is nothing wrong with any of the approaches described above! As long as you select one and stay with it to be consistent across your projects, I'm fine with it :-)
Keep things rolling…
Hello, an interesting article.
ReplyDeleteThe class EvtBindAccess is too much messages oriented. Here is a little bit modified version:
clear
xa=CREATEOBJECT("EvtBindAccess")
*RaiseEvent(xa,"cTest","New Precious Value","TeStaB")
*Raising events to access the object's state? A good solution if the object has a message queue.
*In asynchronous computing two (or more) objects can send messeges, when xa is "working"
xa.setv("New Precious Value","TeStaB") &&OK
xa.setv("New Precious Value","xTeStaB") &&error
return
Define Class EvtBindAccess As Custom
*\\ Write Protected property
cTest = "sensitive content"
*\\ 'Grant Access' security token TypeOf(CHAR[20])
Protected eSecTokens
eSecTokens = "TeStaBChElLo123ItsME!"
*//
Protected Function Init()
*\\ Enable 'Bypass Write Protection' by default
* This.ByPassSwitch("ON")
*//
Return .T.
Endfunc
* Protected Procedure ByPassSwitch(tcOnOff As String) As Void
* If m.tcOnOff == "ON"
* = Bindevent(This, "cTest", This, "cTest_Enabler", 2) && external (visible from outside) message chanell
* cTest_Enabler listen to cTest
* Else
* = Unbindevent(This, "cTest", This, "cTest_Enabler")
* Endif
Endproc
Protected Procedure cTest_Assign(tcTest As String) As Void
*\\ wellknown write protection implementation
If Vartype(m.VeryComplexAndSecretVariableName) == "U"
Error 1740, "tcTest" && "name" is a read-only property
Else
This.cTest = m.tcTest
?this.ctest, " message from assign"
Endif
ENDPROC
FUNCTION setV(v,token) && public interface (insead of a rise event)
this.cTest_Enabler(v,token) && internal bind of cTest_Enabler,cTest_Assign
RETURN This.cTest && or m.tcValue ...
endfun
Protected Procedure cTest_Enabler(tcValue As String;
, tcSecToken As Sting) As Void
tcSecToken = Alltrim(Transform(m.tcSecToken))
If Len(m.tcSecToken) > 4 And ;
At(m.tcSecToken, This.eSecTokens) > 0
Private VeryComplexAndSecretVariableName && a switch, could be a property
VeryComplexAndSecretVariableName = .T.
Endif
*\\ assig value
This.cTest = m.tcValue && raise cTest_Assign event
*//
RETURN m.tcValue
Endproc
Enddefine
Best regards Josip Zohil
@Josip: Hi, and many, many thanks for your input! As I wrote in my post: "I would like to show you another *possible* implementation of read-only properties based on VFP's Event Binding..." :-)
ReplyDeleteI included this example only to show a way using BindEvents. That this is not necessarily the preferable way to do it, seems evident...
Anyway, basically, VFP isn't capable of running our code asynchronously on multiple threads. Thus, please forgive me my 'flat' design, it was written just to demonstrate the essence, not a bullet-prove productive solution...
If one really have to deal with concurrent, asynchronous execution paths, then our both code isn't "thread-safe". One should never use plain object properties (scalar ones) to store an object state temporarily! Because: (a.) such methods wouldn't be re-entrant any longer, and therefore (b.), require some kind of message-queuing. The only alternative is (c.) to implement a critical section using VFP's Sys(2336,1) that is possible when running a MTDLL-based VFP COM-Server.
There are some other reasons, but this is not the right spot t discuss them. I will touch them in one of my future VFP-BASICS posts...
Again, many thanks, your input is always welcome!
Thanks you for your response.
ReplyDelete"...VFP isn't capable of running our code asynchronously on multiple threads". I agree with you, it the threads are OS threads. I agree also on the last part of your's comment (on multi-threading).
'… If one really have to deal with concurrent, asynchronous execution paths, then our both code isn't "thread-safe"'.
This code is concurrent, asynchronous and executes on two program path:
private xa
clear
xa=CREATEOBJECT("EvtBindAccess")
oTimer=createobj("mtimer")
otimer.enabled=.t.
FOR i=1 TO 1000000 && adjust the loop values
k=i*7
IF INT(i/100000)=i/100000
?i,PROGRAM(),"LONG"
endif
doevents
endfor
READ events
RETURN
Define Class EvtBindAccess As Custom
*\\ Write Protected property
cTest = "sensitive content"
*\\ 'Grant Access' security token TypeOf(CHAR[20])
Protected eSecTokens
eSecTokens = "TeStaBChElLo123ItsME!"
*//
Protected Function Init()
*\\ Enable 'Bypass Write Protection' by default
* This.ByPassSwitch("ON")
*//
Return .T.
Endfunc
FUNCTION setV(v,token) && public interface (instead of a rise event)
this.cTest_Enabler(v,token) && internal bind of cTest_Enabler,cTest_Assign
RETURN This.cTest && or m.tcValue ...
endfun
Protected Procedure cTest_Enabler(tcValue As String;
, tcSecToken As Sting) As Void
tcSecToken = Alltrim(Transform(m.tcSecToken))
If Len(m.tcSecToken) > 4 And ;
At(m.tcSecToken, This.eSecTokens) > 0
private VeryComplexAndSecretVariableName && a switch, could be a property
VeryComplexAndSecretVariableName = .T.
Endif
*\\ assig value
This.cTest = m.tcValue && raise cTest_Assign event
*//
RETURN m.tcValue
ENDPROC
Protected Procedure cTest_Assign(tcTest As String) As Void
*\\ wellknown write protection implementation
If Vartype(m.VeryComplexAndSecretVariableName) == "U"
Error 1740, "tcTest" && "name" is a read-only property
Else
This.cTest = m.tcTest
Endif
Endproc
ENDDEFINE
DEFINE CLASS mtimer as timer
interval=100
nloop=0
PROCEDURE timer
this.nloop=this.nloop+1
?PROGRAM()
xa.setv("New Precious Value"+ STR(this.nloop),"TeStaB") &&OK
IF this.nloop>1 && fires two times
this.Interval=0
endif
ENDPROC
ENDDEFINE
We have the LONG and TIMER program path. They execute in a concurrent way: a processor executes for a small time interval the LONG process, then it switch to a Timer, resume the LONG process and so on. The code is not executed serially (but by jumping) so it is an asynchronous execution. It is "thread-safe", but not in the sense of OS multi- threading. Why writing asynchronous code on an OS multi-threading platform with difficult to solve thread_safe problems? We can run asynchronous and concurrent code on a single VFP thread in a much more efficient way.
Regards, Josip Zohil