Otherwise, evaluate script and cache and return the - result. - -
Note: script is not evaluated with uplevel.
-
- @param script A Tcl script whose value should be memoized. May be
- best to pass this as a list, e.g. [list someproc $arg1 $arg2].
-
- @param max_age The maximum age in seconds for the cached value of
- script. If the cached value is older than max_age
- seconds, script will be re-executed.
-
- @return The possibly-cached value returned by script.
- } {
- if {$max_age ne ""} {
- set max_age "-expires $max_age"
- }
- ns_cache_eval {*}$max_age -- util_memoize $script {*}$script
- }
-
- # In case, the definition of the function has cached something,
- # drop this as well.
- catch {ns_cache_flush util_memoize}
-
-
- ad_proc -public util_memoize_seed {script value {max_age ""}} {
- Pretend util_memoize was called with script and
- it returned value. Cache value, replacing any
- previous cache entry for script.
-
-
If clustering is enabled, this command flushes script's - value from the caches on all servers in the cluster before storing - the new value. The new value is only stored in the local cache. - - @param script A Tcl script that presumably would return - value. - - @param value The value to cache for script. - - @param max_age Not used. - } { - ns_cache_eval -force util_memoize $script [list set _ $value] - } - - - ad_proc -public util_memoize_cached_p {script {max_age ""}} { - Check whether script's value has been cached, and whether it - was cached no more than max_age seconds ago. - - @param script A Tcl script. - - @param max_age Maximum age of cached value in seconds. - - @return Boolean value. - } { - if {$max_age ne ""} { - ns_log Warning "util_memoize_cached_p: ignore max_age $max_age for $script" - } - return [expr {[ns_cache_keys util_memoize $script] ne ""}] - } - - ad_proc -public util_memoize_flush_pattern { - -log:boolean - pattern - } { - - Loop through all cached scripts, flushing all that match the - pattern that was passed in. - - @param pattern Match pattern (glob pattern like in 'string match $pattern ...'). - @param log Whether to log keys checked and flushed (useful for debugging). - - } { - set nr_flushed [ns_cache_flush -glob util_memoize $pattern] - if {$log_p} { - ns_log Debug "util_memoize_flush_pattern: flushed $nr_flushed entries using the pattern: $pattern" - } - } - -} else { - # - # "Classical" implementation of util_memoize for AOLServer - # with script-level expire handling - # - ad_proc -public util_memoize {script {max_age ""}} { - If script has been executed before, return the value it - returned last time, unless it was more than max_age seconds ago. - -
Otherwise, evaluate script and cache and return the - result. - -
Note: script is not evaluated with uplevel.
-
- @param script A Tcl script whose value should be memoized. May be
- best to pass this as a list, e.g. [list someproc $arg1 $arg2].
-
- @param max_age The maximum age in seconds for the cached value of
- script. If the cached value is older than max_age
- seconds, script will be re-executed.
-
- @return The possibly-cached value returned by script.
- } {
-
- if {$max_age ne "" && $max_age < 0} {
- error "max_age must not be negative"
- }
-
- set current_time [ns_time]
-
- set cached_p [ns_cache get util_memoize $script pair]
-
- if {$cached_p && $max_age ne "" } {
- set cache_time [lindex $pair 0]
- if {$current_time - $cache_time > $max_age} {
- ns_cache flush util_memoize $script
- set cached_p 0
- }
- }
-
- if {!$cached_p} {
- set pair [ns_cache eval util_memoize $script {
- list $current_time [eval $script]
- }]
- }
-
- return [lindex $pair 1]
- }
-
- ad_proc -public util_memoize_seed {script value {max_age ""}} {
- Pretend util_memoize was called with script and
- it returned value. Cache value, replacing any
- previous cache entry for script.
-
-
If clustering is enabled, this command flushes script's - value from the caches on all servers in the cluster before storing - the new value. The new value is only stored in the local cache. - - @param script A Tcl script that presumably would return - value. - - @param value The value to cache for script. - - @param max_age Not used. - } { - util_memoize_flush $script - - ns_cache set util_memoize $script [list [ns_time] $value] - } - - ad_proc -public util_memoize_cached_p {script {max_age ""}} { - Check whether script's value has been cached, and whether it - was cached no more than max_age seconds ago. - - @param script A Tcl script. - - @param max_age Maximum age of cached value in seconds. - - @return Boolean value. - } { - if {![ns_cache get util_memoize $script pair]} { - return 0 - } - - if {$max_age eq ""} { - return 1 - } else { - set cache_time [lindex $pair 0] - return [expr {[ns_time] - $cache_time <= $max_age}] - } - } - - ad_proc -public util_memoize_flush_pattern { - -log:boolean - pattern - } { - - Loop through all cached scripts, flushing all that match the - pattern that was passed in. - - @param pattern Match pattern (glob pattern like in 'string match $pattern'). - @param log Whether to log keys checked and flushed (useful for debugging). - - } { - foreach name [ns_cache names util_memoize $pattern] { - if {$log_p} { - ns_log Debug "util_memoize_flush_pattern: flushing $name" - } - util_memoize_flush $name - } - } - -} - ad_proc -public util_memoize_initialized_p {} { Return 1 if the util_memoize cache has been initialized and is ready to be used and 0 otherwise.