Index: openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl,v diff -u -r1.36 -r1.37 --- openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl 13 Dec 2017 20:42:31 -0000 1.36 +++ openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl 21 Mar 2018 18:48:13 -0000 1.37 @@ -153,13 +153,12 @@ foreach p [::xo::PackageMgr allinstances] { # Sanity check for old apps, having not set the package key. # TODO: remove this in future versions, when package_keys are enforced - if {![$p exists package_key]} { - ns_log notice "!!! You should provide a package_key for $p [$p info class] !!!" - continue - } + #if {![$p exists package_key]} { + # ns_log notice "!!! You should provide a package_key for $p [$p info class] !!!" + # continue + #} if {[$p package_key] eq $package_key} { - set $key $p - return $p + return [set $key $p] } } 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.20 -r1.21 --- openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl 19 Nov 2017 12:33:15 -0000 1.20 +++ openacs-4/packages/xotcl-core/tcl/06-param-procs.tcl 21 Mar 2018 18:48:13 -0000 1.21 @@ -164,34 +164,14 @@ } { return [apm_package_key_from_id $package_id] } - parameter proc get_package_id_from_package_key { - -package_key:required - } { + parameter proc get_package_id_from_package_key {-package_key:required} { return [ns_cache eval xotcl_object_type_cache package_id-$package_key { ::xo::dc get_value get_package_id \ [::xo::dc select -vars package_id -from apm_packages \ -where "package_key = :package_key" -limit 1] }] } - parameter proc get_package_class_from_package_key {-package_key:required} { - # Look up the parameter class from a package_key. - # 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). - set r "" - while {1} { - set r [ns_cache eval xotcl_object_type_cache package_class-$package_key { - foreach p [::xo::PackageMgr info instances] { - if {[$p set package_key] eq $package_key} { return $p } - } - break; # don't cache - }] - break - } - return $r - } - parameter proc get_parameter_object { -parameter_name:required -package_id @@ -216,7 +196,7 @@ # #my log "--p looking for $parameter_name in superclass of package_key=$package_key" set success 0 - set pkg_class [:get_package_class_from_package_key -package_key $package_key] + set pkg_class [::xo::PackageMgr get_package_class_from_package_key $package_key] if {$pkg_class ne ""} { set sc [$pkg_class info superclass] if {[$sc exists package_key]} {