Index: openacs-4/packages/acs-tcl/tcl/site-nodes-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-init.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/acs-tcl/tcl/site-nodes-init.tcl 13 Mar 2001 22:59:26 -0000 1.1 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-init.tcl 20 Jun 2002 22:58:18 -0000 1.2 @@ -2,7 +2,8 @@ @author rhs@mit.edu @creation-date 2000-09-07 - @cvs-id $Id$ + @version $Id$ + } -site_nodes_sync +site_node::init_cache Index: openacs-4/packages/acs-tcl/tcl/site-nodes-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-procs-oracle.xql,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs-oracle.xql 3 Feb 2002 13:31:27 -0000 1.6 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs-oracle.xql 20 Jun 2002 22:58:18 -0000 1.7 @@ -1,67 +1,57 @@ - oracle8.1.6 + oracle8.1.6 - - - begin - :1 := site_node.new ( - node_id => :new_node_id, - parent_id => :parent_node_id, - name => :name, - directory_p => :directory_p, - pattern_p => :pattern_p, - creation_user => :user_id, - creation_ip => :ip_address - ); - end; - - + + + select site_node.url(site_nodes.node_id) as url, + site_nodes.node_id, + site_nodes.directory_p, + site_nodes.pattern_p, + site_nodes.object_id, + (select acs_objects.object_type + from acs_objects + where acs_objects.object_id = site_nodes.object_id) as object_type, + apm_packages.package_key, + apm_packages.package_id + from site_nodes, + apm_packages + where site_nodes.object_id = apm_packages.package_id(+) + + - - + + + select site_node.url(site_nodes.node_id) as url, + site_nodes.node_id, + site_nodes.directory_p, + site_nodes.pattern_p, + site_nodes.object_id, + (select acs_objects.object_type + from acs_objects + where acs_objects.object_id = site_nodes.object_id) as object_type, + apm_packages.package_key, + apm_packages.package_id + from site_nodes, + apm_packages + where site_nodes.node_id = :node_id + and site_nodes.object_id = apm_packages.package_id(+) + + - select site_node.url(n.node_id) as url, n.node_id, n.directory_p, - n.pattern_p, n.object_id, o.object_type, n.package_key, n.package_id - from acs_objects o, (select n.node_id, n.directory_p, n.pattern_p, n.object_id, p.package_key, p.package_id - from site_nodes n, apm_packages p - where n.object_id = p.package_id (+) ) n - where n.object_id = o.object_id (+) - - - + + + select site_node.url(node_id) + from site_nodes + where object_id = :subsite_pkg_id + + - - - - - begin - :1 := site_node.new ( - parent_id => :parent_node_id, - name => :instance_name, - directory_p => 't', - pattern_p => 't' - ); - end; - - - + + + begin site_node.delete(:node_id); end; + + - - - - select site_node.url(node_id) from site_nodes where object_id=:subsite_pkg_id - - - - - - - - begin site_node.delete(:node_id); end; - - - - Index: openacs-4/packages/acs-tcl/tcl/site-nodes-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-procs-postgresql.xql,v diff -u -r1.9 -r1.10 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs-postgresql.xql 1 Feb 2002 15:16:20 -0000 1.9 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs-postgresql.xql 20 Jun 2002 22:58:18 -0000 1.10 @@ -1,70 +1,53 @@ - postgresql7.1 + postgresql7.1 - - + + + select site_node.url(site_nodes.node_id) as url, + site_nodes.node_id, + site_nodes.directory_p, + site_nodes.pattern_p, + site_nodes.object_id, + (select acs_objects.object_type + from acs_objects + where acs_objects.object_id = site_nodes.object_id) as object_type, + apm_packages.package_key, + apm_packages.package_id + from site_nodes left join apm_packages on site_nodes.object_id = apm_packages.package_id + + -select site_node__url(n.node_id) as url, n.node_id, n.directory_p, - n.pattern_p, n.object_id, o.object_type, p.package_key, - p.package_id - from site_nodes n - left join acs_objects o on n.object_id=o.object_id - left join apm_packages p - on n.object_id = p.package_id - - - + + + select site_node.url(site_nodes.node_id) as url, + site_nodes.node_id, + site_nodes.directory_p, + site_nodes.pattern_p, + site_nodes.object_id, + (select acs_objects.object_type + from acs_objects + where acs_objects.object_id = site_nodes.object_id) as object_type, + apm_packages.package_key, + apm_packages.package_id + from site_nodes left join apm_packages on site_nodes.object_id = apm_packages.package_id + where site_nodes.node_id = :node_id + + - - - -select site_node__new ( - :new_node_id, - :parent_node_id, - :name, - NULL, - :directory_p, - :pattern_p, - :user_id, - :ip_address - ) - - + + + select site_node__url(node_id) + from site_nodes + where object_id = :subsite_pkg_id + + - - + + + select site_node__delete(:node_id); + + - select site_node__new ( - null, - :parent_node_id, - :instance_name, - null, - 't', - 't', - null, - null - ); - - - - - - - - select site_node__url(node_id) from site_nodes where object_id=:subsite_pkg_id - - - - - - - - select site_node__delete(:node_id); - - - - - 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.6 -r1.7 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 12 May 2002 20:57:02 -0000 1.6 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 20 Jun 2002 22:58:18 -0000 1.7 @@ -1,131 +1,325 @@ -ad_library {n - Tcl procs for interface with the site-node data model. +ad_library { - @author rhs@mit.edu - @creation-date 2000-09-06 - @cvs-id $Id$ + site node api + + @author rhs@mit.edu + @author yon (yon@openforce.net) + @creation-date 2000-09-06 + @version $Id$ + } +namespace eval site_node { -ad_proc -public site_node_create { + ad_proc -public new { + {-name:required} + {-parent_id:required} + {-directory_p t} + {-pattern_p t} + } { + create a new site node + } { + set extra_vars [ns_set create] + ns_set put $extra_vars name $name + ns_set put $extra_vars parent_id $parent_id + ns_set put $extra_vars directory_p $directory_p + ns_set put $extra_vars pattern_p $pattern_p + + set node_id [package_instantiate_object -extra_vars $extra_vars site_node] + + update_cache -node_id $node_id + + return $node_id + } + + ad_proc -public new_with_package { + {-name:required} + {-parent_id:required} + {-package_key:required} + {-instance_name:required} + {-context_id:required} + } { + create site node, instantiate package, mount package at new site node + } { + set node_id [new -name $name -parent_id $parent_id] + + set package_id [apm_package_create_instance $instance_name $context_id $package_key] + + mount -node_id $node_id -object_id $package_id + + update_cache -node_id $node_id + + # call post instantiation proc for the package + apm_package_call_post_instantiation_proc $package_id $package_key + + return $package_id + } + + ad_proc -public mount { + {-node_id:required} + {-object_id:required} + } { + mount object at site node + } { + db_dml mount_object {} + update_cache -node_id $node_id + } + + ad_proc -public unmount { + {-node_id:required} + } { + unmount an object from the site node + } { + db_dml unmount_object {} + update_cache -node_id $node_id + } + + ad_proc -private init_cache {} { + initialize the site node cache + } { + nsv_array reset site_nodes [list] + + db_foreach select_site_nodes {} { + set node(url) $url + set node(node_id) $node_id + set node(directory_p) $directory_p + set node(pattern_p) $pattern_p + set node(object_id) $object_id + set node(object_type) $object_type + set node(package_key) $package_key + set node(package_id) $package_id + + nsv_set site_nodes $url [array get node] + } + + ns_eval { + global tcl_site_nodes + if {[info exists tcl_site_nodes]} { + unset tcl_site_nodes + } + } + } + + ad_proc -private update_cache { + {-node_id:required} + } { + if {[db_0or1row select_site_node {}]} { + set node(url) $url + set node(node_id) $node_id + set node(directory_p) $directory_p + set node(pattern_p) $pattern_p + set node(object_id) $object_id + set node(object_type) $object_type + set node(package_key) $package_key + set node(package_id) $package_id + + nsv_set site_nodes $url [array get node] + + ns_eval { + global tcl_site_nodes + if {[info exists tcl_site_nodes]} { + array unset tcl_site_nodes "${url}*" + } + } + } + } + + ad_proc -public get { + {-url:required} + } { + returns an array representing the site node that matches the given url + } { + # attempt an exact match + if {[nsv_exists site_nodes $url]} { + return [nsv_get site_nodes $url] + } + + # attempt adding a / to the end of the url if it doesn't already have + # one + if {![string equal [string index $url end] "/"]} { + append url "/" + if {[nsv_exists site_nodes $url]} { + return [nsv_get site_nodes $url] + } + } + + # chomp off part of the url and re-attempt + while {![empty_string_p $url]} { + set url [string trimright $url /] + set url [string range $url 0 [string last / $url]] + + if {[nsv_exists site_nodes $url]} { + array set node [nsv_get site_nodes $url] + + if {[string equal $node(pattern_p) t] && ![empty_string_p $node(object_id)]} { + return [array get node] + } + } + } + + error "site node not found at url $url" + } + +} + +ad_proc -deprecated site_node_create { {-new_node_id ""} {-directory_p "t"} {-pattern_p "t"} parent_node_id name } { - Create a new site node. - Returns the node_id + Create a new site node. Returns the node_id + @see site_node::new } { - # Generate an ID if we need one - if {[empty_string_p $new_node_id]} { - set new_node_id [db_nextval acs_object_id_seq] - } + return [site_node::new \ + -name $name \ + -parent_id $parent_node_id \ + -directory_p $directory_p \ + -pattern_p $pattern_p \ + ] +} - set user_id [ad_verify_and_get_user_id] - set ip_address [ad_conn peeraddr] +ad_proc -deprecated site_node_create_package_instance { + { -package_id 0 } + { -sync_p "t" } + node_id + instance_name + context_id + package_key +} { + Creates a new instance of the specified package and flushes the + in-memory site map (if sync_p is t). - set node_id [db_exec_plsql node_new {}] + DRB: I've modified this so it doesn't call the package's post instantiation proc until + after the site node map is updated. Delaying the call in this way allows the package to + find itself in the map. The code that mounts a subsite, in particular, needs to be able + to do this so it can find the nearest parent node that defines an application group (the + code in aD ACS 4.2 was flat-out broken). - return $node_id + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 2001-02-05 + + @return The package_id of the newly mounted package +} { + set package_id [apm_package_create_instance $instance_name $context_id $package_key] + + site_node::mount -node_id $node_id -object_id $package_id + + apm_package_call_post_instantiation_proc $package_id $package_key + + return $package_id } -ad_proc -public site_nodes_sync {args} { - Brings the in memory copy of the url hierarchy in sync with the - database version. +ad_proc -public site_node_delete_package_instance { + {-node_id:required} } { - if { [util_memoize_cached_p {site_nodes_sync_helper}] } { - util_memoize_flush {site_nodes_sync_helper} - } - nsv_array reset site_nodes [util_memoize {site_nodes_sync_helper}] - ns_eval { - global tcl_site_nodes - if {[info exists tcl_site_nodes]} { - unset tcl_site_nodes - } - } + Wrapper for apm_package_instance_delete + @author Arjun Sanyal (arjun@openforc.net) + @creation-date 2002-05-02 +} { + db_transaction { + set package_id [site_nodes::get_package_id_from_node_id -node_id $node_id] + site_node::unmount -node_id $node_id + apm_package_instance_delete $package_id + } } -ad_proc -private site_nodes_sync_helper {args} { - Brings the in memory copy of the url hierarchy in sync with the - database version. +ad_proc -public site_node_mount_application { + {-sync_p "t"} + {-return "package_id"} + parent_node_id + instance_name + package_key + package_name } { - db_foreach nodes_select { - select site_node.url(n.node_id) as url, n.node_id, n.directory_p, - n.pattern_p, n.object_id, o.object_type, n.package_key, n.package_id - from acs_objects o, (select n.node_id, n.directory_p, n.pattern_p, n.object_id, p.package_key, p.package_id - from site_nodes n, apm_packages p - where n.object_id = p.package_id) n - where n.object_id = o.object_id (+) - } { + Creates a new instance of the specified package and mounts it + beneath parent_node_id. - set val(url) $url - set val(node_id) $node_id - set val(directory_p) $directory_p - set val(pattern_p) $pattern_p - set val(object_id) $object_id - set val(object_type) $object_type - set val(package_key) $package_key - set val(package_id) $package_id + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 2001-02-05 - set nodes($url) [array get val] - } - return [array get nodes] -} + @param sync_p If "t", we flush the in-memory site map + @param return You can specify what is returned: the package_id or node_id + (now ignored, always return package_id) + @param parent_node_id The node under which we are mounting this + application + @param instance_name The instance name for the new site node + @param package_key The type of package we are mounting + @param package_name The name we want to give the package we are + mounting. + @return The package id of the newly mounted package or the new + node id, based on the value of $return +} { + # if there is an object mounted at the parent_node_id then use that + # object_id, instead of the parent_node_id, as the context_id + if {![db_0or1row get_context {}]} { + set context_id $parent_node_id + } -ad_proc -public site_node {url} { - Returns an array in the form of a list. This array contains - url, node_id, directory_p, pattern_p, and object_id for the - given url. If no node is found then this will throw an error. + return [site_node::new_with_package \ + -name $instance_name \ + -parent_id $parent_node_id \ + -package_key $package_key \ + -instance_name $package_name \ + -context_id $context_id \ + ] +} + +ad_proc -public site_map_unmount_application { + { -sync_p "t" } + { -delete_p "f" } + node_id } { + Unmounts the specified node. - # Try the URL as is. - if {[catch {nsv_get site_nodes $url} result] == 0} { - return $result - } + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 2001-02-07 - # Add a trailing slash and try again. - if {[string index $url end] != "/"} { - append url "/" - if {[catch {nsv_get site_nodes $url} result] == 0} { - return $result - } - } + @param sync_p If "t", we flush the in-memory site map + @param delete_p If "t", we attempt to delete the site node. This + will fail if you have not cleaned up child nodes + @param node_id The node_id to unmount - # Try successively shorter prefixes. - while {$url != ""} { - # Chop off last component and try again. - set url [string trimright $url /] - set url [string range $url 0 [string last / $url]] - - if {[catch {nsv_get site_nodes $url} result] == 0} { - array set node $result - if {$node(pattern_p) == "t" && $node(object_id) != ""} { - return $result - } +} { + db_transaction { + site_node::unmount -node_id $node_id + + if {[string equal $delete_p t]} { + db_exec_plsql node_delete {} + } } - } +} - error "site node not found" +ad_proc -deprecated site_node {url} { + Returns an array in the form of a list. This array contains + url, node_id, directory_p, pattern_p, and object_id for the + given url. If no node is found then this will throw an error. +} { + return [site_node::get -url $url] } - ad_proc -public site_node_id {url} { - Returns the node_id of a site node. Throws an error if there is no - matching node. + Returns the node_id of a site node. Throws an error if there is no + matching node. } { - array set node [site_node $url] - return $node(node_id) + array set node [site_node::get -url $url] + return $node(node_id) } +ad_proc -public site_nodes_sync {args} { + Brings the in memory copy of the url hierarchy in sync with the + database version. +} { + site_node::init_cache +} - ad_proc -public site_node_closest_ancestor_package { { -default "" } { -url "" } - package_key + package_key } { Finds the package id of a package of specified type that is closest to the node id represented by url (or by ad_conn url).Note @@ -153,9 +347,10 @@ such package can be found. } { - if { [empty_string_p $url] } { + if {[empty_string_p $url]} { set url [ad_conn url] } + # Try the URL as is. if {[catch {nsv_get site_nodes $url} result] == 0} { array set node $result @@ -192,10 +387,9 @@ return $default } - ad_proc -public site_node_closest_ancestor_package_url { { -default "" } - { -package_key "acs-subsite" } + { -package_key "acs-subsite" } } { Returns the url stub of the nearest application of the specified type. @@ -209,181 +403,10 @@ } { set subsite_pkg_id [site_node_closest_ancestor_package $package_key] - if { [empty_string_p $subsite_pkg_id] } { + if {[empty_string_p $subsite_pkg_id]} { # No package was found... return the default return $default } - return [db_string select_url { - select site_node.url(node_id) from site_nodes where object_id=:subsite_pkg_id - } -default ""] -} -ad_proc -public site_node_create_package_instance { - { -package_id 0 } - { -sync_p "t" } - node_id - instance_name - context_id - package_key -} { - Creates a new instance of the specified package and flushes the - in-memory site map (if sync_p is t). - - DRB: I've modified this so it doesn't call the package's post instantiation proc until - after the site node map is updated. Delaying the call in this way allows the package to - find itself in the map. The code that mounts a subsite, in particular, needs to be able - to do this so it can find the nearest parent node that defines an application group (the - code in aD ACS 4.2 was flat-out broken). - - @author Michael Bryzek (mbryzek@arsdigita.com) - @creation-date 2001-02-05 - - @return The package_id of the newly mounted package -} { - - # Create the package. - - set package_id [apm_package_create_instance $instance_name $context_id $package_key] - - # Update the site map - db_dml update_site_nodes { - update site_nodes - set object_id = :package_id - where node_id = :node_id - } - - # Flush the in-memory site node map - if { [string eq $sync_p "t"] } { - site_nodes_sync - } - - apm_package_call_post_instantiation_proc $package_id $package_key - - return $package_id - + return [db_string select_url {} -default ""] } - -ad_proc -public site_node_delete_package_instance { - {-node_id:required} -} { - Wrapper for apm_package_instance_delete - - @author Arjun Sanyal (arjun@openforc.net) - @creation-date 2002-05-02 -} { - db_transaction { - - set package_id \ - [site_nodes::get_package_id_from_node_id -node_id $node_id] - - # Update the site map - db_dml unmount { - update site_nodes - set object_id = null - where node_id = :node_id - } - - apm_package_instance_delete $package_id - - } -} - -ad_proc -public site_node_mount_application { - { -sync_p "t" } - { -return "package_id" } - parent_node_id - instance_name - package_key - package_name -} { - Creates a new instance of the specified package and mounts it - beneath parent_node_id. - - @author Michael Bryzek (mbryzek@arsdigita.com) - @creation-date 2001-02-05 - - @param sync_p If "t", we flush the in-memory site map - @param return You can specify what is returned: the package_id or node_id - @param parent_node_id The node under which we are mounting this - application - @param instance_name The instance name for the new site node - @param package_key The type of package we are mounting - @param package_name The name we want to give the package we are - mounting. - @return The package id of the newly mounted package or the new - node id, based on the value of $return - -} { - - # First create the new node beneath parent_node_id - set node_id [db_exec_plsql create_node { - begin - :1 := site_node.new ( - parent_id => :parent_node_id, - name => :instance_name, - directory_p => 't', - pattern_p => 't' - ); - end; - }] - - # If there is an object mounted at the parent_node_id - # then use that object_id, instead of the parent_node_id, - # as the context_id - if { ![db_0or1row get_context { - select object_id as context_id - from site_nodes - where node_id = :parent_node_id - }] } { - set context_id $parent_node_id - } - - set package_id [site_node_create_package_instance -sync_p $sync_p $node_id $package_name $context_id $package_key] - - if { [string eq $return "package_id"] } { - return $package_id - } elseif { [string eq $return "node_id"] } { - return $node_id - } elseif { [string eq $return "package_id,node_id"] } { - return [list $package_id $node_id] - } - - error "Unknown return key: $return. Must be either package_id, node_id" -} - - -ad_proc -public site_map_unmount_application { - { -sync_p "t" } - { -delete_p "f" } - node_id -} { - Unmounts the specified node. - - @author Michael Bryzek (mbryzek@arsdigita.com) - @creation-date 2001-02-07 - - - @param sync_p If "t", we flush the in-memory site map - @param delete_p If "t", we attempt to delete the site node. This - will fail if you have not cleaned up child nodes - @param node_id The node_id to unmount - -} { - db_dml unmount { - update site_nodes - set object_id = null - where node_id = :node_id - } - - if { [string eq $delete_p "t"] } { - # Delete the node from the site map - db_exec_plsql node_delete { - begin site_node.delete(:node_id); end; - } - } - - if { [string eq $sync_p "t"] } { - site_nodes_sync - } -} - Index: openacs-4/packages/acs-tcl/tcl/site-nodes-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-procs.xql,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.xql 1 Dec 2001 17:55:16 -0000 1.3 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.xql 20 Jun 2002 22:58:18 -0000 1.4 @@ -1,36 +1,37 @@ - - - - update site_nodes - set object_id = :package_id - where node_id = :node_id - - - + + + update site_nodes + set object_id = :object_id + where node_id = :node_id + + - - - - - select object_id as context_id - from site_nodes - where node_id = :parent_node_id - - - + + + update site_nodes + set object_id = null + where node_id = :node_id + + - - - - - update site_nodes - set object_id = null - where node_id = :node_id + + + select object_id as context_id + from site_nodes + where node_id = :parent_node_id + + + - - + + + update site_nodes + set object_id = null + where node_id = :node_id + +