Index: openacs-4/packages/dotlrn/tcl/community-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/community-procs.tcl,v diff -u -r1.115 -r1.116 --- openacs-4/packages/dotlrn/tcl/community-procs.tcl 13 May 2002 06:00:06 -0000 1.115 +++ openacs-4/packages/dotlrn/tcl/community-procs.tcl 14 May 2002 19:27:54 -0000 1.116 @@ -516,23 +516,89 @@ return [db_string select_rel_segment_id {} -default ""] } + ad_proc -private get_members_rel_id { + {-community_id:required} + } { + } { + return [get_rel_segment_id \ + -community_id $community_id \ + -rel_type "dotlrn_member_rel" + ] + } + + ad_proc -private get_admin_rel_id { + {-community_id:required} + } { + } { + return [get_rel_segment_id \ + -community_id $community_id \ + -rel_type "dotlrn_admin_rel" + ] + } + + ad_proc -private rel_segments_grant_permission { + {-community_id:required} + } { + Grant the standard set of privileges on the rel_segments of a community + } { + set member_segment_id [get_members_rel_id -community_id $community_id] + set admin_segment_id [get_admin_rel_id -community_id $community_id] + + permission::grant \ + -party_id $member_segment_id \ + -object_id $community_id \ + -privilege "read" + permission::grant \ + -party_id $member_segment_id \ + -object_id $community_id \ + -privilege "write" + permission::grant \ + -party_id $admin_segment_id \ + -object_id $community_id \ + -privilege "admin" + } + + ad_proc -private rel_segments_revoke_permission { + {-community_id:required} + } { + Revoke the standard set of privileges on the rel_segments of a community + } { + set member_segment_id [get_members_rel_id -community_id $community_id] + set admin_segment_id [get_admin_rel_id -community_id $community_id] + + permission::revoke \ + -party_id $member_segment_id \ + -object_id $community_id \ + -privilege "read" + permission::revoke \ + -party_id $member_segment_id \ + -object_id $community_id \ + -privilege "write" + permission::revoke \ + -party_id $admin_segment_id \ + -object_id $community_id \ + -privilege "admin" + } + ad_proc -public create_rel_segments { {-community_id:required} } { create all the relational segments for a community } { - # Get some information about the community set community_name [get_community_name $community_id] db_transaction { - # Create a rel segment for Admins - set member_segment_id [rel_segments_new $community_id dotlrn_member_rel "Members of $community_name"] - set admin_segment_id [rel_segments_new $community_id dotlrn_admin_rel "Admins of $community_name"] - - # Grant permissions - permission::grant -party_id $member_segment_id -object_id $community_id -privilege "read" - permission::grant -party_id $member_segment_id -object_id $community_id -privilege "write" - permission::grant -party_id $admin_segment_id -object_id $community_id -privilege "admin" + set member_segment_id [rel_segments_new \ + $community_id \ + dotlrn_member_rel \ + "Members of $community_name" + ] + set admin_segment_id [rel_segments_new \ + $community_id \ + dotlrn_admin_rel \ + "Admins of $community_name" + ] + rel_segments_grant_permission -community_id $community_id } } @@ -541,10 +607,6 @@ } { remove the rel segments for a community } { - # Take care of the admins - set admin_segment_id [get_rel_segment_id -community_id $community_id -rel_type dotlrn_admin_rel] - permission::revoke -party_id $admin_segment_id -object_id $community_id -privilege "admin" - # a useful bit of code to find privs that you may not have properly revoked # set foo [db_list_of_lists select_outstanding_privs { # select o.object_id, object_type, privilege @@ -555,13 +617,11 @@ # ad_return_complaint 1 "$foo" # end - rel_segments_delete $admin_segment_id + set member_segment_id [get_members_rel_id -community_id $community_id] + set admin_segment_id [get_admin_rel_id -community_id $community_id] - # Take care of the members - set member_segment_id [get_rel_segment_id -community_id $community_id -rel_type dotlrn_member_rel] - permission::revoke -party_id $member_segment_id -object_id $community_id -privilege "read" - permission::revoke -party_id $member_segment_id -object_id $community_id -privilege "write" - + rel_segments_revoke_permission -community_id $community_id + rel_segments_delete $admin_segment_id rel_segments_delete $member_segment_id } @@ -1342,12 +1402,61 @@ } } - ad_proc -public delete { + ad_proc -public archive { {-community_id:required} } { - Delete a community + Archives a community. This means that: + + 1. the community is marked as archived + + 2. the RemovePortlet callback is called for all users of the + community (both members and GAs) and all the applets. This + removes the comm's data from their workspaces + + 3. all users of the community have their "read" privs revoked on the + comm's portal so that only SWA's can view the archived community + } { db_transaction { + # do RemovePortlet callback, we send comm_id, and user_id + foreach user [list_users $community_id] { + set user_id [ns_set get $user user_id] + set portal_id [dotlrn::get_workspace_portal_id $user_id] + set list_args [list $portal_id [list \ + "user_id" $user_id \ + "community_id" $community_id] + ] + + applets_dispatch \ + -community_id $community_id \ + -op RemovePortlet \ + -list_args $list_args + } + + # revoke privs + rel_segments_revoke_permission -community_id $community_id + + # mark the community as archived + db_dml update_archive_p {} + } + } + + ad_proc -public unarchive { + {-community_id:required} + } { + Unarchives a community. ** not done yet ** + } { + db_dml update_archive_p {} + } + + ad_proc -public nuke { + {-community_id:required} + } { + NUKES the community. + ** not done ** + ** do not use! ** + } { + db_transaction { # Remove all users foreach user [list_users $community_id] { remove_user $community_id [ns_set get $user user_id] Index: openacs-4/packages/dotlrn/tcl/community-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/community-procs.xql,v diff -u -r1.56 -r1.57 --- openacs-4/packages/dotlrn/tcl/community-procs.xql 6 May 2002 23:55:02 -0000 1.56 +++ openacs-4/packages/dotlrn/tcl/community-procs.xql 14 May 2002 19:27:54 -0000 1.57 @@ -390,6 +390,18 @@ + + + update dotlrn_communities set archive_p = 't' where community_id = :community_id + + + + + + update dotlrn_communities set archive_p = 'f' where community_id = :community_id + + + select portal_id Index: openacs-4/packages/dotlrn/www/subcommunity-archive.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/www/subcommunity-archive.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/dotlrn/www/subcommunity-archive.adp 14 May 2002 19:27:54 -0000 1.1 @@ -0,0 +1,32 @@ +<% + + # + # Copyright (C) 2001, 2002 OpenForce, Inc. + # + # This file is part of dotLRN. + # + # dotLRN is free software; you can redistribute it and/or modify it under the + # terms of the GNU General Public License as published by the Free Software + # Foundation; either version 2 of the License, or (at your option) any later + # version. + # + # dotLRN is distributed in the hope that it will be useful, but WITHOUT ANY + # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + # details. + # + +%> + + +@title@ +1 +1 + +Are you sure you want to ARCHIVE group @pretty_name@? +

+This will not delete the group's data, but the group will only be able to be +accessed by Site Wide Admins. +
+ + Index: openacs-4/packages/dotlrn/www/subcommunity-archive.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/www/subcommunity-archive.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/dotlrn/www/subcommunity-archive.tcl 14 May 2002 19:27:54 -0000 1.1 @@ -0,0 +1,78 @@ +# +# Copyright (C) 2001, 2002 OpenForce, Inc. +# +# This file is part of dotLRN. +# +# dotLRN is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# dotLRN is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# + +ad_page_contract { + Archive a subcommunity (aka subgroup) + + @author arjun (arjun@openforce.net) + @version $Id: subcommunity-archive.tcl,v 1.1 2002/05/14 19:27:54 arjun Exp $ +} -query { + {community_id:notnull} + {referer "one-community-admin"} +} -properties { + title:onevalue +} + +set user_id [ad_get_user_id] +dotlrn::require_user_admin_community $community_id +set pretty_name [dotlrn_community::get_community_name $community_id] +set subcomm_pn [ad_parameter subcommunity_pretty_name] +set title "Archive $subcomm_pn" + +form create archive_subcomm + +# this is lame, but I don't have a better way yet +set yes_label "Yes, I'm sure." +set no_label "No, I don't want to archive this group." + +element create archive_subcomm no_button \ + -label $no_label \ + -datatype text \ + -widget submit \ + -value "1" + +element create archive_subcomm yes_button \ + -label $yes_label \ + -datatype text \ + -widget submit + +element create archive_subcomm community_id \ + -label " " \ + -datatype text \ + -widget hidden \ + -value $community_id + +element create archive_subcomm referer \ + -label "Referer" \ + -datatype text \ + -widget hidden \ + -value $referer + +if {[form is_valid archive_subcomm]} { + form get_values archive_subcomm community_id referer no_button yes_button + + if {[string equal $yes_button $yes_label]} { + + db_transaction { + set subcomm_id [dotlrn_community::archive \ + -community_id $community_id + ] + } + } + + ad_returnredirect "$referer" + ad_script_abort +}