Class ::acs::SiteNodesCache (public)
::nx::Class ::acs::SiteNodesCache
Defined in packages/acs-tcl/tcl/site-nodes-procs.tcl
acs::SiteNodesCache is a mixin class implementing caching of SiteNode objects. Add/remove extra caching methods as when more operations should be cached. Removing the registry of the object mixin deactivates caching for these methods completely.
- Testcases:
- No testcase defined.
Source code: :public method get_children { -node_id:required,integer,1..1 {-all:switch} {-package_type ""} {-package_key ""} {-filters ""} {-element ""} } { # # Cache get_children operations, except, when "-all" # was specified. The underlying operation can be quite # expensive, when huge site-node trees are # explored. Since the argument list influences the # results, we cache for every parameter combination. # # Since this cache contains subtrees, we have to flush # trees, which is implemented via pattern flushes. So # we use a separate cache to avoid long locks on # site-nodes in general. # if {$all} { # # Don't cache when $all is specified - seldom # used, a pain for invalidating. # next } else { ::acs::site_nodes_children_cache eval -partition_key $node_id get_children-$node_id-$all-$package_type-$package_key-$filters-$element { next } } } :method has_children { -node_id:required,integer,1..1 } { ::acs::site_nodes_children_cache eval -partition_key $node_id has_children-$node_id { next } } :public method get_node_id {-url:required} { # # Cache the result of the upstream implementation of # get_node_id in the acs::site_nodes_id_cache cache. # acs::site_nodes_id_cache eval id-$url { next } } :protected method properties {-node_id:required,integer,1..1} { 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} { # # It's a pain, but OpenACS and its regression test # call "get_url" a few times with an empty node_id. # Shortcut these calls here to avoid problems with the # non-numeric partition_key. # if {$node_id eq ""} { set result "" } else { set result [::acs::site_nodes_cache eval -partition_key $node_id url-$node_id { next }] } return $result } :public method get_urls_from_object_id {-object_id:required,integer,1..1} { # # Cache the result of the upstream implementation of # get_urls_from_object_id in the acs::site_nodes_cache. # ::acs::site_nodes_cache eval -partition_key $object_id urls-$object_id { next } } :public method get_package_url {-package_key:required} { # # Cache the result of the upstream implementation of # get_package_url in the acs::site_nodes_cache. # # Note: the cache value from the following method must # currently be explicitly flushed. We do that, for # instance, when we mount a new package. # ::acs::site_nodes_cache eval -partition_key 0 package_url-$package_key { next } } :method flush_per_request_cache {} { unset -nocomplain ::__node_id } :public method flush_pattern {{-partition_key ""} pattern} { # # Flush from the site-nodes caches certain # information. The method hides the actual caching # structure and is as well provided in conformance # with the alternative implementations # above. Depending on the specified pattern, it # reroutes the flushing request to different caches. # :flush_per_request_cache switch -glob -- $pattern { id-* {set cache site_nodes_id_cache} get_children-* - has_children {set cache site_nodes_children_cache} default {set cache site_nodes_cache} } ::acs::$cache flush_pattern -partition_key $partition_key $pattern } :public method flush_cache { -node_id:required,1..1 {-with_subtree:boolean true} {-url ""} } { # # Flush entries from site-node tree, including the current node, # the root of flushed (sub)tree. If the node_id is not provided, # or it is the node_id of root of the full site-node tree, flush # the whole tree. # :flush_per_request_cache set old_url [:get_url -node_id $node_id] if {$node_id eq "" || $old_url eq "/"} { # # When no node_id is given or the URL is specified # as top-url, flush all caches. This happens # e.g. in the regression test. # #ns_log notice "FLUSHALL" ::acs::site_nodes_cache flush_all ::acs::site_nodes_id_cache flush_all ::acs::site_nodes_children_cache flush_all } else { # # Get subtree from db # set sql [subst { WITH RECURSIVE site_node_tree(node_id,parent_id,object_id) AS ( select node_id, parent_id, object_id from site_nodes where node_id = :node_id UNION ALL select child.node_id, child.parent_id, child.object_id from site_node_tree, site_nodes child where child.parent_id = site_node_tree.node_id and :with_subtree ) select [acs::dc map_function_name site_node__url(node_id)], node_id, object_id from site_node_tree }] if {[db_driverkey ""] eq "oracle"} { set sql [string map [list "WITH RECURSIVE" "WITH"] $sql] if { $with_subtree } { set sql [string map [list ":with_subtree" "1 = 1"] $sql] } else { set sql [string map [list ":with_subtree" "1 = 0"] $sql] } } set tree [::acs::dc list_of_lists -prepare integer,boolean dbqd..get_subtree $sql] foreach entry $tree { lassign $entry url node_id object_id foreach key [list $node_id url-$node_id] { ::acs::site_nodes_cache flush -partition_key $node_id $key } if {$object_id ne ""} { ::acs::site_nodes_cache flush -partition_key $object_id urls-$object_id } :flush_pattern -partition_key $node_id get_children-$node_id-* ::acs::site_nodes_children_cache flush -partition_key $node_id has_children-$node_id } regsub {/$} $old_url "" old_url :flush_pattern id-$old_url* } }Generic XQL file: packages/acs-tcl/tcl/site-nodes-procs.xql
PostgreSQL XQL file: packages/acs-tcl/tcl/site-nodes-procs-postgresql.xql
Oracle XQL file: packages/acs-tcl/tcl/site-nodes-procs-oracle.xql