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.99 -r1.100 --- openacs-4/packages/xotcl-core/xotcl-core.info 21 Jun 2018 07:23:56 -0000 1.99 +++ openacs-4/packages/xotcl-core/xotcl-core.info 22 Jun 2018 11:56:11 -0000 1.100 @@ -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,7 +43,7 @@ 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.126 -r1.127 --- openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl 21 Jun 2018 09:19:51 -0000 1.126 +++ openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl 22 Jun 2018 11:56:11 -0000 1.127 @@ -1,5 +1,5 @@ ::xo::library doc { - + XOTcl API for low level db abstraction @author Gustaf Neumann @@ -110,15 +110,15 @@ } ::xo::db::postgresql instproc has_ltree {} { - ns_cache eval xotcl_object_cache [self]::has_ltree { + ::xo::xotcl_object_type_cache eval [self]::has_ltree { if {[:get_value check_ltree "select count(*) from pg_proc where proname = 'ltree_in'"] > 0} { return 1 } return 0 } } ::xo::db::postgresql instproc has_hstore {} { - ns_cache eval xotcl_object_cache [self]::has_hstore { + ::xo::xotcl_object_type_cache eval [self]::has_hstore { if {[:get_value check_ltree "select count(*) from pg_proc where proname = 'hstore_in'"] > 0} { return 1 } @@ -281,7 +281,7 @@ # # Driver specific and Driver/Dialect specific hooks # - ::xotcl::Class create ::xo::db::DB -superclass ::xo::db::Driver + ::xotcl::Class create ::xo::db::DB -superclass ::xo::db::Driver ::xotcl::Class create ::xo::db::DB-postgresql -superclass {::xo::db::DB ::xo::db::postgresql} ::xotcl::Class create ::xo::db::DB-oracle -superclass {::xo::db::DB ::xo::db::oracle} @@ -674,7 +674,7 @@ set varName ::xo::prepared($session_id,$key) } on error {errorMsg} { set session_id "-" - set varName __prepared($key) + set varName __prepared($key) } if {![info exists $varName]} { @@ -730,14 +730,36 @@ :property package_key:required :property maxentry:integer :property {default_size:integer 10000} - + :public method flush {key} { ::xo::clusterwide ns_cache flush ${:name} $key } - + + if {[info commands ns_cache_eval] ne ""} { + # + # NaviServer variant + # + :public method eval {key body} { + :uplevel [list ns_cache_eval -- ${:name} $key $body] + } + :public method set {key value} { + :uplevel [list ns_cache_eval -force -- ${:name} $key [list set _ $value]] + } + } else { + # + # AOLerver variant + # + :public method eval {key body} { + :uplevel [list ns_cache eval ${:name} $key $body] + } + :public method set {key value} { + :uplevel [list ns_cache set ${:name} $key $value] + } + } + :public method init {} { set :name [namespace tail [current]] - + if {[info commands ns_cache_create] ne ""} { # # Version for NaviServer, which allows us to provide maximum @@ -756,13 +778,13 @@ -size [parameter::get_from_package_key \ -package_key ${:package_key} \ -parameter ${:parameter} \ - -default ${:default_size}] + -default ${:default_size}] } } } - - + + ########################################################################## # # The ns_caches below should exist, before any cached objects are @@ -789,16 +811,19 @@ -package_key xotcl-core \ -parameter XOTclObjectCacheSize \ -default_size 400000 + ns_log notice "... created ::xo::xotcl_object_cache" - ::xo::Cache create xotcl_object_type_cache \ + ::xo::Cache create ::xo::xotcl_object_type_cache \ -package_key xotcl-core \ -parameter XOTclObjectTypeCacheSize \ -default_size 50000 - - ::xo::Cache create xotcl_package_cache \ + ns_log notice "... created ::xo::xotcl_object_type_cache" + + ::xo::Cache create ::xo::xotcl_package_cache \ -package_key xotcl-core \ -parameter XOTclPackageCacheSize \ - -default_size 10000 + -default_size 10000 + ns_log notice "... created ::xo::xotcl_package_cache" } @@ -816,7 +841,7 @@ ::xo::dc has_hstore } - + ::xotcl::Object create require require proc exists_table {name} { @@ -920,8 +945,8 @@ # postgres could avoid this check and use 'if not exists' from # version 9.5 if {[::xo::dc 0or1row exists " - SELECT 1 FROM information_schema.sequences - WHERE sequence_schema = 'public' + SELECT 1 FROM information_schema.sequences + WHERE sequence_schema = 'public' AND sequence_name = :name"]} return } @@ -942,7 +967,7 @@ lappend clause "NO" } lappend clause "CYCLE" - lappend clause "CACHE $cache" + lappend clause "CACHE $cache" ::xo::dc dml create-seq " CREATE SEQUENCE $name [join $clause]" } @@ -1093,7 +1118,7 @@ @return object_type, typically an XOTcl class } { - return [ns_cache eval xotcl_object_type_cache $id { + xo::xotcl_object_type_cache eval $id { ::xo::dc 1row get_class "select object_type from acs_objects where object_id=:id" return $object_type }] @@ -1419,7 +1444,7 @@ set ::xo::db::sql_suffix(postgresql,content_item,set_live_revision) "FOR NO KEY UPDATE" set ::xo::db::sql_suffix(postgresql,content_item,del) "FOR UPDATE" set ::xo::db::sql_suffix(postgresql,content_item,new) "FOR UPDATE" - + ::xo::db::DB instproc psql_statement_suffix {package_name object_name} { set key ::xo::db::sql_suffix(${:dialect},$package_name,$object_name) return [expr {[info exists $key] ? [set $key] : ""}] @@ -2754,7 +2779,7 @@ lappend result "([ns_dbquotevalue $e $type])" } return "(values [join $result ,])" - } + } } ::xo::library source_dependent 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.66 -r1.67 --- openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 21 Jun 2018 09:19:51 -0000 1.66 +++ openacs-4/packages/xotcl-core/tcl/cr-procs.tcl 22 Jun 2018 11:56:11 -0000 1.67 @@ -1019,8 +1019,8 @@ -revision_id $revision_id \ -publish_status $publish_status \ -is_latest $is_latest - ::xo::xotcl_object_cache flush ::${:item_id} - ::xo::xotcl_object_cache flush ::$revision_id + ::xo::xotcl_object_cache flush ${:item_id} + ::xo::xotcl_object_cache flush $revision_id } CrItem ad_instproc update_item_index {} { @@ -1475,7 +1475,7 @@ Because of this, we cannot simply create the instances of CrFolder using the "standard naming convention". Instead we create them as ::cr_folder } { - set object ::cr_folder$item_id + set object ::$item_id if {![:isobject $object]} { :fetch_object -object $object -item_id $item_id -initialize $initialize $object destroy_on_cleanup @@ -1548,7 +1548,7 @@ -folder_id ${:folder_id} \ -content_types [[self class] set allowed_content_types] } - ::xo::xotcl_object_cache flush ::${:parent_id} + ::xo::xotcl_object_cache flush ${:parent_id} # who is setting sub_folder_list? #db_flush_cache -cache_key_pattern sub_folder_list_* return ${:folder_id} @@ -1593,7 +1593,7 @@ -object:required {-initialize:boolean true} } { - set serialized_object [ns_cache eval xotcl_object_cache $object { + set serialized_object [::xo::xotcl_object_cache eval [string trimleft $object :] { # :log "--CACHE true fetch [self args], call shadowed method [self next]" set loaded_from_db 1 # Call the showdowed method with initializing turned off. We @@ -1626,7 +1626,7 @@ CrCache instproc delete {-item_id} { next - ::xo::xotcl_object_cache flush ::$item_id + ::xo::xotcl_object_cache flush $item_id # we should probably flush as well cached revisions } @@ -1697,7 +1697,7 @@ # cache only names with IDs set obj [self] set canonical_name ::[$obj item_id] - ::xo::xotcl_object_cache flush $obj + ::xo::xotcl_object_cache flush [string trimleft $obj :] if {$obj eq $canonical_name} { # :log "--CACHE saving $obj in cache" # @@ -1712,21 +1712,22 @@ set mixins [$obj info mixin] $obj mixin [list] set npv [$obj remove_non_persistent_vars] - ns_cache set xotcl_object_cache $obj [$obj serialize] + ::xo::xotcl_object_cache set [string trimleft $obj :] [$obj serialize] $obj set_non_persistent_vars $npv $obj mixin $mixins } else { # # In any case, flush the canonical name. # - ::xo::xotcl_object_cache flush $canonical_name + ::xo::xotcl_object_cache flush [string trimleft $canonical_name :] } # To be on he safe side, delete the revison as well from the # cache, if possible. if {[$obj exists revision_id]} { - set revision_name ::[$obj revision_id] - if {$obj ne $revision_name} { - ::xo::xotcl_object_cache flush $revision_name + set revision_id [$obj revision_id] + set revision_obj ::$revision_id + if {$obj ne $revision_obj} { + ::xo::xotcl_object_cache flush $revision_id } } } @@ -1746,16 +1747,10 @@ } CrCache::Item instproc save_new args { set item_id [next] - # - # The following approach will now work nicely, we would have to - # rename the object caching this does not seem important here, the - # next fetch will cache it anyhow. - # - #ns_cache set xotcl_object_cache $item_id [::Serializer deepSerialize [self]] return $item_id } CrCache::Item instproc delete args { - ::xo::xotcl_object_cache flush [self] + ::xo::xotcl_object_cache flush [string trimleft [self] :] # :msg "delete flush xotcl_object_type_cache ${:parent_id}-[:name]" ::xo::clusterwide ns_cache flush xotcl_object_type_cache ${:parent_id}-[:name] next Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -N -r1.165 -r1.166 --- openacs-4/packages/xowiki/xowiki.info 21 Jun 2018 07:23:56 -0000 1.165 +++ openacs-4/packages/xowiki/xowiki.info 22 Jun 2018 11:56:11 -0000 1.166 @@ -10,7 +10,7 @@ t xowiki - + Gustaf Neumann A xotcl-based enterprise wiki system with multiple object types 2017-08-06 @@ -55,10 +55,10 @@ BSD-Style 2 - + - + Index: openacs-4/packages/xowiki/tcl/package-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/package-procs.tcl,v diff -u -N -r1.320 -r1.321 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 21 Jun 2018 09:19:51 -0000 1.320 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 22 Jun 2018 11:56:11 -0000 1.321 @@ -2417,8 +2417,8 @@ } Package instproc delete_revision {-revision_id:required -item_id:required} { - ::xo::xotcl_object_cache flush ::$item_id - ::xo::xotcl_object_cache flush ::$revision_id + ::xo::xotcl_object_cache flush $item_id + ::xo::xotcl_object_cache flush $revision_id ::xo::db::sql::content_revision del -revision_id $revision_id } @@ -2567,7 +2567,7 @@ :flush_references -item_id $item_id -name $name -parent_id $parent_id :flush_page_fragment_cache -scope agg - ::xo::xotcl_object_cache flush ::$item_id + ::xo::xotcl_object_cache flush $item_id # # Clear potentially cached revisions. The function could be @@ -2577,7 +2577,7 @@ foreach revision_id [::xo::dc list get_revisions { select revision_id from cr_revisions where item_id = :item_id }] { - ::xo::xotcl_object_cache flush ::$revision_id + ::xo::xotcl_object_cache flush $revision_id } } Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -N -r1.526 -r1.527 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 21 Jun 2018 09:19:52 -0000 1.526 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 22 Jun 2018 11:56:11 -0000 1.527 @@ -3643,7 +3643,7 @@ $payload init } on error {errorMsg} { ad_log error "xowiki::Object set_payload: content $cmd lead to error: $errorMsg" - ::xo::xotcl_object_cache flush ::${:item_id} + ::xo::xotcl_object_cache flush ${:item_id} } } Index: openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl,v diff -u -N -r1.51 -r1.52 --- openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl 21 Jun 2018 09:19:52 -0000 1.51 +++ openacs-4/packages/xowiki/tcl/xowiki-utility-procs.tcl 22 Jun 2018 11:56:11 -0000 1.52 @@ -431,7 +431,7 @@ proc ::xowiki::page_order_uses_ltree {} { if {[::xo::dc has_ltree]} { - ns_cache eval xotcl_object_cache ::xowiki::page_order_uses_ltree { + ::xo::xotcl_object_type_cache eval ::xowiki::page_order_uses_ltree { return [::xo::dc get_value check_po_ltree { select count(*) from pg_attribute a, pg_type t, pg_class c where attname = 'page_order' and a.atttypid = t.oid and c.oid = a.attrelid @@ -484,9 +484,9 @@ ::xo::dc dml chg5 "update acs_objects set object_type = '::xowiki::FormPage' where object_id = :revision_id" ::xo::dc dml chg6 "update cr_items set content_type = '::xowiki::FormPage', publish_status = 'ready', live_revision = :revision_id, latest_revision = :revision_id where item_id = :item_id" - ::xo::xotcl_object_cache flush ::$package_id - ::xo::xotcl_object_cache flush ::$item_id - ::xo::xotcl_object_cache flush ::$revision_id + ::xo::xotcl_object_cache flush $package_id + ::xo::xotcl_object_cache flush $item_id + ::xo::xotcl_object_cache flush $revision_id ::xo::clusterwide ns_cache flush xotcl_object_type_cache root-folder-$package_id ::xo::clusterwide ns_cache flush xotcl_object_type_cache $item_id ::xo::clusterwide ns_cache flush xotcl_object_type_cache $revision_id @@ -821,8 +821,8 @@ #ns_log notice "--cpo UPDATE $page_id new_page_order $new_page_order" $temp_obj item_id $item_id $temp_obj update_attribute_from_slot -revision_id $page_id $slot $new_page_order - ::xo::xotcl_object_cache flush ::$item_id - ::xo::xotcl_object_cache flush ::$page_id + ::xo::xotcl_object_cache flush $item_id + ::xo::xotcl_object_cache flush $page_id } } #