Index: openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl 29 Jan 2003 16:09:01 -0000 1.2 +++ openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl 17 May 2003 09:58:37 -0000 1.3 @@ -14,175 +14,68 @@ namespace eval util {} } - -ad_proc -public acs_subsite_after_mount_callback { +ad_proc -public subsite::after_mount { {-package_id:required} {-node_id:required} } { This is the TCL proc that is called automatically by the APM whenever a new instance of the subsites application is mounted. - @author Peter Marklund -} { - subsite::configure_if_necessary -package_id $package_id -} + We do three things: - ad_proc subsite::configure_if_necessary { - {-package_id ""} - } { - Performs post-install configuration if necessary. - See subsite::configured_p to learn how we determine if a subsite has - already been configured. See subsite::configure to learn what - is involved in configuring a subsite. + -

+ @author Don Baccus (dhogaza@pacifier.com) + @creation-date 2003-03-05 - NOTE: this proc might not work without a connection (i.e., - [ad_conn isconnected]==1). I haven't tested it without a connection, - but I think the code would work right now (assuming the caller passes - in a valid package_id). However, in the future, this proc may redirect - the administrator to a configuration "wizard" in case we need or want - some input from the admin to properly configure the subsite. +} { - @author Oumi Mehrotra (oumi@arsdigita.com) - @creation-date 2000-02-05 + if { [empty_string_p [application_group::group_id_from_package_id -no_complain -package_id $package_id]] } { - @param package_id The package_id of the subsite application instance - to configure. If package_id is not specified, then - [ad_conn package_id] will be used. + set subsite_name [db_string subsite_name_query {}] - } { - if {![configured_p -package_id $package_id]} { - configure -package_id $package_id - } + set truncated_subsite_name [string range $subsite_name 0 89] - } + db_transaction { + # Create subsite application group + set group_name "$truncated_subsite_name Parties" + set subsite_group_id [application_group::new \ + -package_id $package_id \ + -group_name $group_name] - ad_proc subsite::configured_p { - {-package_id ""} - } { - Determines whether a subsite has been configured. Returns 1 if - configured, or 0 otherwise. Right now, a subsite is considered - to be configured if its application group exists. In the future, - we may store an explicit "configured_p" setting in the DB. + # Create segment of registered users + set segment_name "$truncated_subsite_name Members" + set segment_id [rel_segments_new $subsite_group_id membership_rel $segment_name] - @author Oumi Mehrotra (oumi@arsdigita.com) - @creation-date 2000-02-05 + # Create a constraint that says "to be a member of this subsite you must be a member + # of the parent subsite. - @param package_id The package_id of the subsite application instance - to configure. If package_id is not specified, then - [ad_conn package_id] will be used. - } { - if {[empty_string_p [application_group::group_id_from_package_id \ - -no_complain \ - -package_id $package_id]]} { - return 0 - } - return 1 - } + db_1row parent_subsite_query {} + set constraint_name "Members of [string range $subsite_name 0 30] must be members of [string range $supersite_name 0 30]" + set user_id [ad_conn user_id] + set creation_ip [ad_conn peeraddr] + db_exec_plsql add_constraint {} - - - ad_proc subsite::configure { - {-package_id ""} - } { - Configures a subsite. This involves 3 steps: - -

- - @author Oumi Mehrotra (oumi@arsdigita.com) - @creation-date 2000-02-05 - - @param package_id The package_id of the subsite application instance - to configure. If package_id is not specified, then - [ad_conn package_id] will be used. - - } { - - if {[ad_conn isconnected]} { - if {[empty_string_p $package_id]} { - set package_id [ad_conn package_id] - } - } - - if {[empty_string_p $package_id]} { - error "subsite::configure - package_id not specified" - } - - set subsite_name [db_string subsite_name_query { - select instance_name - from apm_packages - where package_id = :package_id - }] - - set truncated_subsite_name [string range $subsite_name 0 89] - - db_transaction { - - # Create subsite application group - set group_name "$truncated_subsite_name Parties" - set subsite_group_id [application_group::new \ - -package_id $package_id \ - -group_name $group_name] - - # Create segment of registered users - set segment_name "$truncated_subsite_name Members" - set segment_id [rel_segments_new $subsite_group_id membership_rel $segment_name] - - # Create constraint that says "to be a member of this - # subsite, you have to be a member of the parent subsite" - - set supersite_group_id "" - - db_0or1row parent_subsite_query { - select m.group_id as supersite_group_id, - p.instance_name as supersite_name - from application_group_element_map m, - apm_packages p - where p.package_id = m.package_id - and container_id = group_id - and element_id = :subsite_group_id - and rel_type = 'composition_rel' - } - - # First get parent application group's id and instance name - if { ![empty_string_p $supersite_group_id] } { - - set constraint_name "Members of [string range $subsite_name 0 30] must be members of [string range $supersite_name 0 30]" - - if {[ad_conn isconnected]} { - set user_id [ad_conn user_id] - set creation_ip [ad_conn peeraddr] - } else { - set user_id "" - set creation_ip "" - } - - set constraint_id [db_exec_plsql add_constraint { - BEGIN - :1 := rel_constraint.new( - constraint_name => :constraint_name, - rel_segment => :segment_id, - rel_side => 'two', - required_rel_segment => rel_segment.get(:supersite_group_id, 'membership_rel'), - creation_user => :user_id, - creation_ip => :creation_ip - ); - END; - }] - } - } - + } } +} +ad_proc -public subsite::before_uninstantiate { + {-package_id:required} +} { + Delete the application group associated with this subsite. +} { + application_group::delete -group_id [application_group::group_id_from_package_id -package_id $package_id] +} + ad_proc -private subsite::instance_name_exists_p { node_id instance_name @@ -202,24 +95,24 @@ }] } - ad_proc -public subsite::auto_mount_application { { -instance_name "" } { -pretty_name "" } { -node_id "" } package_key } { Mounts a new instance of the application specified by package_key - beneath node_id. This proc makes sure that the instance_name (the + beneath node_id. This proc makes sure that the instance_name (the name of the new node) is unique before invoking site_node::instantiate_and_mount. - + + @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 2001-02-28 @param instance_name The name to use for the url in the site-map. Defaults to the package_key plus a possible digit to serve as a unique identifier (e.g. news-2) - + @param pretty_name The english name to use for the site-map and for things like context bars. Defaults to the name of the object mounted at this node + the package pretty name (e.g. Intranet News) @@ -269,14 +162,71 @@ -package_key $package_key] } + +ad_proc -public subsite::get { + {-subsite_id {}} + {-array:required} +} { + Get information about a subsite. + + @param subsite_id The id of the subsite for which info is requested. + If no id is provided, then the id of the closest ancestor subsite will + be used. + @param array The name of an array in which information will be returned. + + @author Frank Nikolajsen (frank@warpspace.com) + @creation-date 2003-03-08 +} { + upvar $array subsite_info + + if { [empty_string_p $subsite_id] } { + set subsite_id [site_node_closest_ancestor_package "acs-subsite"] + } + + array unset subsite_info + array set subsite_info [site_node::get_from_object_id -object_id $subsite_id] +} + +ad_proc -public subsite::get_element { + {-subsite_id {}} + {-element:required} + {-notrailing:boolean} +} { + Return a single element from the information about a subsite. + + @param subsite_id The node id of the subsite for which info is requested. + If no id is provided, then the id of the closest ancestor subsite will + be used. + @param element The element you want, one of: + directory_p object_type package_key package_id name pattern_p + instance_name node_id parent_id url object_id + @notrailing If true and the element requested is an url, then strip any + trailing slash ('/'). This means the empty string is returned for the root. + @return The element you asked for + + @author Frank Nikolajsen (frank@warpspace.com) + @creation-date 2003-03-08 +} { + get -subsite_id $subsite_id -array subsite_info + + if { $notrailing_p && [string match $element "url"]} { + set returnval [string trimright $subsite_info($element) "/"] + } else { + set returnval $subsite_info($element) + } + + return $returnval +} + + ad_proc subsite::util::sub_type_exists_p { object_type } { returns 1 if object_type has sub types, or 0 otherwise @author Oumi Mehrotra (oumi@arsdigita.com) @creation-date 2000-02-07 - + @param object_type } { @@ -328,7 +278,7 @@ @author Oumi Mehrotra (oumi@arsdigita.com) @creation-date 2000-02-07 - + @param object_type } { return [db_string select_pretty_name {