Index: openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl,v diff -u -r1.12.2.2 -r1.12.2.3 --- openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl 22 Nov 2019 18:41:34 -0000 1.12.2.2 +++ openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl 22 Nov 2019 20:18:39 -0000 1.12.2.3 @@ -35,10 +35,20 @@ } if { $node_id ne "" } { + # # The package is mounted, unmount it and delete it together - # with the site node + # with the site node. + # site_node::unmount -node_id $node_id - site_node::unmount_services -node_id $node_id + # + # Since we do not want to delete the potentially shared + # service packages, delete just the service nodes but not the + # packages behind it. + # + site_node::delete_service_nodes -node_id $node_id + # + # Finally, delete the site-nodes and the packages under it. + # site_node::delete -node_id $node_id \ -delete_subnodes -delete_package } else { Index: openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl,v diff -u -r1.141.2.8 -r1.141.2.9 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 22 Nov 2019 18:41:34 -0000 1.141.2.8 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 22 Nov 2019 20:18:39 -0000 1.141.2.9 @@ -133,21 +133,26 @@ return $node_id } -ad_proc -public site_node::unmount_services { +ad_proc -public site_node::delete_service_nodes { {-node_id:required} } { - unmount all shared packages under this site_node + Unmount and delete all (shared) service packages under this + site_node. + + @param node_id starting node_id } { - set sub_node_ids [site_node::get_children \ - -node_id $node_id] - foreach sub_node_id $sub_node_ids { + set sub_node_urls [site_node::get_children \ + -node_id $node_id] + foreach sub_node_url $sub_node_urls{ + set sub_node_id [site_node::get_element -url $sub_node_url -element node_id] set package_id [site_node::get_object_id -node_id $sub_node_id] if {$package_id ne "" && [db_0or1row is_apm_service { select 1 from apm_services where where service_id = :package_id }]} { site_node::unmount -node_id $sub_node_id + site_node::delete -node_id $sub_node_id } } } @@ -627,14 +632,14 @@ } { Returns 1 if a site node exists at the given url and 0 otherwise. The provided URL has to start with a slash. - + @param url URL path starting with a slash. @author Peter Marklund } { ns_log notice "OLD nsv-based site_node::exists_p <$url>" - - + + set url_no_trailing [string trimright $url "/"] return [nsv_exists site_nodes "$url_no_trailing/"] }