Index: openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl,v diff -u -r1.24.2.3 -r1.24.2.4 --- openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl 9 Aug 2019 19:45:14 -0000 1.24.2.3 +++ openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl 19 Sep 2019 11:26:32 -0000 1.24.2.4 @@ -1,7 +1,7 @@ -# Motivations: +# Motivations: # # - Huge number of parameter_values in larger dotlrn installations -# Learn: currently > 0.3 mio entries, +# Learn: currently > 0.3 mio entries, # Galileo: > 2mio (2nd most frequent kind of object type) # Small oacs installations: 1000 objects (38 package instances) # @@ -14,13 +14,13 @@ # Most parameters are stored multiple times with the same values # (e.g. most dotlrn parameters > 4000 times on dotlrn; cause: # Cause: high number of communities. -# -# Do we really need to store 4000 times what the pretty-plural +# +# Do we really need to store 4000 times what the pretty-plural # string is one and the same string? # # - Most parameter_values are identical to default values # For 1 parameter in learn, we have 8 different values, for -# 4 parameters we have 3 different values, ... for most, +# 4 parameters we have 3 different values, ... for most, # all values are the same # # - Huge space improvements, when redundancy is removed. @@ -29,8 +29,8 @@ # => especially big savings on larger installations. # # Other shortcomings: -# -# - Existent design is 2 level: +# +# - Existent design is 2 level: # package-key provides default # package-instance keeps values (materialized cross-product) # @@ -54,14 +54,14 @@ # flexible) and is substantially faster (current implementation): # parameter get_from_package_key old: 172.92 new: 32.16 (5x) # parameter get old: 63.09 new: 31.29 (2x) -# -# The implementation uses the OpenACS datamodel (apm_packages, +# +# The implementation uses the OpenACS datamodel (apm_packages, # apm_package_values) and loads the parameters during startup. # -# Missing: +# Missing: # - definition of new parameters (based on ::xo::db interface) # - changing of per-package-key values -# - user interface +# - user interface # - alternate permissions for changing/deleting per-package-instance and # per-package-key values (simple approach: use swa for the latter) # @@ -74,8 +74,8 @@ # ::xo::Package (apm_package) # <- ::xowiki::Package # <- ::s5::Package -# -# package_parameter: +# +# package_parameter: # parameter_id package_key parameter_name default_value # 835 xowiki with_yahoo_publisher 0 # 2071 s5 with_yahoo_publisher 0 @@ -87,28 +87,28 @@ # Lookup for package_id=2075 "with_yahoo_publisher" # 1) lookup parameter_id for "with_yahoo_publisher" from s5 (::s5::Package) # 1.1) parameter_id exists for s5 => parameter_id=2071 -# lookup value for parameter_id=2071,package_id=2075 -# 1.1.1) value for parameter=2071 and package_id=2075 exists +# lookup value for parameter_id=2071,package_id=2075 +# 1.1.1) value for parameter=2071 and package_id=2075 exists # => return value -# 1.1.2) value for parameter=2071 and package_id=2075 does not exist +# 1.1.2) value for parameter=2071 and package_id=2075 does not exist # => return default value for parameter and package_key=s5 # 1.2) no parameter_id for s5 + "with_yahoo_publisher" # search for parameter_id in superclasses ... # # 2) lookup parameter_id for "with_yahoo_publisher" from superclass # 2.1) parameter_id exists for xowiki => parameter_id=835 -# lookup value for parameter_id=835,package_id=2075 -# 2.1.1) value for parameter=835 and package_id=2075 exists +# lookup value for parameter_id=835,package_id=2075 +# 2.1.1) value for parameter=835 and package_id=2075 exists # => return value -# 2.1.2) value for parameter=835 and package_id=2075 does not exist +# 2.1.2) value for parameter=835 and package_id=2075 does not exist # => return default value for parameter and package_key=xowiki # 2.2) no parameter_id for xowiki + "with_yahoo_publisher" # search for parameter_id in superclasses ... namespace eval ::xo { Class create ::xo::parameter - + # Every OpenACS parameter should work with the methods defined here. # So, fetch first the apm_parameter class from the definitions # in the database, and ... @@ -133,7 +133,7 @@ # TODO: Constraint_values are dummies for now. # # Should be for db::Attributes: - # constraint apm_parameters_datatype_ck + # constraint apm_parameters_datatype_ck # check(datatype in ('number', 'string','text')), # # Could be used directly for UI selections as well. @@ -185,13 +185,13 @@ if {[info exists :$key]} { return [set :$key] } - # + # # We did not find the parameter object for the current package # key. Loop up the parameter class (TODO: should be done from # object_type of package_id, but first, we have to store it # there). We simply iterate here of the classes of packages # (only a few exist). - # + # #:log "--p looking for $parameter_name in superclass of package_key=$package_key" set success 0 set pkg_class [::xo::PackageMgr get_package_class_from_package_key $package_key] @@ -206,7 +206,7 @@ } if {$retry} { # - # The parameter object was not found. Maybe this is a new + # The parameter object was not found. Maybe this is a new # parameter, not known in this thread. We try to load it # set r [::xo::db::apm_parameter instantiate_objects \ @@ -269,8 +269,8 @@ # Try to get the package id; if everything fails, use kernel_id # (to be compatible with traditional parameter::get) # - set package_id [expr {[nsf::is object ::xo::cc] ? - [::xo::cc package_id] : + set package_id [expr {[nsf::is object ::xo::cc] ? + [::xo::cc package_id] : [ns_conn isconnected] ? [ad_conn package_id] : [ad_acs_kernel_id]}] } set parameter_obj [:get_parameter_object -parameter_name $parameter -package_id $package_id -retry $retry] @@ -280,17 +280,41 @@ return $value } else { return $default - } + } } - + + parameter proc set_value { + -package_id + -parameter:required + -value:required + } { + + if {![info exists package_id]} { + # + # Try to get the package id; if everything fails, use kernel_id + # (to be compatible with traditional parameter::get) + # + set package_id [expr {[nsf::is object ::xo::cc] ? + [::xo::cc package_id] : + [ns_conn isconnected] ? [ad_conn package_id] : [ad_acs_kernel_id]}] + } + set parameter_obj [:get_parameter_object -parameter_name $parameter -package_id $package_id] + if {$parameter_obj ne ""} { + $parameter_obj set_per_package_instance_value $package_id $value + ::parameter::set_value -package_id $package_id -parameter MenuBar -value $value + } else { + error "could not create parameter object" + } + } + # # Methods for parameter instances # parameter instproc set_per_package_instance_value {package_id value} { set array [:per_package_id_name $package_id] nsv_set $array [:parameter_name] $value } - parameter instproc clear_per_package_instance_value {package_id value} { + parameter instproc clear_per_package_instance_value {package_id} { set array [:per_package_id_name $package_id] if {[nsv_exists $array [:parameter_name]]} { nsv_unset $array [:parameter_name] @@ -345,10 +369,10 @@ # Get those parameter values, which are different from the default and # remember these per package_id. xo::dc foreach get_non_default_values { - select p.parameter_id, p.package_key, v.package_id, p.parameter_name, - p.default_value, v.attr_value - from apm_parameters p, apm_parameter_values v - where p.parameter_id = v.parameter_id + select p.parameter_id, p.package_key, v.package_id, p.parameter_name, + p.default_value, v.attr_value + from apm_parameters p, apm_parameter_values v + where p.parameter_id = v.parameter_id and coalesce(attr_value,'') <> coalesce(p.default_value,'') } { # ns_log notice "--p $parameter_id $package_key $package_id $parameter_name <$attr_value>" @@ -367,7 +391,7 @@ -value:required } { Implementation of subsite::parameter_changed for xotcl param procs - + @param package_id the package_id of the package the parameter was changed for @param parameter the parameter name @param value the new value @@ -381,12 +405,12 @@ set parameter_obj [::xo::parameter get_parameter_object \ -package_key $package_key \ -parameter_name $parameter] - + if {$parameter_obj eq ""} { # We have still no parameter. There must be something significantly wrong. error "--parameter $parameter for package $package_key, package_id $package_id does not exist" } else { - $parameter_obj clear_per_package_instance_value $package_id $value + $parameter_obj clear_per_package_instance_value $package_id if {[$parameter_obj default_value] ne $value} { $parameter_obj set_per_package_instance_value $package_id $value } @@ -410,7 +434,7 @@ # ns_log notice "GET_PACKAGE_KEY old: [time $cmd1 100], new: [time $cmd2 100]" # set pid 4906 - # set pname trend-elements + # set pname trend-elements # ns_log notice "xotcl-request-monitor.$pname=[parameter get \ # -package_id $pid -parameter $pname]" # set cmd1 "::parameter::get -package_id $pid -parameter $pname" @@ -435,7 +459,7 @@ # $p append default_value "1" # $p save # $p delete - + } #