/usr/share/tcltk/tcllib1.18/cache/async.tcl is in tcllib 1.18-dfsg-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 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
|