Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

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]]
+