OpenACS
Subsite
2017-08-06
@@ -18,11 +18,11 @@
GPL
3
-
+
-
+
Index: openacs-4/packages/acs-subsite/tcl/package-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/package-procs.tcl,v
diff -u -N -r1.40.2.2 -r1.40.2.3
--- openacs-4/packages/acs-subsite/tcl/package-procs.tcl 2 Jan 2020 15:32:11 -0000 1.40.2.2
+++ openacs-4/packages/acs-subsite/tcl/package-procs.tcl 19 May 2020 19:15:36 -0000 1.40.2.3
@@ -1,5 +1,3 @@
-# /packages/mbryzek-subsite/tcl/package-procs.tcl
-
ad_library {
Procs to help build PL/SQL packages
@@ -568,25 +566,21 @@
{ -object_name "NEW" }
package_name
} {
- Generates a list of parameters expected to a plsql function defined within
- a given package.
+
+ Return a list of parameters expected to a plsql function defined
+ within a given package and cache these per thread. Changes in the
+ interface will require a server restart.
-
-
@author Ben Adida (ben@openforce.net)
@creation-date 11/2001
@param package_name The package which owns the function
@param object_name The function name which we're looking up
@return list of parameters
} {
- # Get just the args
- set key ::acs::package_plsql_args($object_name-$package_name)
- if {[info exists $key]} {
- return [set $key]
- }
- return [set $key [db_list select_package_func_param_list {}]]
-
+ return [acs::per_thread_cache eval -key acs-subsite.package_plsql_args($object_name-$package_name) {
+ db_list select_package_func_param_list {}
+ }]
}
ad_proc -private package_function_p {
@@ -595,11 +589,9 @@
} {
@return true if the package's object is a function.
} {
- set key ::acs::package_function_p($object_name-$package_name)
- if {[info exists $key]} {
- return [set $key]
- }
- return [set $key [db_0or1row function_p ""]]
+ return [acs::per_thread_cache eval -key acs-subsite.package_function_p($object_name-$package_name) {
+ db_0or1row function_p ""
+ }]
}
ad_proc -private package_table_columns_for_type {
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 -N -r1.95.2.11 -r1.95.2.12
--- openacs-4/packages/acs-tcl/acs-tcl.info 18 May 2020 21:13:20 -0000 1.95.2.11
+++ openacs-4/packages/acs-tcl/acs-tcl.info 19 May 2020 19:15:36 -0000 1.95.2.12
@@ -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 -N -r1.10.2.6 -r1.10.2.7
--- openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl 18 May 2020 21:20:20 -0000 1.10.2.6
+++ openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl 19 May 2020 19:15:36 -0000 1.10.2.7
@@ -373,31 +373,45 @@
namespace eval ::acs {
##########################################################################
#
- # Per-Thread Cache
+ # acs::LockfreeCache: Per-thread and per-request Cache
#
- # Cached values are stored as namespaced variables. This kind of
- # cache has the advantage that no lock is required, but has the
- # disadvantage that it can be used only for values that never
- # change. Currently, there is no interface to flush these values.
+ # Lockfree cache are provided either as per-thread caches or
+ # per-request caches, sharing the property that accessing these
+ # values does not require locks.
#
+ # The per-thread caches use namespaced variables, which are not
+ # touched by the automatic cleanup routines of the server. So, the
+ # values cached in one requests can be used by another
+ # requests. These per-thread caches are kept as long the thread
+ # lives, there is so far no automatic mechanism to flush
+ # these. So, these are typically used for values fetched from the
+ # database, but which not not change, unless the server is
+ # restarted.
+ #
+ # Per-request caches have very short-lived. Some values are needed
+ # multiple times per request, and/or they should show consistently
+ # the same value during the request, no matter, if concurrently, a
+ # value is changed (e.g. permissions).
+ #
##########################################################################
- nx::Class create acs::PerThreadCache {
-
+ nx::Class create acs::LockfreeCache {
+ :property {prefix }
+
:public method eval {
{-key:required}
{-no_empty:switch false}
cmd
} {
#
- # Implement per-thread cache based on namespaced Tcl variables.
- # The cached values are stored in the namespace ::acs:cache::*
+ # Use the "prefix" to determine whether the cache is
+ # per-thread or per-request.
#
- # @param key key for caching, should start with package-keys
- # and a dot to avoid name clashes
+ # @param key key for caching, should start with package-key
+ # and a dot to avoid name clashes
# @param cmd command to be executed.
- # @return return the last value set (don't use "return").
+ # @return return the last value set (don't use "return").
#
- set cache_key ::acs::cache::$key
+ set cache_key ${:prefix}$key
#ns_log notice "### exists $cache_key => [info exists $cache_key]"
if {![info exists $cache_key]} {
@@ -412,7 +426,18 @@
}
return [set $cache_key]
}
- :create per_thread_cache
+ #
+ # The per-thread cache uses namespaced Tcl variables, identified
+ # by the prefix "::acs:cache::"
+ #
+ :create per_thread_cache -prefix ::acs::cache::
+
+ #
+ # The per-reuqest cache uses Tcl variables in the global
+ # namespace, such they are automatically reclaimed after the
+ # request. These use the prefix "::__acs_cache_"
+ #
+ :create per_request_cache -prefix ::__acs_cache_
}
namespace eval ::acs::cache {}
}
Index: openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl,v
diff -u -N -r1.47.2.2 -r1.47.2.3
--- openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl 5 Jun 2019 08:27:27 -0000 1.47.2.2
+++ openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl 19 May 2020 19:15:36 -0000 1.47.2.3
@@ -162,13 +162,11 @@
}
# We have a per-request cache here
- set key ::permission__permission_p__cache($party_id,$object_id,$privilege)
- if { ![info exists $key] } {
- set $key [db_string select_permission_p {
+ return [acs::per_request_cache eval -key acs-tcl.permission_p__cache($party_id,$object_id,$privilege) {
+ db_string select_permission_p {
select acs_permission.permission_p(:object_id, :party_id, :privilege)::integer from dual
- }]
- }
- return [set $key]
+ }
+ }]
}
Index: openacs-4/packages/acs-tcl/tcl/defs-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/defs-procs.tcl,v
diff -u -N -r1.81.2.7 -r1.81.2.8
--- openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 26 Jan 2020 17:10:55 -0000 1.81.2.7
+++ openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 19 May 2020 19:15:36 -0000 1.81.2.8
@@ -8,25 +8,16 @@
@cvs-id $Id$
}
-ad_proc -public ad_acs_version_no_cache {} {
- The OpenACS version of this instance. Uses the version name
- of the acs-kernel package.
-
- @author Peter Marklund
-} {
- apm_version_get -package_key acs-kernel -array kernel
-
- return $kernel(version_name)
-}
ad_proc -public ad_acs_version {} {
The OpenACS version of this instance. Uses the version name
of the acs-kernel package.
@author Peter Marklund
} {
- set key ::acs::version
- if {[info exists $key]} {return [set $key]}
- set $key [util_memoize ad_acs_version_no_cache]
+ return [acs::per_thread_cache eval -key acs-tcl.acs_version {
+ apm_version_get -package_key acs-kernel -array kernel
+ set kernel(version_name)
+ }]
}
ad_proc -public ad_acs_release_date {} {
Index: openacs-4/packages/acs-tcl/tcl/security-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/security-procs.tcl,v
diff -u -N -r1.126.2.28 -r1.126.2.29
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl 17 May 2020 17:04:10 -0000 1.126.2.28
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl 19 May 2020 19:15:37 -0000 1.126.2.29
@@ -2421,21 +2421,20 @@
@param host host from host header field.
} {
#
- # The global variable takes care of outputting error message only
+ # The per-request cache takes care of outputting error message only
# once per request.
#
- set key ::__security_provided_host_validated($host)
- if {![info exists $key]} {
- set $key 1
+ return [acs::per_request_cache eval -key acs-tcl.security_provided_host_validated($host) {
+ set result 1
if {$host ne ""} {
if {![regexp {^[\w.:@+/=$%!*~\[\]-]+$} $host]} {
binary scan [encoding convertto utf-8 $host] H* hex
ad_log warning "provided host <$host> (hex $hex) contains invalid characters"
- set $key 0
+ set result 0
}
}
- }
- return [set $key]
+ set result
+ }]
}
ad_proc -public security::validated_host_header {} {
Index: openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl,v
diff -u -N -r1.141.2.18 -r1.141.2.19
--- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 17 Apr 2020 19:12:05 -0000 1.141.2.18
+++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 19 May 2020 19:15:37 -0000 1.141.2.19
@@ -1414,12 +1414,9 @@
}
:protected method properties {-node_id:required,integer,1..1} {
- set key ::__site_nodes_property($node_id)
- if {[info exists $key]} {
- return [set $key]
- }
- set $key [::acs::site_nodes_cache eval -partition_key $node_id $node_id { next }]
- return [set $key]
+ return [acs::per_request_cache eval -key acs-tcl.site_nodes_property($node_id) {
+ ::acs::site_nodes_cache eval -partition_key $node_id $node_id { next }
+ }]
}
:public method get_url {-node_id:required,1..1} {