Index: openacs-4/packages/acs-tcl/acs-tcl.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/acs-tcl.info,v diff -u -r1.84 -r1.85 --- openacs-4/packages/acs-tcl/acs-tcl.info 27 Jun 2018 10:14:58 -0000 1.84 +++ openacs-4/packages/acs-tcl/acs-tcl.info 27 Jun 2018 11:31:23 -0000 1.85 @@ -9,7 +9,7 @@ f t - + OpenACS The Kernel Tcl API library. 2017-08-06 @@ -18,7 +18,7 @@ GPL version 2 3 - + Index: openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl 27 Jun 2018 10:14:58 -0000 1.3 +++ openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl 27 Jun 2018 11:31:23 -0000 1.4 @@ -31,8 +31,9 @@ # Provide a base class to generalize cache management to # extend cache primitives like e.g. for cache partitioning. # + :property name :property parameter:required - :property package_key:required + :property package_key:required :property maxentry:integer :property {default_size:integer 10000} @@ -56,21 +57,32 @@ } :public method flush {{-partition_key} key} { - if {![info exists partition_key]} {set partition_key $key} + if {![info exists partition_key]} { + set partition_key $key + } ::acs::clusterwide ns_cache flush [:cache_name $partition_key] $key } if {[info commands ns_cache_eval] ne ""} { # # NaviServer variant # - :public method eval {{-partition_key} key command} { + :public method eval {{-partition_key} {-expires:integer} key command} { # # Evaluate the command unless it is cached. # - if {![info exists partition_key]} {set partition_key $key} + if {![info exists partition_key]} { + set partition_key $key + } + if {[info exists expires]} { + set expires_flag [list -expires $expires] + } else { + set expires_flag {} + } + try { - :uplevel [list ns_cache_eval -- [:cache_name $partition_key] $key $command] + :uplevel [list ns_cache_eval {*}$expires_flag -- \ + [:cache_name $partition_key] $key $command] } on break {r} { # @@ -86,13 +98,15 @@ } } - :public method set {key value} { + :public method set {-partition_key key value} { # # Set some value in the cache. This code uses # ns_cache_eval to achieve this behavior, which is # typically a AOLserver idiom and should be avoided. # - if {![info exists partition_key]} {set partition_key $key} + if {![info exists partition_key]} { + set partition_key $key + } :uplevel [list ns_cache_eval -force -- [:cache_name $partition_key] $key [list set _ $value]] } @@ -121,8 +135,13 @@ # # AOLserver variant # - :public method eval {{-partition_key} key body} { - if {![info exists partition_key]} {set partition_key $key} + :public method eval {{-partition_key} {-expires:integer} key body} { + # + # ignore "-expires", since not supported by AOLserver + # + if {![info exists partition_key]} { + set partition_key $key + } try { :uplevel [list ns_cache eval [:cache_name $partition_key] $key $body] } on break {r} { @@ -131,7 +150,7 @@ return $r } } - :public method set {{-partition_key} key value} { + :public method set {-partition_key key value} { if {![info exists partition_key]} {set partition_key $key} :uplevel [list ns_cache set [:cache_name $partition_key] $key $value] } @@ -148,6 +167,20 @@ } } + :public method get {-partition_key key} { + # + # The "get" method retrieves data from the cache. It + # should not be used for new applications due to likely + # race conditions, but legacy applications use this. As + # implementation, we use in the case of NaviServer the + # AOLserver API emulation. + # + if {![info exists partition_key]} { + set partition_key $key + } + return [ns_cache get [:cache_name $partition_key] $key] + } + :public method flush_cache {{-partition_key ""}} { # # Flush all entries in a cache. Both, NaviServer and @@ -166,7 +199,13 @@ } :public method init {} { - set :name [namespace tail [current]] + # + # If the name was not provided, use the object name as + # default. + # + if {![info exists :name]} { + set :name [namespace tail [current]] + } :cache_create ${:name} [:get_size] } } @@ -188,7 +227,13 @@ } :public method init {} { - set :name [namespace tail [current]] + # + # If the name was not provided, use the object name as + # default. + # + if {![info exists :name]} { + set :name [namespace tail [current]] + } set partitions [::parameter::get_from_package_key \ -package_key ${:package_key} \ -parameter "${:parameter}Partitions" \