Version 6 of Aspect Support Class for TclOO

Updated 2007-11-12 13:29:06 by dkf

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.

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]
        set notrap [expr {[dict get $opts -trap] eq ""}]
        if {$notrap} {
            dict set opts -trap ASPECT__options
        }
	set script {
	    if {[lindex [self target] 0] eq "::oo::object"} {
		return [next {*}$args]
	    }
	}
	append script [list if [dict get $opts -condition] then] " "
	set inScript \n[dict get $opts -before]\n
	append inScript [list catch {next {*}$args} \
		[dict get $opts -variable] [dict get $opts -trap]] \n
        if {$notrap} {
            append inScript [list if \
                    {[dict get $ASPECT__options -code] == 0} \
                    [dict get $opts -after]] \n
        } else {
            append inScript [dict get $opts -after]\n
        }
	append inScript {return -options [set } [list [dict get $opts -trap]]\
		{] [set } [list [dict get $opts -variable]] {]}
	append script [list $inScript else {return [next {*}$args]}]
	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 {
	    oo::define $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::define 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