diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/cache | |
parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/cache')
-rw-r--r-- | tcllib/modules/cache/ChangeLog | 52 | ||||
-rw-r--r-- | tcllib/modules/cache/async.man | 143 | ||||
-rw-r--r-- | tcllib/modules/cache/async.tcl | 185 | ||||
-rw-r--r-- | tcllib/modules/cache/async.test | 230 | ||||
-rw-r--r-- | tcllib/modules/cache/pkgIndex.tcl | 3 |
5 files changed, 613 insertions, 0 deletions
diff --git a/tcllib/modules/cache/ChangeLog b/tcllib/modules/cache/ChangeLog new file mode 100644 index 0000000..d043e6a --- /dev/null +++ b/tcllib/modules/cache/ChangeLog @@ -0,0 +1,52 @@ +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-11-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * async.tcl: Moved the cleanup of state regarding pending + * async.man: callbacks in the notification methods forward + * pkgIndex.tcl: to ensure consistent internal state in case of + recursive call to set method by the callbacks. Also added guard + in 'set' to avoid multiple sets for identical values. Bumped to + version 0.3. + +2008-11-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * async.tcl (exists): Added method querying the cache about + knowledge of a key. Fixed handling of provider command + prefix. Bumped version to 0.2. + +2008-11-18 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * async.man: New module 'cache', containing the new package + * async.tcl: 'cache::async'. + * async.test: + * pkgIndex.tcl: + diff --git a/tcllib/modules/cache/async.man b/tcllib/modules/cache/async.man new file mode 100644 index 0000000..7672c7b --- /dev/null +++ b/tcllib/modules/cache/async.man @@ -0,0 +1,143 @@ +[manpage_begin cache::async n 0.3] +[keywords asynchronous] +[keywords cache] +[keywords callback] +[keywords synchronous] +[copyright {2008 Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[moddesc {In-memory caches}] +[titledesc {Asynchronous in-memory cache}] +[require Tcl 8.4] +[require cache::async [opt 0.3]] +[description] + +This package provides objects which cache data in memory, and operate +asynchronously with regard to request and responses. The objects are +agnostic with regard to cache keys and values, and unknown methods are +delegated to the provider of cached data. These two properties make it +easy to use caches as a facade for any data provider. + +[section API] + +The package exports a class, [class cache::async], as specified +below. + +[list_begin definitions] + +[call [cmd ::cache::async] [arg objectName] [arg commandprefix] [opt [arg options]...]] + +The command creates a new [term cache] object with an associated +global Tcl command whose name is [arg objectName]. This command may +be used to invoke various operations on the object. + +[para] + +The [arg commandprefix] is the action to perform when an user asks for +data in the cache and the cache doesn't yet know about the key. When +run the commandprefix is given three additional arguments, the string +[const get], the key requested, and the cache object itself, in the +form of its object command, in this order. The execution of the action +is done in an idle-handler, decoupling it from the original request. + +[para] + +The only supported option is + +[list_begin options] +[opt_def -full-async-results] + +This option defines the behaviour of the cache for when requested keys +are known to the cache at the time of [method get] request. By default +such requeste are responded to asynchronously as well. Setting this +option to [const false] forces the cache to respond to them +synchronuously, although still through the specified callback. + +[list_end] +[list_end] + +The object commands created by the class commands above have +the form: + +[list_begin definitions] + +[call [arg objectName] [method get] [arg key] [arg donecmdprefix]] + +This method requests the data for the [arg key] from the cache. If the +data is not yet known the command prefix specified during construction +of the cache object is used to ask for this information. + +[para] + +Whenever the information is/becomes available the [arg donecmdprefix] +will be run to transfer the result to the caller. This command prefix +is invoked with either 2 or 3 arguments, i.e. + +[list_begin enum] +[enum] The string [const set], the [arg key], and the value. +[enum] The string [const unset], and the [arg key]. +[list_end] + +These two possibilities are used to either signal the value for the +[arg key], or that the [arg key] has no value defined for it. The +latter is distinct from the cache not knowing about the [arg key]. + +[para] + +For a cache object configured to be fully asynchronous (default) the +[arg donecmdprefix] is always run in an idle-handler, decoupling it +from the request. Otherwise the callback will be invoked synchronously +when the [arg key] is known to the cache at the time of the +invokation. + +[para] + +Another important part of the cache's behaviour, as it is asynchronous +it is possible that multiple [method get] requests are issued for the +same [arg key] before it can respond. In that case the cache will +issue only one data request to the provider, for the first of these, +and suspend the others, and then notify all of them when the data +becomes available. + +[call [arg objectName] [method set] [arg key] [arg value]] +[call [arg objectName] [method unset] [arg key]] + +These two methods are provided to allow users of the cache to make +keys known to the cache, as either having a [arg value], or as +undefined. + +[para] + +It is expected that the data provider (see [arg commandprefix] of the +constructor) uses them in response to data requests for unknown keys. + +[para] + +Note how this matches the cache's own API towards its caller, calling +the [arg donecmd] of [method get]-requests issued to itself with +either "set key value" or "unset key", versus issuing +[method get]-requests to its own provider with itself in the place of +the [arg donecmd], expecting to be called with either "set key value" +or "unset key". + +[para] + +This also means that these methods invoke the [arg donecmd] of all +[method get]-requests waiting for information about the modified +[arg key]. + +[call [arg objectName] [method exists] [arg key]] + +This method queries the cache for knowledge about the [arg key] and +returns a boolean value. The result is [const true] if the key is +known, and [const false] otherwise. + +[call [arg objectName] [method clear] [opt [arg key]]] + +This method resets the state of either the specified [arg key] or of +all keys known to the cache, making it unkown. This forces future +[method get]-requests to reload the information from the provider. + +[list_end] + +[vset CATEGORY cache] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/cache/async.tcl b/tcllib/modules/cache/async.tcl new file mode 100644 index 0000000..e6c866a --- /dev/null +++ b/tcllib/modules/cache/async.tcl @@ -0,0 +1,185 @@ +## -*- tcl -*- +# ### ### ### ######### ######### ######### + +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> + +# Aynchronous in-memory cache. Queries of the cache generate +# asynchronous requests for data for unknown parts, with asynchronous +# result return. Data found in the cache may return fully asynchronous +# as well, or semi-synchronous. The latter meaning that the regular +# callbacks are used, but invoked directly, and not decoupled through +# events. The cache can be pre-filled synchronously. + +# ### ### ### ######### ######### ######### +## Requisites + +package require Tcl 8.4 ; # +package require snit ; # + +# ### ### ### ######### ######### ######### +## + +snit::type cache::async { + + # ### ### ### ######### ######### ######### + ## Unknown methods and options are forwared to the object actually + ## providing the cached data, making the cache a proper facade for + ## it. + + delegate method * to myprovider + delegate option * to myprovider + + # ### ### ### ######### ######### ######### + ## API + + option -full-async-results -default 1 -type snit::boolean + + constructor {provider args} { + set myprovider $provider + $self configurelist $args + return + } + + method get {key donecmd} { + # Register request + lappend mywaiting($key) $donecmd + + # Check if the request can be satisfied from the cache. If yes + # then that is done. + + if {[info exists mymiss($key)]} { + $self NotifyUnset 1 $key + return + } elseif {[info exists myhit($key)]} { + $self NotifySet 1 $key + return + } + + # We have to ask our provider if there is data or + # not. however, if a request for this key is already in flight + # then we have to do nothing more. Our registration at the + # beginning ensures that we will get notified when the + # requested information comes back. + + if {[llength $mywaiting($key)] > 1} return + + # This is the first query for this key, ask the provider. + + after idle [linsert $myprovider end get $key $self] + return + } + + method clear {args} { + # Note: This method cannot interfere with async queries caused + # by 'get' invokations. If the data is present, and now + # removed, all 'get' invokations before this call were + # satisfied from the cache and only invokations coming after + # it can trigger async queries of the provider. If the data is + # not present the state will not change, and queries in flight + # simply refill the cache as they would do anyway without the + # 'clear'. + + if {![llength $args]} { + array unset myhit * + array unset mymiss * + } elseif {[llength $arg] == 1} { + set key [lindex $args 0] + unset -nocomplain myhit($key) + unset -nocomplain mymiss($key) + } else { + WrongArgs ?key? + } + return + } + + method exists {key} { + return [expr {[info exists myhit($key)] || [info exists mymiss($key)]}] + } + + method set {key value} { + # Add data to the cache, and notify all outstanding queries. + # Nothing is done if the key is already known and has the same + # value. + + # This is the method invoked by the provider in response to + # queries, and also the method to use to prefill the cache + # with data. + + if { + [info exists myhit($key)] && + ($value eq $myhit($key)) + } return + + set myhit($key) $value + unset -nocomplain mymiss($key) + $self NotifySet 0 $key + return + } + + method unset {key} { + # Add hole to the cache, and notify all outstanding queries. + # This is the method invoked by the provider in response to + # queries, and also the method to use to prefill the cache + # with holes. + unset -nocomplain myhit($key) + set mymiss($key) . + $self NotifyUnset 0 $key + return + } + + method NotifySet {found key} { + if {![info exists mywaiting($key)] || ![llength $mywaiting($key)]} return + + set pending $mywaiting($key) + unset mywaiting($key) + + set value $myhit($key) + if {$found && !$options(-full-async-results)} { + foreach donecmd $pending { + uplevel \#0 [linsert $donecmd end set $key $value] + } + } else { + foreach donecmd $pending { + after idle [linsert $donecmd end set $key $value] + } + } + return + } + + method NotifyUnset {found key} { + if {![info exists mywaiting($key)] || ![llength $mywaiting($key)]} return + + set pending $mywaiting($key) + unset mywaiting($key) + + if {$found && !$options(-full-async-results)} { + foreach donecmd $pending { + uplevel \#0 [linsert $donecmd end unset $key] + } + } else { + foreach donecmd $pending { + after idle [linsert $donecmd end unset $key] + } + } + return + } + + proc WrongArgs {expected} { + return -code error "wrong#args: Expected $expected" + } + + # ### ### ### ######### ######### ######### + ## State + + variable myprovider ; # Command prefix providing the data to cache. + variable myhit -array {} ; # Cache array mapping keys to values. + variable mymiss -array {} ; # Cache array mapping keys to holes. + variable mywaiting -array {} ; # Map of keys pending to notifier commands. + + # ### ### ### ######### ######### ######### +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide cache::async 0.3 diff --git a/tcllib/modules/cache/async.test b/tcllib/modules/cache/async.test new file mode 100644 index 0000000..f904413 --- /dev/null +++ b/tcllib/modules/cache/async.test @@ -0,0 +1,230 @@ +# -*- tcl -*- +# Tests for the cache::async module. +# +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: async.test,v 1.1 2008/11/19 06:04:59 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 2.0 + +testing { + useLocal async.tcl cache::async +} + +# ------------------------------------------------------------------------- +# Helper commands + +proc DATA_NONE {method key cmd} { + res+ DATA_NONE $method $key $cmd + set ::wait . + return -code error "Should not be called" +} + +proc DATA_VALUE {method key cmd} { + res+ DATA_VALUE $method $key $cmd + eval [linsert $cmd end set $key ALPHA] + return +} + +proc DATA_HOLE {method key cmd} { + res+ DATA_HOLE $method $key $cmd + eval [linsert $cmd end unset $key] + return +} + +proc DONE {args} { + res+ DONE $args + set ::wait . + return +} + +proc WAIT {} { + res+ WAIT + vwait ::wait + res+ RESUME +} + +# ------------------------------------------------------------------------- + +test cache-async-1.0 {preset value} -setup { + cache::async ca DATA_NONE + ca set KEY VALUE + res! +} -body { + res+ BEGIN + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DONE {set KEY VALUE} +RESUME} + +test cache-async-1.1 {preset hole} -setup { + cache::async ca DATA_NONE + ca unset KEY + res! +} -body { + res+ BEGIN + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DONE {unset KEY} +RESUME} + +# ------------------------------------------------------------------------- + +test cache-async-2.0 {provider value} -setup { + cache::async ca DATA_VALUE + res! +} -body { + res+ BEGIN + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DATA_VALUE get KEY ::ca +DONE {set KEY ALPHA} +RESUME} + +test cache-async-2.1 {provider hole} -setup { + cache::async ca DATA_HOLE + res! +} -body { + res+ BEGIN + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DATA_HOLE get KEY ::ca +DONE {unset KEY} +RESUME} + +# ------------------------------------------------------------------------- + +test cache-async-3.0 {provider value, multi request merge} -setup { + cache::async ca DATA_VALUE + res! +} -body { + res+ BEGIN + ca get KEY DONE + ca get KEY DONE + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DATA_VALUE get KEY ::ca +DONE {set KEY ALPHA} +DONE {set KEY ALPHA} +DONE {set KEY ALPHA} +RESUME} + +test cache-async-3.1 {provider hole, multi request merge} -setup { + cache::async ca DATA_HOLE + res! +} -body { + res+ BEGIN + ca get KEY DONE + ca get KEY DONE + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DATA_HOLE get KEY ::ca +DONE {unset KEY} +DONE {unset KEY} +DONE {unset KEY} +RESUME} + +# ------------------------------------------------------------------------- + +test cache-async-4.0 {preset value, sync return on hit} -setup { + cache::async ca DATA_NONE -full-async-results 0 + ca set KEY VALUE + res! +} -body { + res+ BEGIN + ca get KEY DONE + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +DONE {set KEY VALUE}} + +test cache-async-4.1 {preset hole, sync return on hit} -setup { + cache::async ca DATA_NONE -full-async-results 0 + ca unset KEY + res! +} -body { + res+ BEGIN + ca get KEY DONE + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +DONE {unset KEY}} + +# ------------------------------------------------------------------------- + +test cache-async-5.0 {provider value, stays async} -setup { + cache::async ca DATA_VALUE -full-async-results 0 + res! +} -body { + res+ BEGIN + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DATA_VALUE get KEY ::ca +DONE {set KEY ALPHA} +RESUME} + +test cache-async-5.1 {provider hole, stays async} -setup { + cache::async ca DATA_HOLE -full-async-results 0 + res! +} -body { + res+ BEGIN + ca get KEY DONE + WAIT + res?lines +} -cleanup { + ca destroy +} -result {BEGIN +WAIT +DATA_HOLE get KEY ::ca +DONE {unset KEY} +RESUME} + +# ------------------------------------------------------------------------- +testsuiteCleanup diff --git a/tcllib/modules/cache/pkgIndex.tcl b/tcllib/modules/cache/pkgIndex.tcl new file mode 100644 index 0000000..0840786 --- /dev/null +++ b/tcllib/modules/cache/pkgIndex.tcl @@ -0,0 +1,3 @@ +if {![package vsatisfies [package provide Tcl] 8.4]} {return} +package ifneeded cache::async 0.3 [list source [file join $dir async.tcl]] + |