Index: openacs-4/packages/acs-admin/acs-admin.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/acs-admin.info,v diff -u -N -r1.58.2.1 -r1.58.2.2 --- openacs-4/packages/acs-admin/acs-admin.info 17 May 2019 19:28:06 -0000 1.58.2.1 +++ openacs-4/packages/acs-admin/acs-admin.info 14 Feb 2020 13:42:12 -0000 1.58.2.2 @@ -9,7 +9,7 @@ f t - + Don Baccus An interface for Site-wide administration of an OpenACS Installation. 2017-08-06 @@ -20,7 +20,7 @@ GPL 3 - + Index: openacs-4/packages/acs-admin/tcl/site-wide-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/tcl/Attic/site-wide-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-admin/tcl/site-wide-procs.tcl 14 Feb 2020 13:42:12 -0000 1.1.2.1 @@ -0,0 +1,98 @@ +ad_library { + + Handling of site_wide packages, mostly for testing and + administration of the full site. + + @author Gustaf Neumann + @creation-date 13 Feb 2020 +} + +namespace eval ::acs_admin { + + ad_proc require_site_wide_subsite {} { + + Require the site_wide subsite for administration and testing purposes. + If the subsite does not exist, create it. + + @return package_id of the site_wide subsite + } { + set key ::acs_admin::site_wide_subsite + if {![info exists $key]} { + set subsite_name site-wide + set subsite_parent /acs-admin + set subsite_path $subsite_parent/$subsite_name + + if {[site_node::exists_p -url $subsite_path]} { + set node_info [site_node::get -url $subsite_path] + set subsite_id [dict get $node_info object_id] + } else { + set node_info [site_node::get -url $subsite_parent] + set subsite_id [site_node::instantiate_and_mount \ + -parent_node_id [dict get $node_info node_id] \ + -node_name $subsite_name \ + -package_name $subsite_name \ + -package_key acs-subsite] + } + set $key $subsite_id + } + return [set $key] + } + + ad_proc require_site_wide_package { + -package_key:required + -node_name + -package_name + {-parameters {}} + {-configuration_command {}} + } { + + Require a package under the site-wide subsite. If such a + package does not exist, it is created with the provided + parameters. When a configuratioon command is passed-in + it will be called with "-package_id $package_id" of the + new instance appended. + + @param package_key of the required package + @param node_name name of the mount point (defaults to the package_key) + @param package_name name of the package_instance (defaults to the package_key) + @param parameter package parameter for initialization of the package + @param configuration_command when a configuratio + + @return package_id of the required package + } { + if {![info exists node_name]} { + set node_name $package_key + } + if {![info exists package_name]} { + set package_name $package_key + } + set site_wide_subsite [::acs_admin::require_site_wide_subsite] + set node_info [site_node::get_from_object_id -object_id $site_wide_subsite] + + set path [dict get $node_info url]$node_name + if {[site_node::exists_p -url $path]} { + set node_info [site_node::get -url $path] + set package_id [dict get $node_info object_id] + } else { + set package_id [site_node::instantiate_and_mount \ + -parent_node_id [dict get $node_info node_id] \ + -node_name $node_name \ + -package_name $package_name \ + -package_key $package_key] + foreach {parameter value} $parameters { + parameter::set_value -package_id $package_id -parameter $parameter -value $value + } + if {[llength $configuration_command] > 0} { + {*}$configuration_command -package_id $package_id + } + } + return $package_id + } +} + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: 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.106.2.11 -r1.106.2.12 --- openacs-4/packages/xotcl-core/xotcl-core.info 3 Feb 2020 22:19:28 -0000 1.106.2.11 +++ openacs-4/packages/xotcl-core/xotcl-core.info 14 Feb 2020 13:42:12 -0000 1.106.2.12 @@ -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 @@ -33,7 +33,7 @@ - object life-time support (automatic cleanup when needed after request) - proxy objects for stored procedures/functions (PostgreSQL and Oracle) -- db-abstraction for PostgreSQL and Oracle (e.g. queries composition) +- db-abstraction for PostgreSQL and Oracle (e.g. query composition) - context-management: context objects for (connections and db-queries) - security policies - GUI and DOM support (via tdom) @@ -43,12 +43,13 @@ BSD-Style 2 - + + 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 -N -r1.41.2.10 -r1.41.2.11 --- openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl 29 Nov 2019 15:30:15 -0000 1.41.2.10 +++ openacs-4/packages/xotcl-core/tcl/06-package-procs.tcl 14 Feb 2020 13:42:12 -0000 1.41.2.11 @@ -10,11 +10,14 @@ # # Meta-Class for Application Package Classes # - Class create ::xo::PackageMgr \ -superclass ::xo::db::Class \ -parameter { package_key + {default_package_parameters ""} + {default_package_parameter_page_info ""} + {site_wide_package_parameters ""} + {site_wide_package_parameter_page_info ""} } PackageMgr ad_instproc first_instance {-privilege -party_id} { @@ -60,6 +63,196 @@ return [lsort -integer $result] } + PackageMgr instproc import_prototype_page { + -package_key:required + -name:required + -parent_id:required + -package_id:required + {-lang en} + {-add_revision:boolean true} + } { + set page "" + set fn [acs_root_dir]/packages/$package_key/www/prototypes/$name.page + #:log "--W check $fn" + if {[file readable $fn]} { + # + # We have the file of the prototype page. We try to create + # either a new item or a revision from definition in the file + # system. + # + if {[regexp {^(..):(.*)$} $name _ lang local_name]} { + set fullName $name + } else { + set fullName en:$name + } + :log "--sourcing page definition $fn, using name '$fullName'" + set page [source $fn] + $page configure \ + -name $fullName \ + -parent_id $parent_id \ + -package_id $package_id + # + # xowiki::File has a different interface for build-name to + # derive the "name" from a file-name. This is not important for + # prototype pages, so we skip it + # + if {![$page istype ::xowiki::File]} { + set nls_language [:get_nls_language_from_lang $lang] + $page name [$page build_name -nls_language $nls_language] + #:log "--altering name of page $page to '[$page name]'" + set fullName [$page name] + } + if {![$page exists title]} { + $page set title $object + } + $page destroy_on_cleanup + $page set_content [string trim [$page text] " \n"] + $page initialize_loaded_object + + set p [::$package_id get_page_from_name -name $fullName -parent_id $parent_id] + #:log "--get_page_from_name --> '$p'" + if {$p eq ""} { + # + # We have to create the page new. The page is completed with + # missing vars on save_new. + # + #:log "--save_new of $page class [$page info class]" + $page save_new + } else { + #:log "--save revision $add_revision" + if {$add_revision} { + # + # An old page exists already, create a revision. Update the + # existing page with all scalar variables from the prototype + # page (which is just partial) + # + foreach v [$page info vars] { + if {[$page array exists $v]} continue ;# don't copy arrays + $p set $v [$page set $v] + } + #:log "--save of $p class [$p info class]" + $p save + } + set page $p + } + if {$page ne ""} { + # we want to be able to address the page via the canonical name ::$item_id + set page [::xo::db::CrClass get_instance_from_db -item_id [$page item_id]] + } + } + return $page + } + + PackageMgr instproc require_site_wide_info {} { + if {![info exists :site_wide_info]} { + if {${:site_wide_package_parameter_page_info} ne ""} { + set cmd [list ::xowf::require_parameter_page \ + -name [dict get ${:site_wide_package_parameter_page_info} name] \ + -title [dict get ${:site_wide_package_parameter_page_info} title] \ + -instance_attributes [dict get ${:site_wide_package_parameter_page_info} instance_attributes]] + } else { + set cmd "" + } + set site_wide_instance_id [acs_admin::require_site_wide_package \ + -package_key ${:package_key} \ + -parameters ${:site_wide_package_parameters} \ + -configuration_command $cmd ] + ::xowiki::Package require $site_wide_instance_id + dict set :site_wide_info folder_id [::$site_wide_instance_id folder_id] + dict set :site_wide_info instance_id $site_wide_instance_id + } + return ${:site_wide_info} + } + + PackageMgr instproc require_site_wide_info {} { + if {![info exists :site_wide_info]} { + set cmd [list [self] configure_fresh_instance \ + -parameter_page_info ${:site_wide_package_parameter_page_info} \ + -parameters ${:site_wide_package_parameters} \ + ] + set site_wide_instance_id [acs_admin::require_site_wide_package \ + -package_key ${:package_key} \ + -configuration_command $cmd] + ::xowiki::Package require $site_wide_instance_id + dict set :site_wide_info folder_id [::$site_wide_instance_id folder_id] + dict set :site_wide_info instance_id $site_wide_instance_id + } + return ${:site_wide_info} + } + + PackageMgr instproc configure_fresh_instance { + {-package_id:required} + {-parameter_page_info ""} + {-parameters ""} + } { + if {[llength $parameter_page_info] > 0} { + ::xowf::require_parameter_page \ + -package_id $package_id \ + -name [dict get $parameter_page_info name] \ + -title [dict get $parameter_page_info title] \ + -instance_attributes [dict get $parameter_page_info instance_attributes] + } + # + # Configuring of the parameters is performed after the optional + # configuration of the parameter page, since by setting the + # package parameter "parameter_page" to a page that does not exist + # yet, would lead to errors. + # + if {[llength $parameters] > 0} { + foreach {parameter value} $parameters { + ::parameter::set_value \ + -package_id $package_id \ + -parameter $parameter \ + -value $value + } + } + } + + PackageMgr instproc require_site_wide_pages { + {-refetch:boolean false} + } { + set info [:require_site_wide_info] + foreach n {folder.form link.form page.form import-archive.form photo.form} { + set item_id [::xo::db::CrClass lookup -name en:$n -parent_id [dict get $info folder_id]] + #:log "lookup en:$n => $item_id" + if {!$item_id || $refetch} { + set page [:import_prototype_page \ + -name $n \ + -package_key ${:package_key} \ + -parent_id [dict get $info folder_id] \ + -package_id [dict get $info instance_id] ] + :log "Page en:$n loaded as '$page'" + } + } + } + + PackageMgr instproc lookup_side_wide_page {-name:required} { + set id [::xo::db::CrClass lookup \ + -name $name \ + -parent_id [dict get [:require_site_wide_info] folder_id]] + :log "lookup_side_wide_page <$name> uses [:require_site_wide_info] => $id" + return $id + } + + PackageMgr instproc get_site_wide_page {-name:required} { + set item_id [:lookup_side_wide_page -name $name] + # :ds "lookup from base objects $name => $item_id" + if {$item_id} { + set page [::xo::db::CrClass get_instance_from_db -item_id $item_id] + set package_id [$page package_id] + if {$package_id ne ""} { + #$form set_resolve_context -package_id $package_id -parent_id $parent_id + ::xo::Package require $package_id + } + + return $page + } + return "" + } + + + + PackageMgr ad_instproc initialize { -ad_doc {-parameter ""} Index: openacs-4/packages/xowf/xowf.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/xowf.info,v diff -u -N -r1.12.2.8 -r1.12.2.9 --- openacs-4/packages/xowf/xowf.info 3 Feb 2020 23:00:23 -0000 1.12.2.8 +++ openacs-4/packages/xowf/xowf.info 14 Feb 2020 13:42:12 -0000 1.12.2.9 @@ -10,15 +10,15 @@ t xowf - + Gustaf Neumann XoWiki Content Flow - an XoWiki based workflow system implementing state-based behavior of wiki pages and forms 2017-08-06 WU Vienna 2 - - + + Index: openacs-4/packages/xowf/tcl/xowf-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/xowf-callback-procs.tcl,v diff -u -N -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/xowf/tcl/xowf-callback-procs.tcl 8 May 2019 14:38:41 -0000 1.1.2.1 +++ openacs-4/packages/xowf/tcl/xowf-callback-procs.tcl 14 Feb 2020 13:42:12 -0000 1.1.2.2 @@ -12,41 +12,15 @@ Callback when this an xowf instance is created } { ns_log notice "++++ BEGIN ::xowf::after-instantiate -package_id $package_id" - # General setup - ::xo::Package initialize -package_id $package_id - set folder_id [::$package_id folder_id] - + # # Create a parameter page for convenience # - set pform_id [::xowiki::Weblog instantiate_forms -forms en:Parameter.form \ - -package_id $package_id] + ::xowf::Package configure_fresh_instance \ + -package_id $package_id \ + -parameters [::xowf::Package default_package_parameters] \ + -parameter_page_info [::xowf::Package default_package_parameter_page_info] - ::xo::db::sql::content_item set_live_revision \ - -revision_id [::$pform_id revision_id] \ - -publish_status production - - set ia { - MenuBar t top_includelet none production_mode t with_user_tracking t with_general_comments f - with_digg f with_tags f - ExtraMenuEntries {{entry -name New.Extra.Workflow -label "#xowf.menu-New-Extra-Workflow#" -form /en:Workflow.form}} - with_delicious f with_notifications f security_policy ::xowiki::policy1 - } - - set parameter_page_name en:xowf-default-parameter - set p [::$pform_id create_form_page_instance \ - -name $parameter_page_name \ - -nls_language en_US \ - -default_variables [list title "XoWf Default Parameter" parent_id $folder_id \ - package_id $package_id instance_attributes $ia]] - $p save_new - - # - # Make the parameter page the default - # - parameter::set_value -package_id $package_id -parameter parameter_page -value $parameter_page_name - callback subsite::parameter_changed -package_id $package_id -parameter parameter_page -value $parameter_page_name - ns_log notice "++++ END ::xowf::after-instantiate -package_id $package_id" } } Index: openacs-4/packages/xowf/tcl/xowf-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/xowf-init.tcl,v diff -u -N -r1.3.2.2 -r1.3.2.3 --- openacs-4/packages/xowf/tcl/xowf-init.tcl 9 Sep 2019 17:05:09 -0000 1.3.2.2 +++ openacs-4/packages/xowf/tcl/xowf-init.tcl 14 Feb 2020 13:42:12 -0000 1.3.2.3 @@ -1,5 +1,6 @@ -if {[info commands ::ns_cache_eval] eq ""} {proc ::ns_cache_eval {args} {::ns_cache eval {*}$args}} -# register the dav interface for the todos +# +# Register the dav interface for the todo handler. +# ::xowf::dav-todo register # Index: openacs-4/packages/xowf/tcl/xowf-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/xowf-procs.tcl,v diff -u -N -r1.28.2.24 -r1.28.2.25 --- openacs-4/packages/xowf/tcl/xowf-procs.tcl 7 Feb 2020 08:44:05 -0000 1.28.2.24 +++ openacs-4/packages/xowf/tcl/xowf-procs.tcl 14 Feb 2020 13:42:12 -0000 1.28.2.25 @@ -27,8 +27,40 @@ -package_key "xowf" -pretty_name "XoWiki Workflow" \ -superclass ::xowiki::Package + Package site_wide_package_parameter_page_info { + name en:xowf-site-wide-parameter + title "Xowf Site-wide Parameter" + instance_attributes { + index_page table-of-contents + MenuBar t + top_includelet none + production_mode t + with_user_tracking t with_general_comments f with_digg f with_tags f + with_delicious f with_notifications f + security_policy ::xowiki::policy1 + }} + + Package site_wide_package_parameters { + parameter_page en:xowf-site-wide-parameter + } + + Package default_package_parameters { + parameter_page en:xowf-default-parameter + } + + Package default_package_parameter_page_info { + name en:xowf-default-parameter + title "Xowf Default Parameter" + instance_attributes { + MenuBar t top_includelet none production_mode t with_user_tracking t with_general_comments f + with_digg f with_tags f + ExtraMenuEntries {{entry -name New.Extra.Workflow -form /en:Workflow.form}} + with_delicious f with_notifications f security_policy ::xowiki::policy1 + } + } + Package ad_instproc initialize {} { - mixin ::xowf::WorkflowPage to every FormPage + Add mixin ::xowf::WorkflowPage to every FormPage. } { # # This method is called, whenever an xowf package is initialized. Index: openacs-4/packages/xowf/www/prototypes/Parameter.form.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/www/prototypes/Parameter.form.page,v diff -u -N --- openacs-4/packages/xowf/www/prototypes/Parameter.form.page 7 Aug 2017 23:48:30 -0000 1.3 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,34 +0,0 @@ -# -*- tcl-*- -::xowiki::Form new \ - -set name en:Parameter.form \ - -title "XoWiki Parameter Form" \ - -set anon_instances t \ - -set text {} \ - -set form {{
-@MenuBar@ -@top_includelet@ -@production_mode@ -@with_delicious@ @with_digg@ @with_general_comments@ -@with_notifications@ @with_tags@ @with_user_tracking@ -@ExtraMenuEntries@ @security_policy@ -@_description@ @_nls_language@ -
} text/html} \ - -set form_constraints { -MenuBar:boolean,horizontal=true -top_includelet:text,default=none -{_title:text,default=Parameter Page} -_creator:hidden -production_mode:boolean,horizontal=true,default=t -with_delicious:boolean,horizontal=true,default=f -with_digg:boolean,horizontal=true,default=f -{with_general_comments:boolean,horizontal=true,default=f,label=User Comments} -with_notifications:boolean,horizontal=true,default=f -with_tags:boolean,horizontal=true,default=f -with_user_tracking:boolean,horizontal=true -_page_order:omit _description:omit -{ExtraMenuEntries:textarea,cols=80,rows=4,default={form_link -name New.Extra.Workflow -label "#xowf.menu-New-Extra-Workflow#" -form en:workflow.form}} -security_policy:security_policy,default=::xowiki::policy1 -} - - - Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -N -r1.180.2.31 -r1.180.2.32 --- openacs-4/packages/xowiki/xowiki.info 3 Feb 2020 22:49:12 -0000 1.180.2.31 +++ openacs-4/packages/xowiki/xowiki.info 14 Feb 2020 13:42:12 -0000 1.180.2.32 @@ -10,7 +10,7 @@ t xowiki - + Gustaf Neumann A xotcl-based enterprise wiki system with multiple object types 2017-08-06 @@ -55,8 +55,8 @@ 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.332.2.44 -r1.332.2.45 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 25 Jan 2020 13:40:39 -0000 1.332.2.44 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 14 Feb 2020 13:42:12 -0000 1.332.2.45 @@ -16,10 +16,15 @@ {folder_id 0} {force_refresh_login false} } - # {folder_id "[::xo::cc query_parameter folder_id 0]"} - if {[apm_version_names_compare [ad_acs_version] 5.2] <= -1} { - error "We require at least OpenACS Version 5.2; current version is [ad_acs_version]" + Package site_wide_package_parameters { + MenuBar 1 + index_page table-of-contents + top_includelet "" + with_general_comments 0 + with_notifications 0 + with_tags 0 + with_user_tracking 0 } Package ad_proc get_package_id_from_page_id { @@ -1973,17 +1978,29 @@ } if {!$(item_id) && $use_prototype_pages} { - array set "" [:item_ref \ - -normalize_name false \ - -default_lang $default_lang \ - -parent_id $parent_id \ - $link] - set page [::xowiki::Package import_prototype_page \ - -package_key [:package_key] \ - -name $(stripped_name) \ - -parent_id $(parent_id) \ - -package_id ${:id} ] - #:msg "import_prototype_page for '$(stripped_name)' => '$page'" + set item_info [:item_ref \ + -normalize_name false \ + -default_lang $default_lang \ + -parent_id $parent_id \ + $link] + foreach pkgClass [${:id} info precedence] { + if {[$pkgClass exists package_key]} { + set package_key [$pkgClass package_key] + if {$package_key ne "apm_package"} { + set page [::xowiki::Package import_prototype_page \ + -package_key $package_key \ + -name [dict get $item_info stripped_name] \ + -parent_id [dict get $item_info parent_id] \ + -package_id ${:id} ] + if {$page ne ""} { + :log "loading prototype page for [dict get $item_info stripped_name] from $package_key" + break + } + } + } + } + #:msg "import_prototype_page for '[dict get $item_info stripped_name]' => '$page'" + if {$page ne ""} { # we want to be able to address the page via ::$item_id set page [::xo::db::CrClass get_instance_from_db -item_id [$page item_id]] @@ -2033,138 +2050,49 @@ } } - Package proc import_prototype_page { - -package_key:required - -name:required - -parent_id:required - -package_id:required - {-lang en} - {-add_revision:boolean true} - } { - set page "" - set fn [acs_root_dir]/packages/$package_key/www/prototypes/$name.page - #:log "--W check $fn" - if {[file readable $fn]} { - # - # We have the file of the prototype page. We try to create - # either a new item or a revision from definition in the file - # system. - # - if {[regexp {^(..):(.*)$} $name _ lang local_name]} { - set fullName $name - } else { - set fullName en:$name - } - :log "--sourcing page definition $fn, using name '$fullName'" - set page [source $fn] - $page configure \ - -name $fullName \ - -parent_id $parent_id \ - -package_id $package_id - # - # xowiki::File has a different interface for build-name to - # derive the "name" from a file-name. This is not important for - # prototype pages, so we skip it - # - if {![$page istype ::xowiki::File]} { - set nls_language [:get_nls_language_from_lang $lang] - $page name [$page build_name -nls_language $nls_language] - #:log "--altering name of page $page to '[$page name]'" - set fullName [$page name] - } - if {![$page exists title]} { - $page set title $object - } - $page destroy_on_cleanup - $page set_content [string trim [$page text] " \n"] - $page initialize_loaded_object - - set p [::$package_id get_page_from_name -name $fullName -parent_id $parent_id] - #:log "--get_page_from_name --> '$p'" - if {$p eq ""} { + Package proc reparent_site_wide_pages {} { + # + # Reparent the site_wide pages from parent_id -100 to the + # site_wide xowiki instance. Reparenting is necessary to keep the + # relations to form instances. + # + # This is transitional code (just for the move). It is safe to + # execute this method multiple times. + # + set site_info [:require_site_wide_info] + set parent_id [dict get $site_info folder_id] + set page_info [::xo::dc list_of_lists get_site_wide_pages { + select item_id,name from cr_items + where parent_id = -100 + and content_type like '::%' + and name not like 'xowiki: %'; + }] + xo::dc transaction { + foreach {item_id name} [concat {*}$page_info] { # - # We have to create the page new. The page is completed with - # missing vars on save_new. + # Avoid potential name clashes in case require_site_wide_pages + # was already run and has populated the site. # - #:log "--save_new of $page class [$page info class]" - $page save_new - } else { - #:log "--save revision $add_revision" - if {$add_revision} { - # - # An old page exists already, create a revision. Update the - # existing page with all scalar variables from the prototype - # page (which is just partial) - # - foreach v [$page info vars] { - if {[$page array exists $v]} continue ;# don't copy arrays - $p set $v [$page set $v] - } - #:log "--save of $p class [$p info class]" - $p save + xo::dc dml maybe_delete_page { + delete from cr_items where parent_id = :parent_id and name = :name } - set page $p + # + # Reparent page (identified by item_id) to site_wide instance + # + xo::dc dml reparent_page { + update cr_items set parent_id = :parent_id where item_id = :item_id + } } - if {$page ne ""} { - # we want to be able to address the page via the canonical name ::$item_id - set page [::xo::db::CrClass get_instance_from_db -item_id [$page item_id]] - } } - return $page } - Package proc require_site_wide_pages { - {-refetch:boolean false} - } { - set parent_id -100 - set package_id [::xowiki::Package first_instance] - ::xowiki::Package require $package_id - #::xowiki::Package initialize -package_id $package_id -init_url false -keep_cc true - set package_key "xowiki" - foreach n {folder.form link.form page.form import-archive.form photo.form} { - set item_id [::xo::db::CrClass lookup -name en:$n -parent_id $parent_id] - #:log "lookup en:$n => $item_id" - if {!$item_id || $refetch} { - set page [::xowiki::Package import_prototype_page \ - -name $n \ - -package_key $package_key \ - -parent_id $parent_id \ - -package_id $package_id ] - :log "Page en:$n loaded as '$page'" - } - } - } - Package proc preferredCSSToolkit {} { return [parameter::get_global_value -package_key xowiki \ -parameter PreferredCSSToolkit \ -default bootstrap] } - Package proc lookup_side_wide_page {-name:required} { - return [::xo::db::CrClass lookup \ - -name $name \ - -parent_id -100 \ - -content_type "::%"] - } - - Package proc get_site_wide_page {-name:required} { - set item_id [:lookup_side_wide_page -name $name] - # :ds "lookup from base objects $name => $item_id" - if {$item_id} { - set page [::xo::db::CrClass get_instance_from_db -item_id $item_id] - set package_id [$page package_id] - if {$package_id ne ""} { - #$form set_resolve_context -package_id $package_id -parent_id $parent_id - ::xo::Package require $package_id - } - - return $page - } - return "" - } - Package instproc call {object method options} { set allowed [${:policy} enforce_permissions \ -package_id ${:id} -user_id [::xo::cc user_id] \ Index: openacs-4/packages/xowiki/tcl/parameter-page-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/Attic/parameter-page-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/tcl/parameter-page-procs.tcl 14 Feb 2020 13:42:12 -0000 1.1.2.1 @@ -0,0 +1,92 @@ +::xo::library doc { + xowiki - procs for working with parameter pages. + + @creation-date 2020-02-13 + @author Gustaf Neumann +} + +namespace eval ::xowiki { + ad_proc require_parameter_page { + -name:required + -package_id:required + -parent_id + {-title "Parameter Page"} + {-instance_attributes ""} + {-form en:Parameter.form} + {-publish_status production} + } { + + Create or up update a parameter page. This is a convenience + method to ease the interaction with parameter pages. + + } { + ::xo::Package require $package_id + + if {![info exists parent_id]} { + set parent_id [::$package_id folder_id] + } + + set item_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id] + if {$item_id == 0} { + # + # We have to create the parameter page new.... + # Get first the parameter form + # + set page [::$package_id get_page_from_item_ref \ + -use_prototype_pages true \ + -use_package_path true \ + -parent_id $parent_id \ + $form] + if {$page eq ""} { + error "cannot instantiate $form" + } + + #ns_log notice FORM=[$page serialize] + + if {[$page publish_status] ne $publish_status} { + ns_log notice "form $form: change publish_status -> $publish_status" + ::xo::db::sql::content_item set_live_revision \ + -revision_id [::$page revision_id] \ + -publish_status $publish_status + } + + set instance_vars [list title $title parent_id $parent_id \ + package_id $package_id \ + instance_attributes $instance_attributes] + ad_try { + ns_log notice "form $form: try to create form page $name" + ::$page create_form_page_instance \ + -name $name \ + -package_id $package_id \ + -parent_id $parent_id \ + -nls_language en_US \ + -default_variables $instance_vars + } on error {errorMsg} { + error "cannot create instance named '$name' of form $form" + } on ok {p} { + ns_log notice "form $form: try to create form page $name DONE, do a save_new" + $p save_new + ns_log notice "form $form: try to create form page $name DONE, do a save_new DONE" + } + } else { + # + # The parameter page exists already. Get the old instance + # attributes, add the new ones and save the page + # + set p [::xowiki::FormPage get_instance_from_db -item_id $item_id] + $p title $title + $p instance_attributes [dict merge [$p instance_attributes] $instance_attributes] + $p save + ns_log notice "form $form: updated parameter page saved." + } + } +} + + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: + Index: openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl,v diff -u -N -r1.15.2.8 -r1.15.2.9 --- openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl 5 Oct 2019 13:24:53 -0000 1.15.2.8 +++ openacs-4/packages/xowiki/tcl/upgrade/upgrade.tcl 14 Feb 2020 13:42:12 -0000 1.15.2.9 @@ -834,6 +834,13 @@ ::xowiki::Package require_site_wide_pages -refetch true } + set v 5.10.0d49 + if {[apm_version_names_compare $from_version_name $v] == -1 && + [apm_version_names_compare $to_version_name $v] > -1} { + ns_log notice "-- upgrading to $v" + ::xowiki::Package reparent_site_wide_pages + } + } } Index: openacs-4/packages/xowiki/www/prototypes/Parameter.form.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/Attic/Parameter.form.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/Parameter.form.page 14 Feb 2020 13:42:12 -0000 1.1.2.1 @@ -0,0 +1,34 @@ +# -*- tcl-*- +::xowiki::Form new \ + -set name en:Parameter.form \ + -title "XoWiki Parameter Form" \ + -set anon_instances t \ + -set text {} \ + -set form {{
+@MenuBar@ +@top_includelet@ +@production_mode@ +@with_delicious@ @with_digg@ @with_general_comments@ +@with_notifications@ @with_tags@ @with_user_tracking@ +@ExtraMenuEntries@ @security_policy@ +@_description@ @_nls_language@ +
} text/html} \ + -set form_constraints { +MenuBar:boolean,horizontal=true +top_includelet:text,default=none +{_title:text,default=Parameter Page} +_creator:hidden +production_mode:boolean,horizontal=true,default=t +with_delicious:boolean,horizontal=true,default=f +with_digg:boolean,horizontal=true,default=f +{with_general_comments:boolean,horizontal=true,default=f,label=User Comments} +with_notifications:boolean,horizontal=true,default=f +with_tags:boolean,horizontal=true,default=f +with_user_tracking:boolean,horizontal=true +_page_order:omit _description:omit +{ExtraMenuEntries:textarea,cols=80,rows=4,default={form_link -name New.Extra.Workflow -label "#xowf.menu-New-Extra-Workflow#" -form en:workflow.form}} +security_policy:security_policy,default=::xowiki::policy1 +} + + + Index: openacs-4/packages/xowiki/www/prototypes/table-of-contents.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/Attic/table-of-contents.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/table-of-contents.page 14 Feb 2020 13:42:12 -0000 1.1.2.1 @@ -0,0 +1,6 @@ +::xowiki::Page new -title "Table of Contents" -text {{{child-resources -publish_status all}}} + + + + +