Index: openacs-4/contrib/packages/cop-base/tcl/cop-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/cop-base/tcl/cop-procs.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/contrib/packages/cop-base/tcl/cop-procs.tcl 1 Apr 2004 21:03:49 -0000 1.5 +++ openacs-4/contrib/packages/cop-base/tcl/cop-procs.tcl 7 May 2004 16:43:21 -0000 1.6 @@ -4,7 +4,7 @@ @author Jeff Davis - @creation-date 10/23/2003 + @creation-date 2003-10-30 @cvs-id $Id$ } @@ -62,6 +62,7 @@ @return root_node of the parsed xml file. @author Jeff Davis davis@xarg.net + @creation-date 2003-10-30 } { # Abort if there is no install.xml file set filename [acs_root_dir]$filename @@ -100,6 +101,7 @@ @return list of messages @author Jeff Davis (swiped from acs-bootstrap-installer though) + @creation-date 2003-10-30 } { set root_node [cop::load_install_xml $filename $binds] @@ -234,3 +236,43 @@ } return $out } + +ad_proc -private cop::util::packages_no_mem { + -node_id +} { + return a list of packages for the subsite containing node_id + + @author Jeff Davis davis@xarg.net + @creation-date 2004-05-07 + @see cop::util::packages +} { + # need to strip nodes which have no mounted package... + set packages [list] + foreach package [site_node::get_children -all -node_id $node_id -element package_id] { + if {![empty_string_p $package]} { + lappend packages $package + } + } + + return $packages +} + +ad_proc -public cop::util::packages { + -node_id +} { + Return a list of packages for the subsite containing node_id + + Memoized function. + + @author Jeff Davis davis@xarg.net + @creation-date 2004-05-07 + @see cop::util::packages_no_mem +} { + set subsite_node_id [site_node::closest_ancestor_package \ + -package_key acs-subsite \ + -node_id $node_id \ + -include_self \ + -element node_id] + + return [util_memoize [list cop::util::packages_no_mem -node_id $subsite_node_id] 1200] +}