Index: openacs-4/packages/acs-tcl/tcl/memoize-procs-naviserver.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/memoize-procs-naviserver.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-tcl/tcl/memoize-procs-naviserver.tcl 27 Feb 2018 11:00:56 -0000 1.2
+++ openacs-4/packages/acs-tcl/tcl/memoize-procs-naviserver.tcl 28 Mar 2018 07:27:10 -0000 1.3
@@ -35,6 +35,16 @@
#
catch {ns_cache_flush util_memoize}
+proc !! args {
+ set t0 [clock clicks -milliseconds]
+ set result [uplevel $args]
+ set t1 [clock clicks -milliseconds]
+ if {$t1 - $t0 > 100} {
+ ns_log notice "!!! slow ([expr {$t1 - $t0}]ms): $args"
+ }
+ return $result
+}
+
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.
@@ -56,7 +66,7 @@
if {$max_age ne ""} {
set max_age "-expires $max_age"
}
- ns_cache_eval {*}$max_age -- util_memoize $script {*}$script
+ !! ns_cache_eval {*}$max_age -- util_memoize $script {*}$script
}
# In case, the definition of the function has cached something,
@@ -80,7 +90,7 @@
@param max_age Not used.
} {
- ns_cache_eval -force util_memoize $script [list set _ $value]
+ !! ns_cache_eval -force util_memoize $script [list set _ $value]
}
@@ -97,7 +107,7 @@
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 ""}]
+ return [expr {[!! ns_cache_keys util_memoize $script] ne ""}]
}
ad_proc -public util_memoize_flush_pattern {
@@ -112,7 +122,7 @@
@param log Whether to log keys checked and flushed (useful for debugging).
} {
- set nr_flushed [ns_cache_flush -glob util_memoize $pattern]
+ 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"
}