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.37 -r1.38
--- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl	22 Sep 2003 09:51:37 -0000	1.37
+++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl	22 Sep 2003 13:35:16 -0000	1.38
@@ -256,17 +256,17 @@
     # 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]]
+        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 {[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]
-    	    }
-    	}
+            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\""
@@ -410,25 +410,54 @@
 ad_proc -public site_node::get_children {
     {-all:boolean}
     {-package_type {}}
+    {-package_key {}}
+    {-filter_element {}}
+    {-filter_value {}}
     {-element {}}
     {-node_id:required}
 } {
+    This proc gives answers to questions such as: What are all the package_id's 
+    (or any of the other available elements) for all the instances of package_key or package_type mounted
+    under node_id xxx?
+
     @param node_id       The node for which you want to find the children.
 
     @option all          Set this if you want all children, not just direct children
     
     @option package_type If specified, this will limit the returned nodes to those with an
                          package of the specified package type (normally apm_service or 
-                         apm_application) mounted
+                         apm_application) mounted. Conflicts with the -package_key option.
     
-    @param element       The element of the site node you wish returned. Defaults to url, but you 
-                         can say 'node_id' instead.
+    @param package_key   If specified, this will limit the returned nodes to those with a
+                         package of the specified package key mounted. Conflicts with the
+                        -package_type option.
+                     
+    @param element       The element of the site node you wish returned. Defaults to url, but 
+                         the following elements are available: object_type, url, object_id,
+                         instance_name, package_type, package_id, name, node_id, directory_p.
     
     @return A list of URLs of the site_nodes immediately under this site node, or all children, 
     if the -all switch is specified.
     
     @author Lars Pind (lars@collaboraid.biz)
 } {
+    if { ![empty_string_p $filter_element] } {
+        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."
+        }
+    } else {
+        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 { ![empty_string_p $package_type] } {
+            set filter_element package_type
+            set filter_value $package_type
+        } elseif { ![empty_string_p $package_key] } {
+            set filter_element package_key
+            set filter_value $package_key
+        }
+    }
+    
     set node_url [get_url -node_id $node_id]
     
     set child_urls [nsv_array names site_nodes "${node_url}?*"]
@@ -443,14 +472,14 @@
         }
     }
 
-    if { ![empty_string_p $package_type] } {
+    if { ![empty_string_p $filter_element] } {
         set org_child_urls $child_urls
         set child_urls [list]
         foreach child_url $org_child_urls {
             array unset site_node
             array set site_node [get_from_url -exact -url $child_url]
 
-            if { [string equal $site_node(package_type) $package_type] } {
+            if { [string equal $site_node($filter_element) $filter_value] } {
                 lappend child_urls $child_url
             }
         }
@@ -706,40 +735,40 @@
 
 } {
     if {[empty_string_p $url]} {
-	  set url [ad_conn url]
+          set url [ad_conn url]
     }
 
     # Try the URL as is.
     if {[catch {nsv_get site_nodes $url} result] == 0} {
-	  array set node $result
-	  if { [lsearch -exact $package_keys $node(package_key)] != -1 } {
-	      return $node(package_id)
-	  }
+          array set node $result
+          if { [lsearch -exact $package_keys $node(package_key)] != -1 } {
+              return $node(package_id)
+          }
     }
     
     # Add a trailing slash and try again.
     if {[string index $url end] != "/"} {
-	  append url "/"
-	  if {[catch {nsv_get site_nodes $url} result] == 0} {
-	      array set node $result
-	      if { [lsearch -exact $package_keys $node(package_key)] != -1 } {
-		    return $node(package_id)
-	      }
-	  }
+          append url "/"
+          if {[catch {nsv_get site_nodes $url} result] == 0} {
+              array set node $result
+              if { [lsearch -exact $package_keys $node(package_key)] != -1 } {
+                    return $node(package_id)
+              }
+          }
     }
     
     # 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) != "" && [lsearch -exact $package_keys $node(package_key)] != -1 } {
-		    return $node(package_id)
-	      }
-	  }
+          # 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) != "" && [lsearch -exact $package_keys $node(package_key)] != -1 } {
+                    return $node(package_id)
+              }
+          }
     }
     
     return $default
@@ -762,8 +791,8 @@
 } {
     set subsite_pkg_id [site_node_closest_ancestor_package $package_key]
     if {[empty_string_p $subsite_pkg_id]} {
-	# No package was found... return the default
-	return $default
+        # No package was found... return the default
+        return $default
     }
 
     return [lindex [site_node::get_url_from_object_id -object_id $subsite_pkg_id] 0]
Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	22 Sep 2003 09:51:37 -0000	1.5
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	22 Sep 2003 13:35:16 -0000	1.6
@@ -250,8 +250,8 @@
     script
 } -on_error {
     site_node::get_children returns root node!
-} test_for_root_node_inclusion {
-    Shows bug in site_node::get_children - reurns passed node
+} site_node_get_children {
+    Test site_node::get_children
 } {
     # Start with a known site-map entry
     set node_id [site_node::get_node_id -url "/"]
@@ -262,7 +262,31 @@
 			    -node_id $node_id]
 
     # lsearch returns '-1' if not found
-    aa_equals "site_node::get_children" [lsearch -exact $child_node_ids $node_id] -1
-}
+    aa_equals "site_node::get_children does not return root node" [lsearch -exact $child_node_ids $node_id] -1
 
 
+    # -package_key
+    set nodes [site_node::get_children -all -element node_id -node_id $node_id -filter_element package_key -filter_value "acs-admin"]
+
+    aa_equals "package_key arg. identical to filter_element package_key" \
+        [site_node::get_children -all -element node_id -node_id $node_id -package_key "acs-admin"] \
+        $nodes
+    
+    aa_equals "Found exactly one acs-admin node" [llength $nodes] 1
+
+
+    # -package_type
+    set nodes [site_node::get_children -all -element node_id -node_id $node_id -filter_element package_type -filter_value "apm_service"]
+    aa_equals "package_type arg. identical to filter_element package_type" \
+        [site_node::get_children -all -element node_id -node_id $node_id -package_type "apm_service"] \
+        $nodes
+    
+    aa_true "Found at least one apm_service node" [expr [llength $nodes] > 0]
+
+    # nonexistent package_type
+    aa_true "No nodes with package type 'foo'" \
+        [expr [llength [site_node::get_children -all -element node_id -node_id $node_id -package_type "foo"]] == 0]
+
+    
+}
+