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.19 -r1.20 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs-oracle.xql 20 Jan 2008 15:27:30 -0000 1.19 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs-oracle.xql 11 Apr 2008 22:37:12 -0000 1.20 @@ -20,8 +20,7 @@ p.package_key, p.package_id, p.instance_name, - t.package_type, - (select count(*) from site_nodes where parent_id = n.node_id) as num_children + t.package_type from apm_packages p, apm_package_types t, (select node_id, parent_id, name, directory_p, pattern_p, object_id, @@ -35,29 +34,6 @@ - - - select n.node_id, - n.parent_id, - n.name, - n.directory_p, - n.pattern_p, - n.object_id, - p.package_key, - p.package_id, - p.instance_name, - t.package_type, - (select count(*) from site_nodes where parent_id = n.node_id) as num_children - from apm_packages p, - apm_package_types t, - site_nodes n - where n.object_id = p.package_id(+) - and t.package_key (+) = p.package_key - and (n.node_id = :node_id or n.parent_id = :node_id) - order by n.node_id - - - select n.node_id, @@ -69,8 +45,7 @@ p.package_key, p.package_id, p.instance_name, - t.package_type, - (select count(*) from site_nodes where parent_id = n.node_id) as num_children + t.package_type from apm_packages p, apm_package_types t, site_nodes n where n.node_id = :node_id and n.object_id = p.package_id(+) 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.19 -r1.20 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs-postgresql.xql 13 Mar 2007 09:09:04 -0000 1.19 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs-postgresql.xql 11 Apr 2008 22:37:12 -0000 1.20 @@ -20,8 +20,7 @@ p.package_key, p.package_id, p.instance_name, - t.package_type, - (select count(*) from site_nodes where parent_id = n.node_id) as num_children + t.package_type from site_nodes n left join apm_packages p on n.object_id = p.package_id left join apm_package_types t using (package_key) @@ -31,27 +30,6 @@ - - - select n.node_id, - n.parent_id, - n.name, - n.directory_p, - n.pattern_p, - n.object_id, - p.package_key, - p.package_id, - p.instance_name, - t.package_type, - (select count(*) from site_nodes where parent_id = n.node_id) as num_children - from site_nodes n left join - apm_packages p on n.object_id = p.package_id left join - apm_package_types t using (package_key) - where n.node_id = :node_id or n.parent_id = :node_id - order by n.tree_sortkey - - - select n.node_id, @@ -63,8 +41,7 @@ p.package_key, p.package_id, p.instance_name, - t.package_type, - (select count(*) from site_nodes where parent_id = n.node_id) as num_children + t.package_type from site_nodes n left join apm_packages p on n.object_id = p.package_id left join apm_package_types t using (package_key) 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.82 -r1.83 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 21 Aug 2007 13:58:19 -0000 1.82 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 11 Apr 2008 22:37:12 -0000 1.83 @@ -49,7 +49,7 @@ with_finally -code { set url [site_node::get_url -node_id $parent_id] append url $name - if { $directory_p eq "t" } { append url "/" } + if { $directory_p == "t" } { append url "/" } nsv_set site_node_url_by_node_id $node_id $url nsv_set site_nodes $url \ [list url $url node_id $node_id parent_id $parent_id name $name \ @@ -60,7 +60,7 @@ } -finally { ns_mutex unlock [nsv_get site_nodes_mutex mutex] } - + return $node_id } @@ -112,7 +112,7 @@ instance_name $instance_name package_type $package_type] set url_by_object_id [list $node(url)] - if { [nsv_exists site_node_url_by_object_id $object_id] && $url_by_object_id ne [nsv_get site_node_url_by_object_id $object_id] } { + if { [nsv_exists site_node_url_by_object_id $object_id] } { set url_by_object_id [concat [nsv_get site_node_url_by_object_id $object_id] $url_by_object_id] set url_by_object_id [lsort \ -decreasing \ @@ -121,7 +121,7 @@ } nsv_set site_node_url_by_object_id $object_id $url_by_object_id - if { $package_key ne "" } { + if { ![empty_string_p $package_key] } { set url_by_package_key [list $node(url)] if { [nsv_exists site_node_url_by_package_key $package_key] } { set url_by_package_key [concat [nsv_get site_node_url_by_package_key $package_key] $url_by_package_key] @@ -159,7 +159,7 @@ db_dml rename_node {} db_dml update_object_title {} - update_cache -node_id $node_id + update_cache -sync_children -node_id $node_id } ad_proc -public site_node::instantiate_and_mount { @@ -189,14 +189,14 @@ @author Peter Marklund } { # Create a new node if none was provided and none exists - if { $node_id eq "" } { + if { [empty_string_p $node_id] } { # Default parent node to the main site - if { $parent_node_id eq "" } { + if { [empty_string_p $parent_node_id ] } { set parent_node_id [site_node::get_node_id -url "/"] } # Default node_name to package_key - if { $node_name eq "" } { + if { [empty_string_p $node_name] } { set node_name $package_key } @@ -219,7 +219,7 @@ } # Default context id to the closest ancestor package_id - if { $context_id eq "" } { + if { [empty_string_p $context_id] } { set context_id [site_node::closest_ancestor_package -node_id $node_id] } @@ -257,47 +257,23 @@ nsv_array reset site_node_url_by_object_id [list] nsv_array reset site_node_url_by_package_key [list] - set root_node_id [site_node::get_root_node_id] - if { $root_node_id ne "" } { - site_node::update_cache -node_id $root_node_id + set root_node_id [db_string get_root_node_id {} -default {}] + if { ![empty_string_p $root_node_id] } { + site_node::update_cache -sync_children -node_id $root_node_id } - - # Update the cache for the mounted packages except acs-subsite - db_foreach acs_nodes {select node_id from site_nodes s, apm_packages where parent_id = :root_node_id and s.object_id = package_id and package_key != 'acs-subsite'} { - site_node::update_cache -node_id $node_id -sync_children - } } -ad_proc -public site_node::get_root_node_id { -} { - Returns the root node id of the site -} { - util_memoize [list site_node::get_root_node_id_not_cached] -} - -ad_proc -public site_node::get_root_node_id_not_cached { -} { - Returns the root node id of the site -} { - return [db_string get_root_node_id {} -default {}] -} - ad_proc -private site_node::update_cache { {-sync_children:boolean} {-node_id:required} - {-sync_direct_children:boolean} - {-no_mutex:boolean} } { Brings the in memory copy of the site nodes hierarchy in sync with the database version. Only updates the given node and its children. } { - if {$no_mutex_p eq 0} { - # don't let any other thread try to do a concurrent update - # until cache is fully updated - ns_mutex lock [nsv_get site_nodes_mutex mutex] - } + # don't let any other thread try to do a concurrent update + # until cache is fully updated + ns_mutex lock [nsv_get site_nodes_mutex mutex] - ns_log Debug "Updating URL:: $node_id :: $sync_children_p :: $sync_direct_children_p" with_finally -code { array set nodes [nsv_array get site_nodes] @@ -323,7 +299,7 @@ # Find the object_id previously mounted there set cur_object_id $cur_node(object_id) - if { $cur_object_id ne "" } { + if { ![empty_string_p $cur_object_id] } { # Remove the URL from the url_by_object_id entry for that object_id set cur_idx [lsearch -exact $url_by_object_id($cur_object_id) $cur_node_url] if { $cur_idx != -1 } { @@ -334,7 +310,7 @@ # Find the package_key previously mounted there set cur_package_key $cur_node(package_key) - if { $cur_package_key ne "" } { + if { ![empty_string_p $cur_package_key] } { # Remove the URL from the url_by_package_key entry for that package_key set cur_idx [lsearch -exact $url_by_package_key($cur_package_key) $cur_node_url] if { $cur_idx != -1 } { @@ -353,92 +329,42 @@ if { $sync_children_p } { set query_name select_child_site_nodes - set mounted_children all - } elseif { $sync_direct_children_p} { - set query_name select_direct_child_site_nodes - set mounted_children one } else { set query_name select_site_node - set mounted_children none } - set orig_node_id $node_id - - # Because you can run out of db pools if this proc - # is called for too many parent nodes this needs to - # be run through a foreach tcl loop and cannot - # use db_foreach - foreach item [db_list_of_lists $query_name {}] { - util_unlist $item node_id parent_id name directory_p pattern_p object_id package_key package_id instance_name package_type num_children - - if {$parent_id eq ""} { + db_foreach $query_name {} { + if {[empty_string_p $parent_id]} { # url of root node set url "/" } else { # append directory to url of parent node - # Check that the parent is in the cache - if {![exists_and_not_null url_by_node_id($parent_id)]} { - site_node::update_cache -node_id $parent_id -no_mutex - array set url_by_node_id [nsv_array get site_node_url_by_node_id] - } set url $url_by_node_id($parent_id) append url $name - if { $directory_p eq "t" } { append url "/" } + if { $directory_p == "t" } { append url "/" } } # save new url set url_by_node_id($node_id) $url - if { $object_id ne "" } { - if {[info exists url_by_object_id($object_id)]} { - if {[lsearch $url_by_object_id($object_id) $url] < 0} { - lappend url_by_object_id($object_id) $url - } - } else { - set url_by_object_id($object_id) $url - } + if { ![empty_string_p $object_id] } { + lappend url_by_object_id($object_id) $url } - if { $package_key ne "" } { + if { ![empty_string_p $package_key] } { lappend url_by_package_key($package_key) $url } - if { $package_id eq "" } { + if { [empty_string_p $package_id] } { set object_type "" } else { set object_type "apm_package" } - switch $mounted_children { - all { set mounted_children_p 1 } - one { - # Only set mounted_children for the node, as we only node it's children - if {$orig_node_id == $node_id} { - set mounted_children_p 1 - } else { - set mounted_children_p 0 - } - } - default { - set mounted_children_p 0 - } - } - - if { $num_children eq 0 } { - set has_children_p 0 - # It has no children, so we can save that all children are mounted - set mounted_children_p 1 - } else { - set has_children_p 1 - } - - - ns_log Debug "Update cache:: $url :: node_id: $node_id :: $orig_node_id :: $has_children_p :: $mounted_children_p :: $mounted_children" # save new node set nodes($url) \ [list url $url node_id $node_id parent_id $parent_id name $name \ directory_p $directory_p pattern_p $pattern_p \ object_id $object_id object_type $object_type \ package_key $package_key package_id $package_id \ - instance_name $instance_name package_type $package_type \ - has_children_p $has_children_p mounted_children_p $mounted_children_p] + instance_name $instance_name package_type $package_type] } # AG: This lsort used to live in the db_foreach loop above. I moved it here @@ -475,16 +401,16 @@ The array elements are: package_id, package_key, object_type, directory_p, instance_name, pattern_p, parent_id, node_id, object_id, url. } { - if {$url eq "" && $node_id eq ""} { + if {[empty_string_p $url] && [empty_string_p $node_id]} { error "site_node::get \"must pass in either url or node_id\"" } - if {$node_id ne ""} { - return [site_node::get_from_node_id -node_id $node_id] + if {![empty_string_p $node_id]} { + return [get_from_node_id -node_id $node_id] } - if {$url ne ""} { - return [site_node::get_from_url -url $url] + if {![empty_string_p $url]} { + return [get_from_url -url $url] } } @@ -529,104 +455,38 @@ first match found by successively removing the trailing $url path component.

@see site_node::get - - @param url URL to retrieve the site node from - @param exact Switch which will prevent us from trying to find the parent site_node - @param retry Notes that the procedure is being called by itself. This is to prevent a loop. } { - set orig_url $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 index $url end] ne "/" } { + if {![string equal [string index $url end] "/"]} { append url "/" if {[nsv_exists site_nodes $url]} { - return [nsv_get site_nodes $url] + return [nsv_get site_nodes $url] } } - set url_list [split [string trim "$orig_url" "/"] "/"] - set url_list_length [llength $url_list] + # chomp off part of the url and re-attempt + if {!$exact_p} { + while {![empty_string_p $url]} { + set url [string trimright $url /] + set url [string range $url 0 [string last / $url]] - # We could not find it directly, so we have to go from top to bottom, trying to load the side node cache - # Obviously try to do this only once - set new_url "" - set parent_id [site_node::get_root_node_id] + if {[nsv_exists site_nodes $url]} { + array set node [nsv_get site_nodes $url] - # Skip this for all subsite urls of the root node - set subsite_list [list resources file image x o shared register images] - set root_url [lindex $url_list 0] - - if {[lsearch -exact $subsite_list $root_url] > -1} { - # This is a root URL for acs-subsite - return [nsv_get site_nodes /] - } - - # Set a counter to figure out if we are at the last element - # We need the last element because, if it is the last element, then the check down below is different - set counter 0 - - foreach name $url_list { - incr counter - set node_id "" - if {$name ne ""} { - # Append the current name to the url to test - set test_url "${new_url}/$name" - - # If the site node is in the cache, continue - if {[nsv_exists site_nodes $test_url] || [nsv_exists site_nodes "${test_url}/"]} { - # It is already in the cache, just continue - # Set the new_url to the test_url and update the parent_id - set new_url $test_url - set parent_id [site_node::get_node_id -url $new_url] - } else { - - # Try loading it from the database - # Do this only if we have children marked with the parent - # Exclude all parents who have been marked with having already all children mounted. - - array set new_node [nsv_get site_nodes "${new_url}/"] - # Check if the site_node has children in the first place - if {![exists_and_not_null new_node(has_children_p)]} { - set new_node(has_children_p) 1 - set new_node(mounted_children_p) 0 - } - - if {$new_node(has_children_p) && !$new_node(mounted_children_p)} { - if {[lsearch -exact $subsite_list $name] > -1} { - set node_id $parent_id - } else { - set node_id [db_string node_id "select node_id from site_nodes where parent_id = :parent_id and name=:name" -default ""] - ns_log Debug "Loading from the database $test_url $name $parent_id" - } - } else { - set node_id "" - } - - - if {$node_id ne ""} { - site_node::update_cache -node_id $node_id -sync_direct_children - if {$counter eq $url_list_length} { - # This is the last element, return the site_node - return [nsv_get site_nodes "${test_url}/"] - } else { - set parent_id $node_id - set new_url $test_url - } - } else { - # Okay, it is not in the database, but maybe the new_url itself is in the cache - # So we can just return it. - if {[nsv_exists site_nodes "${new_url}/"]} { - return [nsv_get site_nodes "${new_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 -public site_node::exists_p { @@ -637,7 +497,6 @@ @author Peter Marklund } { set url_no_trailing [string trimright $url "/"] - return [nsv_exists site_nodes "$url_no_trailing/"] } @@ -679,19 +538,12 @@ set url "" if {[nsv_exists site_node_url_by_node_id $node_id]} { set url [nsv_get site_node_url_by_node_id $node_id] - } else { - # The node was not found, update the cache with the node to be on the save side - site_node::update_cache -node_id $node_id - if {[nsv_exists site_node_url_by_node_id $node_id]} { - # And try again - set url [nsv_get site_node_url_by_node_id $node_id] - } } if { $notrailing_p } { set url [string trimright $url "/"] } - + return $url } @@ -707,15 +559,7 @@ if { [nsv_exists site_node_url_by_object_id $object_id] } { return [nsv_get site_node_url_by_object_id $object_id] } else { - # Try to load it from the database - set node_id [db_string get_node_id {} -default ""] - if {$node_id ne ""} { - # Update the cache and return the result - site_node::update_cache -node_id $node_id - return [nsv_get site_node_url_by_object_id $object_id] - } else { - return [list] - } + return [list] } } @@ -724,7 +568,7 @@ } { return the node_id for this url } { - array set node [site_node::get_from_url -url $url] + array set node [get -url $url] return $node(node_id) } @@ -734,7 +578,7 @@ return the site node id associated with the given object_id } { set url [lindex [get_url_from_object_id -object_id $object_id] 0] - if { $url ne "" } { + if { ![empty_string_p $url] } { return [get_node_id -url $url] } else { return {} @@ -768,7 +612,7 @@ set result [list] set array_result_p [string equal $element ""] - while {$node_id ne "" } { + while {![string equal $node_id ""]} { array set node [get -node_id $node_id] if {$array_result_p} { @@ -830,38 +674,19 @@ @author Lars Pind (lars@collaboraid.biz) } { - if { $package_type ne "" && $package_key ne "" } { + if { ![empty_string_p $package_type] && ![empty_string_p $package_key] } { error "You may specify either package_type, package_key, or filter_element, but not more than one." } - if { $package_type ne "" } { + if { ![empty_string_p $package_type] } { lappend filters package_type $package_type - } elseif { $package_key ne "" } { + } elseif { ![empty_string_p $package_key] } { lappend filters package_key $package_key } - # Check if the node_id is already in the cache - array set node [site_node::get -node_id $node_id] + set node_url [site_node::get_url -node_id $node_id] - # Check if the site_node has children in the first place - if {![exists_and_not_null node(has_children_p)]} { - site_node::update_cache -node_id $node_id - array set node [site_node::get -node_id $node_id] - } - - if {!$node(has_children_p)} { - return "" - } - - set node_url $node(url) - if { !$all_p } { - - if {!$node(mounted_children_p)} { - # The site_node was not mounted with all it's children - site_node::update_cache -node_id $node_id -sync_direct_children - } - set child_urls [list] set s [string length "$node_url"] # find all child_urls who have only one path element below node_id @@ -873,13 +698,6 @@ } } } else { - - if {!$node(mounted_children_p)} { - # Update the site_node cache as we do not know if all children are already in the cache - # Once we have a children_p flag in the nsv_array, this might get easier to accomplish - site_node::update_cache -node_id $node_id -sync_children - } - set node_url [site_node::get_url -node_id $node_id] set child_urls [nsv_array names site_nodes "${node_url}?*"] } @@ -892,21 +710,21 @@ set passed_p 1 foreach { elm val } $filters { - if { $site_node($elm) ne $val } { + if { ![string equal $site_node($elm) $val] } { set passed_p 0 break } } if { $passed_p } { - if { $element ne "" } { + if { ![empty_string_p $element] } { lappend return_val $site_node($element) } else { lappend return_val $child_url } } } } - } elseif { $element ne "" } { + } elseif { ![empty_string_p $element] } { set return_val [list] foreach child_url $child_urls { array unset site_node @@ -918,7 +736,7 @@ # if we had filters or were getting a particular element then we # have our results in return_val otherwise it's just urls - if { $element ne "" + if { ![empty_string_p $element] || [llength $filters] > 0} { return $return_val } else { @@ -958,16 +776,16 @@ @author Peter Marklund } { # Make sure we have a url to work with - if { $url eq "" } { - if { $node_id eq "" } { + if { [empty_string_p $url] } { + if { [empty_string_p $node_id] } { set url "/" } else { set url [site_node::get_url -node_id $node_id] } } # should we return the package at the passed-in node/url? - if { $include_self_p && $package_key ne ""} { + if { $include_self_p && ![empty_string_p $package_key]} { array set node_array [site_node::get -url $url] if { [lsearch -exact $package_key $node_array(package_key)] != -1 } { @@ -976,15 +794,15 @@ } set elm_value {} - while { $elm_value eq "" && $url ne "/"} { + while { [empty_string_p $elm_value] && $url != "/"} { # move up a level set url [string trimright $url /] set url [string range $url 0 [string last / $url]] array set node_array [site_node::get -url $url] # are we looking for a specific package_key? - if { $package_key eq "" || \ + if { [empty_string_p $package_key] || \ [lsearch -exact $package_key $node_array(package_key)] != -1 } { set elm_value $node_array($element) } @@ -1028,7 +846,7 @@ set existing_urls [site_node::get_children -node_id $parent_node_id -element name] array set parent_node [site_node::get -node_id $parent_node_id] - if { $parent_node(package_key) ne "" } { + if { ![empty_string_p $parent_node(package_key)] } { # Find all the page or directory names under this package foreach path [glob -nocomplain -types d "[acs_package_root_dir $parent_node(package_key)]/www/*"] { lappend existing_urls [lindex [file split $path] end] @@ -1044,10 +862,10 @@ } } - if { $folder ne "" } { + if { ![empty_string_p $folder] } { if { [lsearch $existing_urls $folder] != -1 } { # The folder is on the list - if { $current_node_id eq "" } { + if { [empty_string_p $current_node_id] } { # New node: Complain return {} } else { @@ -1062,7 +880,7 @@ } } else { # Autogenerate folder name - if { $instance_name eq "" } { + if { [empty_string_p $instance_name] } { error "Instance name must be supplied when folder name is empty." } @@ -1116,7 +934,7 @@ db_transaction { site_node::unmount -node_id $node_id - if {$delete_p eq "t"} { + if {[string equal $delete_p t]} { site_node::delete -node_id $node_id } } @@ -1177,7 +995,7 @@ @see site_node::closest_ancestor_package } { - if {$url eq ""} { + if {[empty_string_p $url]} { set url [ad_conn url] } @@ -1190,7 +1008,7 @@ } # Add a trailing slash and try again. - if {[string index $url end] ne "/"} { + if {[string index $url end] != "/"} { append url "/" if {[catch {nsv_get site_nodes $url} result] == 0} { array set node $result @@ -1201,14 +1019,14 @@ } # Try successively shorter prefixes. - while {$url ne ""} { + 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) eq "t" && $node(object_id) ne "" && [lsearch -exact $package_keys $node(package_key)] != -1 } { + if {$node(pattern_p) == "t" && $node(object_id) != "" && [lsearch -exact $package_keys $node(package_key)] != -1 } { return $node(package_id) } } @@ -1233,7 +1051,7 @@ @see site::node::closest_ancestor_package } { - if {$package_key eq ""} { + if {[empty_string_p $package_key]} { set package_key [subsite::package_keys] } @@ -1242,7 +1060,7 @@ -package_key $package_key \ -url [ad_conn url] ] - if {$subsite_pkg_id eq ""} { + if {[empty_string_p $subsite_pkg_id]} { # No package was found... return the default return $default } 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.13 -r1.14 --- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.xql 13 Mar 2007 09:09:04 -0000 1.13 +++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.xql 11 Apr 2008 22:37:12 -0000 1.14 @@ -58,20 +58,12 @@ - + select node_id from site_nodes where parent_id is null - - - select node_id - from site_nodes - where object_id = :object_id - - -