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