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" }