Aspect Support Class for TclOO

The Aspect class is a metaclass that acts as a generator for aspects. Use it just like you would oo::class, except that there is now a new aspect definition command.

  oo::object
  └ oo::class
    └ Aspect

Description

The aspect definition command (only available when creating a subclass of Aspect) accepts a list of option-value pairs. Note that all arguments to the method being wrapped are always placed in the args variable in any script code. The following options are supported:

-name name	The name of the aspect method. May be omitted, in which case a default name will be selected.
-condition expression	An expression to allow the choice of whether to apply the aspect to the current call. Will execute in the same variable context as the -before and -after scripts.
-before script	A script to execute before the call to the contained method. Will execute in the same variable context as the -condition expression and -after script.
-after script	A script to execute after the call to the contained method. Will execute in the same variable context as the -condition expression and -before script.
-variable varName	The name of the variable that will hold the result of the contained method.
-trap varName	The name of the variable that will hold the catch options from the contained method. If this is unset, the -after script will only be executed when the inner method completes successfully.

Code

oo::class create Aspect {
    superclass oo::class

    constructor {{script ""}} {
        variable AspectNameGen 1
        interp alias {} ::oo::define::aspect {} \
                {*}[namespace code {my DefineAspect}]
        set cls [next $script]
        interp alias {} ::oo::define::aspect {}
    }
    method DefineAspect args {
        set opts [dict merge {
            -name {}
            -condition 1 -before {} -after {}
            -variable ASPECT__result -trap {}
        } $args]
        if {[dict get $opts -trap] eq ""} {
            set script {
                if {[lindex [self target] 0] eq "::oo::object"} {
                    return [next {*}$args]
                }
                if {%1$s} {
                    %2$s
                    set %4$s [next {*}$args]
                    %3$s
                    return [set %4$s]
                } else {
                    return [next {*}$args]
                }
            }
        } else {
            set script {
                if {[lindex [self target] 0] eq "::oo::object"} {
                    return [next {*}$args]
                }
                if {%1$s} {
                    %2$s
                    catch {next {*}$args} %4$s %5$s
                    %3$s
                    return -options [set %5$s] [set %4$s]
                } else {
                    return [next {*}$args]
                }
            }
        }
        set script [format $script \
                [dict get $opts -condition] \
                [dict get $opts -before] \
                [dict get $opts -after] \
                [list [dict get $opts -variable]] \
                [list [dict get $opts -trap]]]
        set name [dict get $opts -name]
        if {$name eq ""} {
            variable AspectNameGen
            set name Aspect__[self]__[incr AspectNameGen]
        }
        oo::define [self] method $name args $script
        set filters [info class filters [self]]
        oo::define [self] filter [lappend filters $name]
        return $name
    }
    method attach {args} {
        foreach obj $args {
            # changed oo::define to oo::objdefine for TclOO version 0.6.1
            oo::objdefine $obj mixin [self]
        }
    }
}

Demonstrations

Here are some demonstrations of how to use the Aspect metaclass.

Log

One of the simplest uses for aspects is adding logging:

package require log
Aspect create logger {
    aspect -before {
        log::log debug "Called [self]->[self target] $args"
    }
}

Demonstrating it in use:

oo::class create foo {
    method bar {a b c} {
        expr {$a + $b + $c}
    }
}
logger attach foo
foo create fooObj
fooObj bar 2 3 4                → returns "9"
                                → logs "Called ::fooObj->bar 2 3 4"

Cache

A simple caching aspect:

Aspect create cache {
    aspect -before {
        my variable ValueCache
        set key [self target],$args
        if {[info exist ValueCache($key)]} {
            return $ValueCache($key)
        }
    } -variable result -after {
        set ValueCache($key) $result
    }
    method flushCache {} {
        my variable ValueCache
        unset ValueCache
        # Skip the caching
        return -level 2 ""
    }
}

Then we'll demo it in service:

oo::object create demo
oo::objdefine demo {
    method compute {a b c} {
        after 3000 ;# Simulate deep thought
        return [expr {$a + $b * $c}]
    }
    method compute2 {a b c} {
        after 3000 ;# Simulate deep thought
        return [expr {$a * $b + $c}]
    }
}

cache attach demo

puts [demo compute  1 2 3]      → prints "7" after delay
puts [demo compute2 4 5 6]      → prints "26" after delay
puts [demo compute  1 2 3]      → prints "7" instantly
puts [demo compute2 4 5 6]      → prints "26" instantly
puts [demo compute  4 5 6]      → prints "34" after delay
puts [demo compute  4 5 6]      → prints "34" instantly
puts [demo compute  1 2 3]      → prints "7" instantly
demo flushCache
puts [demo compute  1 2 3]      → prints "7" after delay

jima Apparently the logger sample does not work for me...even with plain puts. I have tried the following instead:

 ::oo::object create foo2
 ::oo::define foo2 {
  method bar {a b c} {
   expr {$a + $b + $c}
  }
 }
 logger attach foo2
 foo2 bar 2 3 4

And it seems to work.

DKF: Oops, yes. That's a bug (filters in mixins aren't currently detected...)

Bezoar: It did not work for me until I enabled logging at debug level then it worked (Linux, tcl 8.6b.1) so after the package require log put:

 log::lvSuppress debug 0

I also changed the Aspect classes attache method. It worked fine for the foo class but for the demo object I had to change oo::define to oo::objdefine. Is oo::objdefine new in version 0.6.1 ?

DKF: It's been in there for a while (over a year); the split of oo::define and oo::objdefine (one for classes, one for objects) was done before the (successful) TIP#257 vote.

jblz This is wicked cool. I changed 'oo::define demo' to 'oo::objdefine demo' in the example. I am having a problem though where if i attach to a class, i get calls to the class (aka calls to new), but i'm not getting the calls to the methods of instances of a class.

Hey! Got it! To get methods calls of instance objects by attaching to a class, you can add the following method to the Aspect metaclass

method attach-class {args} {
     foreach cls $args {
         oo::define $cls mixin [self]
     }
}