Index: openacs-4/packages/xotcl-core/COPYRIGHT
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/COPYRIGHT,v
diff -u -N -r1.1 -r1.2
--- openacs-4/packages/xotcl-core/COPYRIGHT 30 Dec 2005 00:04:44 -0000 1.1
+++ openacs-4/packages/xotcl-core/COPYRIGHT 26 Jun 2018 10:24:24 -0000 1.2
@@ -1,23 +1,24 @@
- * xotcl-core
- *
- * Copyright (C) 2005 Gustaf Neumann, neumann@wu-wien.ac.at
- *
- * Vienna University of Economics and Business Administration
- * Institute of Information Systems and New Media
- * A-1090, Augasse 2-6
- * Vienna, Austria
- *
- * This is a BSD-Style license applicable for the files in this
- * directory and below, except when stated explicitly different.
- *
- * Permission to use, copy, modify, distribute, and sell this
- * software and its documentation for any purpose is hereby granted
- * without fee, provided that the above copyright notice appear in
- * all copies and that both that copyright notice and this permission
- * notice appear in supporting documentation. We make no
- * representations about the suitability of this software for any
- * purpose. It is provided "as is" without express or implied
- * warranty.
- *
+#
+# xotcl-core
+#
+# Copyright (C) 2005-2018 Gustaf Neumann, neumann@wu-wien.ac.at
+#
+# Vienna University of Economics and Business
+# Institute of Information Systems and New Media
+# A-1020, Welthandelsplatz 1
+# Vienna, Austria
+#
+# This is a BSD-Style license applicable for the files in this
+# directory and below, except when stated explicitly different.
+#
+# Permission to use, copy, modify, distribute, and sell this
+# software and its documentation for any purpose is hereby granted
+# without fee, provided that the above copyright notice appear in
+# all copies and that both that copyright notice and this permission
+# notice appear in supporting documentation. We make no
+# representations about the suitability of this software for any
+# purpose. It is provided "as is" without express or implied
+# warranty.
+#
Index: openacs-4/packages/xotcl-core/xotcl-core.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v
diff -u -N -r1.101 -r1.102
--- openacs-4/packages/xotcl-core/xotcl-core.info 22 Jun 2018 20:11:55 -0000 1.101
+++ openacs-4/packages/xotcl-core/xotcl-core.info 26 Jun 2018 10:24:24 -0000 1.102
@@ -10,7 +10,7 @@
t
xotcl
-
+
Gustaf Neumann
XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)
2017-08-06
@@ -43,12 +43,12 @@
BSD-Style
2
-
+
-
+
Index: openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl,v
diff -u -N -r1.132 -r1.133
--- openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl 25 Jun 2018 17:20:48 -0000 1.132
+++ openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl 26 Jun 2018 10:24:24 -0000 1.133
@@ -722,173 +722,6 @@
##########################################################################
#
- # Generic Cache class
- #
- ##########################################################################
-
- nx::Class create ::xo::Cache {
- #
- # Provide a simple class to generalize cache management to extend
- # cache primitiva (in the future, e.g. for cache partitioning).
- #
- :property parameter:required
- :property package_key:required
- :property maxentry:integer
- :property {default_size:integer 10000}
-
- :method cache_name {key} {
- #
- # More or less dummy function, can be refined, completely
- # ignores "key".
- #
- return ${:name}
- }
-
- :method get_size {} {
- #
- # Determine the cache size depending on configuration variables.
- #
- return [::parameter::get_from_package_key \
- -package_key ${:package_key} \
- -parameter "${:parameter}Size" \
- -default ${:default_size}]
- }
-
- :public method flush {{-tree_key} key} {
- if {![info exists tree_key]} {set tree_key $key}
- ::xo::clusterwide ns_cache flush [:cache_name $tree_key] $key
- }
-
- if {[info commands ns_cache_eval] ne ""} {
- #
- # NaviServer variant
- #
- :public method eval {{-tree_key} key body} {
- if {![info exists tree_key]} {set tree_key $key}
- try {
- :uplevel [list ns_cache_eval -- [:cache_name $tree_key] $key $body]
- } on break {r} {
- #ns_log notice "====================== [self] $key -> break -> <$r>"
- return 0
- } on ok {r} {
- return $r
- }
- }
- :public method set {key value} {
- if {![info exists tree_key]} {set tree_key $key}
- :uplevel [list ns_cache_eval -force -- [:cache_name $tree_key] $key [list set _ $value]]
- }
- :public method flush_pattern {{-tree_key ""} pattern} {
- return [ns_cache_flush -glob [:cache_name $tree_key] $pattern]
- }
- :method cache_create {name size} {
- ns_cache_create \
- {*}[expr {[info exists :maxentry] ? "-maxentry ${:maxentry}" : ""}] \
- $name $size
- }
-
- } else {
- #
- # AOLserver variant
- #
- :public method eval {{-tree_key} key body} {
- if {![info exists tree_key]} {set tree_key $key}
- try {
- :uplevel [list ns_cache eval [:cache_name $tree_key] $key $body]
- } on break {r} {
- return 0
- } on ok {r} {
- return $r
- }
- }
- :public method set {{-tree_key} key value} {
- if {![info exists tree_key]} {set tree_key $key}
- :uplevel [list ns_cache set [:cache_name $tree_key] $key $value]
- }
- :public method flush_pattern {{-tree_key ""} pattern} {
- foreach name [ns_cache names [:cache_name $tree_key] $pattern] {
- :flush -tree_key $tree_key $name
- }
- }
- :method cache_create {name size} {
- ns_cache create $name -size $size
- }
- }
-
- :public method init {} {
- set :name [namespace tail [current]]
- :cache_create ${:name} [:get_size]
- }
- }
-
- ##########################################################################
- #
- # Simple Partitioned Cache class
- #
- # Partitioning is based on a modulo function based on the key, which
- # has to be numeric. So far, no partitioning-spanning methods are
- # provided.
- #
- ##########################################################################
-
- nx::Class create ::xo::PartitionedCache -superclasses ::xo::Cache {
- :property {partitions:integer 1}
-
- :protected method cache_name {key:integer} {
- return ${:name}-[expr {$key % ${:partitions}}]
- }
-
- :public method init {} {
- set :name [namespace tail [current]]
- set partitions [::parameter::get_from_package_key \
- -package_key ${:package_key} \
- -parameter "${:parameter}Partitions" \
- -default ${:partitions}]
- #
- # Create multiple separate caches depending on the
- # partitions. This requires to have a partitioning function that
- # determines the partition number from the key.
- #
- set size [expr {[:get_size] / ${:partitions}}]
- for {set i 0} {$i < ${:partitions}} {incr i} {
- :cache_create ${:name}-$i $size
- }
- }
- }
-
-
- ##########################################################################
- #
- # Tree Partitioned Cache class
- #
- # Tree Partitioning is based on a modulo function using a special
- # tree_key, which has to be numeric. So far, no
- # partitioning-spanning methods are provided.
- #
- ##########################################################################
-
- nx::Class create ::xo::TreePartitionedCache -superclasses ::xo::PartitionedCache {
- :property {partitions:integer 1}
-
- :public method flush_pattern {{-tree_key:integer,required} pattern} {
- #
- # flush just in the determined partition
- #
- next
- }
-
- :public method flush {{-tree_key:integer,required} key} {
- next
- }
-
- :public method set {{-tree_key:integer,required} key value} {
- next
- }
- }
-
-
- ##########################################################################
- #
# The ns_caches below should exist, before any cached objects are
# created. Under most conditions, it is sufficient to do this in
# object-cache-init.tcl, which is performed after xotcl-core procs
@@ -897,8 +730,7 @@
# xotcl-core are not executed (probably a bug). Without the
# ns_cache, creating objects fails with an error. So, we moved the
# cache creation here and create caches, when they do not exist
- # already. This change makes the object-cache-init.tcl
- # obsolete.
+ # already.
#
# Unfortunately, AOLserver's ns_cache has no command to check, whether
# a cache exists, so we use the little catch below to check.
@@ -908,28 +740,31 @@
} on error {errorMsg} {
ns_log notice "xotcl-core: creating xotcl-object caches"
- ::xo::PartitionedCache create ::xo::xotcl_object_cache \
+ ::acs::PartitionedCache create ::xo::xotcl_object_cache \
-maxentry 200000 \
-package_key xotcl-core \
-parameter XOTclObjectCache \
-default_size 400000 \
-partitions 2
ns_log notice "... created ::xo::xotcl_object_cache"
- ::xo::TreePartitionedCache create ::xo::xotcl_object_type_cache \
+ ::acs::TreePartitionedCache create ::xo::xotcl_object_type_cache \
-package_key xotcl-core \
-parameter XOTclObjectTypeCache \
-default_size 50000
ns_log notice "... created ::xo::xotcl_object_type_cache"
- ::xo::Cache create ::xo::xotcl_package_cache \
+ ::acs::Cache create ::xo::xotcl_package_cache \
-package_key xotcl-core \
-parameter XOTclPackageCache \
-default_size 10000
ns_log notice "... created ::xo::xotcl_package_cache"
}
-
+ ##########################################################################
+ #
+ # Deprecated functions, obsolted by xo::dc
+ #
ad_proc -deprecated has_ltree {} {
Check, whether ltree is available (postgres only)
@see ::xo::dc has_ltree
@@ -944,7 +779,11 @@
::xo::dc has_hstore
}
-
+ ##########################################################################
+ #
+ # Support for requiring database artifacts
+ #
+ ##########################################################################
::xotcl::Object create require
require proc exists_table {name} {
@@ -1221,7 +1060,7 @@
@return object_type, typically an XOTcl class
} {
- xo::xotcl_object_type_cache eval -tree_key $id $id {
+ xo::xotcl_object_type_cache eval -partition_key $id $id {
::xo::dc 1row get_class "select object_type from acs_objects where object_id=:id"
return $object_type
}
Index: openacs-4/packages/xotcl-core/tcl/cr-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/cr-procs.tcl,v
diff -u -N -r1.69 -r1.70
--- openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 25 Jun 2018 15:03:02 -0000 1.69
+++ openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 26 Jun 2018 10:24:24 -0000 1.70
@@ -65,7 +65,7 @@
return [set $key]
}
set entry_key [expr {$item_id ? $item_id : $revision_id}]
- set $key [xo::xotcl_object_type_cache eval -tree_key $entry_key $entry_key {
+ set $key [xo::xotcl_object_type_cache eval -partition_key $entry_key $entry_key {
if {$item_id} {
::xo::dc 1row -prepare integer get_class_from_item_id \
"select content_type as object_type from cr_items where item_id=:item_id"
@@ -1639,7 +1639,7 @@
# In order to cache fails as well, we would have to flush the fail
# on new added items and renames.
while {1} {
- set item_id [xo::xotcl_object_type_cache eval -tree_key $parent_id $parent_id-$name {
+ set item_id [xo::xotcl_object_type_cache eval -partition_key $parent_id $parent_id-$name {
set item_id [next]
if {$item_id == 0} {
#ns_log notice ".... lookup $parent_id-$name => 0 -> break and don't cache"
@@ -1753,19 +1753,27 @@
return $item_id
}
CrCache::Item instproc delete args {
+ #
+ # Not all cr_items are cached. Some of the bulk creation commands
+ # create autonamed items, which have non-numeric object names. So
+ # the flush on these will fail anyhow, since these were never
+ # added to the cache.
+ #
set key [string trimleft [self] :]
- # Do not try to flush autnamed entries
if {[string is integer $key] } {
::xo::xotcl_object_cache flush $key
}
- xo::xotcl_object_type_cache flush -tree_key ${:parent_id} ${:parent_id}-[:name]
+ xo::xotcl_object_type_cache flush -partition_key ${:parent_id} ${:parent_id}-[:name]
next
}
CrCache::Item instproc rename {-old_name:required -new_name:required} {
- ::xo::xotcl_object_type_cache flush -tree_key ${:parent_id} ${:parent_id}-$old_name
+ ::xo::xotcl_object_type_cache flush -partition_key ${:parent_id} ${:parent_id}-$old_name
next
}
+ #
+ # Register the caching mixins
+ #
CrClass instmixin CrCache
CrClass mixin CrCache::Class
CrItem instmixin CrCache::Item