This is an expansion on [The observer design pattern] in which you can provide criteria in which your callback will run. This is basically a toy at this point. I would not consider this anywhere near production ready code, however it illustrates the concept and provides the opportunity for feedback if anyone has any ideas or obvious security concerns. I intend on utilizing this in the future to power a new unix rc scripting library built on within a customized TCL enabled bsdinit binary. **Concept** So basically I wanted to build a construct that would allow.... ====== when {[thing2 get temperature] > 100} do {thing1 set alarm on} ====== So we need a few things in order for this to work... * to know when the underlying temperature variable that the 'thing2 get temperature' ensemble is modified. * to know when interest is expressed in that variable at the time the callback is created. (when processing the when...do created by the user) * to be able to easily guarantee the values which we may want to be using as constraints will actually match criteria (so that alarm is not set to yes. (this is a little more of my preference than an actual requirement. It just seems more tidy if this were possible.) ====== # The implementation housed here is submitted into the public domain, with no implied # warranty, for use, modification, distribution AS-IS. # The only thing I ask is if you use it please distribute under MIT/BSD style license # credit my and others contribution, and let me know so I can share in the catharsis # that this has provided benefit to someone other than me. # TODO: # -- Add subject type enforcement (as defined with where commands...) # -- Write Handler for destruction of a variable # -- Write Handler for array (hashtable) modification. # -- Add expression result cache to prevent calculation of something # which hasn't changed. Need some way to track invalidation of cache # entries.. (there is a point where this is noted below) # -- Add dependency management (preferably with TCL's internal package require) so that when-do's will not be evaluated for 'expressesInterest' until the dependent objects/variable traces have been created and traces set. # -- Implement checks on constraints. #ENABLE/DISABLE DEBUGGING OUTPUT set ::DEBUG false #SET LOGFILE TO CHANGE FROM STDERR TO FILE OUTPUT. set ::LOGFILE {} if {$::LOGFILE == {}} { proc log {args} { puts stderr [join $args { }] } } else { set ::LOGFD [open $::LOGFILE w+] proc log {args} [format { puts %s [join $args { }] } $::LOGFD] } if {[info exists ::DEBUG] && $::DEBUG} { proc debug {args} { set caller(logtype) [lindex $args 0] array set caller [info frame -1] set caller(message) [format {%s @ line %s: %s} \ $caller(proc) $caller(line) $args] puts $caller(message) } } else { proc debug {args} { return } } namespace eval ::esos::subjectLogicObserver { namespace export when subject namespace ensemble create -command ::subject -map [list create [namespace current]::create] namespace ensemble create -command ::when -map [list do [namespace current]::when_do] -parameters expr # subject is watched varable.. # priority should be weight of expr dependancy complexity # bump priority based on quantity of times callback gets scheduled # value is {expression priority callback} variable conditionMap variable subjectRef variable subjectConstraint array set conditionMap {} array set subjectRef {} } proc ::esos::subjectLogicObserver::create {args} { debug entered... variable subjectConstraint set syntax {wrong # args: "subject create subjectName constraint ... ?subjectName constraint?"} set arglen [llength $args] # must supply argument if {$arglen < 1} { return -code error $argserr } # multiple args are binary tupples of {event contraint} if {$arglen > 1} { # must be divisible by 2 if {[llength $args] % 2 == 1} { return -code error $argserr } } else { # single arg container of tupples of {event constraint} set args [lindex $args 0] } set subjectNamespace [uplevel {namespace current}] foreach {subjectName constraint} $args { ############################################# # ALWAYS FULLY QUALIFY SUBJECT AND CALLBACK # ############################################# # fully qualify subject variable. set subject [set subjectNamespace]::[set subjectName] # create the subject (traced variable) in the correct namespace set $subject [list] debug subject $subject variable created... # observer "creates" with to watch subject through the # execution of the expression (which will trigger the # following trace when the variable is read trace add variable $subject read [namespace current]::subjectObserver_expressesInterest debug subject $subject trace reads -> [namespace current]::subjectObserver_expressesInterest # evaluate callbacks when object written to. trace add variable $subject write [namespace current]::subjectChanged_Handler debug subject $subject trace writes -> [namespace current]::subjectChanged_Handler # deal with out of band destruction of subject trace add variable $subject unset [namespace current]::subjectUnset_Handler debug subject $subject trace unsets -> [namespace current]::subjectUnset_Handler # deal with out of band modification of subject trace add variable $subject array [namespace current]::subjectArraymod_Handler debug subject $subject trace array events -> [namespace current]::subjectArraymod_Handler set subjectConstraint($subject) $constraint debug constraint bound to subject: $constraint } } # this executes the expr on behalf of the createing observer # kickstarting the registration process when the trace fires as # the subject variable event triggers are read. Now anytime the # publishing service writes to the variable, the trace executes # evaluating any interested parties' expression to determine # if we should schedule the callback for execution. # # the real beauty in this approach is we can use complex logic # that just relies on the subjects in the observer or are even # obscured by the subject publisher with procs that rely on # the subject variables. This should be extremely scalable and # quite user friendly as the service developer shouldn't have # to think about anything beyond writing a boolean expression # which when true runs a defined callback. proc ::esos::subjectLogicObserver::when_do {expr script} { debug evaluating when $expr -> $script # run the expression and pass exception, to help identify # interested observers. if {[catch [list expr $expr] res]} { return -code error $res } debug evaluation completed successfully with $res. } # gets caller info from parent's parent frame proc ::esos::subjectLogicObserver::callerinfo {arrayName} { debug updating $arrayName upvar $arrayName result foreach {k v} [info frame -2] { set result(caller$k) $v } } # fully qualify the subject and determine if scalar or array (hash table)... proc ::esos::subjectLogicObserver::qualifySubject {subjectName subjectKey} { if {"$subjectKey" == ""} { debug derived subject:$subjectName set subject [uplevel 2 [list namespace which -variable $subjectName]] } { debug derived subject:$subjectName\($subjectKey\) set subject [uplevel 2 [list namespace which -variable $subjectName]\($subjectKey\)] } } # looks through stack frames to see if this is ran from within the # 'when-do' command. This is how we implicitly determine the # expression's dependancy on a particular subject (traced variable). proc ::esos::subjectLogicObserver::subjectObserver_expressesInterest {subjectName subjectKey op args} { debug args:$subjectName $subjectKey $args variable conditionMap set namespace [namespace current] set subject [qualifySubject $subjectName $subjectKey] debug interest expressed in $subject #traverse the stack for 'when' for {set level 1} {![catch {set frameproc [dict get [info frame -$level] proc]} res]} { incr level } { debug searching stack $level: $frameproc if {"$frameproc" == "[set namespace]::when_do"} { debug level:$level $frameproc found... # link to variables in when_do frame so we can store # expr and callback in conditionMap upvar $level expr expr script callback lappend conditionMap($subject) $expr $callback debug updated conditionMap\($subject\) $expr $callback # bail out.. we don't need to finish searching the stack return } } } # anytime a subject is modified, call this callback so we can update any # interested parties. proc ::esos::subjectLogicObserver::subjectChanged_Handler {subjectName subjectKey op args} { variable subjectRef variable conditionMap set subject [qualifySubject $subjectName $subjectKey] upvar $subject subjectValue debug "'[lindex [info level 1] 0]' modified $subject -> '$subjectValue'" # if we have issues below, make sure that when multiple conditions show up we # are handlnig them correctly.. lindex maybe a janky way to drop the # subjectName from the response of 'array get' but the advantage of using # 'array get' is it returns nothing if nothing is found, as opposed to using # the sugar var '$conditionMap($subjectName)' results in an exception when # there is no matching key in the hashtable. foreach {expr callback} [lindex [array get conditionMap $subject] 1] { set namespace [namespace qualifiers $subject] # NOTE: If there were some sort of expression eval cache, and we arrived at # this point, the entry would now be invalid as a supporting component # has been changed. Reevaluate procedures within expression that have # changed and evaluate resultant expression. (this is not implemented # and is just a note for a possible future scalability/performance # improvement opportunity.) # debug change invalidates expr: $expr, reevaluating. debug callback: $callback if {[expr $expr]} { after idle [list namespace inscope $namespace $callback] debug $expr is now true: callback scheduled for execution $callback } } tailcall update } proc ::esos::subjectLogicObserver::subjectUnset_Handler {subjectName subjectKey op args} { variable subjectRef variable conditionMap set subject [qualifySubject $subjectName $subjectKey] # TODO: WRITE HANDLER FOR UNSET TRACE.... Not sure if this is needed yet. } proc ::esos::subjectLogicObserver::subjectArraymod_Handler {subjectName subjectKey op args} { variable subjectRef variable conditionMap set subject [qualifySubject $subjectName $subjectKey] # TODO: WRITE HANDLER FOR ARRAY MODIFICATION TRACE.... Not sure if this is needed yet. } ====== And now... a test implementation ====== namespace eval ::thing2 { namespace export extern_* namespace ensemble create -map [list set [namespace current]::extern_set get [namespace current]::extern_get] subject create { temperature {where $temperature is double} watchdog {where $watchdog is wideinteger} text {where $text is print} } proc extern_set {varname value} { variable $varname set $varname $value } proc extern_get {varname} { variable $varname return [set $varname] } } namespace eval ::thing1 { namespace export extern_* namespace ensemble create -map [list set [namespace current]::extern_set get [namespace current]::extern_get] subject create { pressure {where $pressure is double} status {where $status in {stopped starting running stopping}} alarm {where $alarm is boolean} } when {[thing2 get temperature] > 100} do { puts stderr {!WARNING! thing2 IS GETTING TOO HOT, TURNING DOWN PRESSURE!} thing1 set pressure 100 } proc extern_set {varname value} { variable $varname set $varname $value } proc extern_get {varname} { variable $varname return [set $varname] } } % thing2 set temperature 150 !WARNING! thing2 IS GETTING TOO HOT, TURNING DOWN PRESSURE! 150 ====== I know at face value this seems like this is just a really long way to call a procedure, but I believe if you experiment with creating your code in such a way that you're just defining conditions in which code should run, we can create some very interesting implementations of state machines, servers or interfaces in general. Anyways.. thoughts, ideas, fixes are definately welcome. ---- <>Concept