Index: openacs-4/packages/acs-subsite/tcl/group-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/group-procs.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/acs-subsite/tcl/group-procs.tcl 30 Sep 2003 12:10:03 -0000 1.7 +++ openacs-4/packages/acs-subsite/tcl/group-procs.tcl 2 Oct 2003 22:43:30 -0000 1.8 @@ -11,268 +11,268 @@ } -namespace eval group { +namespace eval group {} - ad_proc new { - { -form_id "" } - { -variable_prefix "" } - { -creation_user "" } - { -creation_ip "" } - { -group_id "" } - { -context_id "" } - { -group_name "" } - {group_type "group"} - } { - Creates a group of this type by calling the .new function for - the package associated with the given group_type. This - function will fail if there is no package. - -

- There are now several ways to create a group of a given - type. You can use this TCL API with or without a form from the form - system, or you can directly use the PL/SQL API for the group type. +ad_proc group::new { + { -form_id "" } + { -variable_prefix "" } + { -creation_user "" } + { -creation_ip "" } + { -group_id "" } + { -context_id "" } + { -group_name "" } + {group_type "group"} +} { + Creates a group of this type by calling the .new function for + the package associated with the given group_type. This + function will fail if there is no package. + +

+ There are now several ways to create a group of a given + type. You can use this TCL API with or without a form from the form + system, or you can directly use the PL/SQL API for the group type. -

Examples: -

+    

Examples: +

 
-	# OPTION 1: Create the group using the TCL Procedure. Useful if the
-	# only attribute you need to specify is the group name
-	
-	db_transaction {
-	    set group_id [group::new -group_name "Author" $group_type]
-	}
-	
-	
-	# OPTION 2: Create the group using the TCL API with a templating
-	# form. Useful when there are multiple attributes to specify for the
-	# group
-	
-	template::form create add_group
-	template::element create add_group group_name -value "Publisher"
-	
-	db_transaction {
-	    set group_id [group::new -form_id add_group $group_type ]
-	}
-	
-	# OPTION 3: Create the group using the PL/SQL package automatically
-	# created for it
-	
-	# creating the new group
-	set group_id [db_exec_plsql add_group "
-	  begin
-	    :1 := ${group_type}.new (group_name => 'Editor');
-	  end;
-	"]
-	
-	
+ # OPTION 1: Create the group using the TCL Procedure. Useful if the + # only attribute you need to specify is the group name + + db_transaction { + set group_id [group::new -group_name "Author" $group_type] + } + + + # OPTION 2: Create the group using the TCL API with a templating + # form. Useful when there are multiple attributes to specify for the + # group + + template::form create add_group + template::element create add_group group_name -value "Publisher" + + db_transaction { + set group_id [group::new -form_id add_group $group_type ] + } + + # OPTION 3: Create the group using the PL/SQL package automatically + # created for it + + # creating the new group + set group_id [db_exec_plsql add_group " + begin + :1 := ${group_type}.new (group_name => 'Editor'); + end; + "] + +
- @author Michael Bryzek (mbryzek@arsdigita.com) - @creation-date 10/2000 + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 10/2000 - @return group_id of the newly created group + @return group_id of the newly created group - @param form_id The form id from templating form system (see - example above) + @param form_id The form id from templating form system (see + example above) - @param group_name The name of this group. Note that if - group_name is specified explicitly, this name will be used even if - there is a group_name attribute in the form specified by - form_id. + @param group_name The name of this group. Note that if + group_name is specified explicitly, this name will be used even if + there is a group_name attribute in the form specified by + form_id. - @param group_type The type of group we are creating. Defaults to group - which is what you want in most cases. + @param group_type The type of group we are creating. Defaults to group + which is what you want in most cases. - @param group_name The name of this group. This is a required - variable, though it may be specified either explicitly or through - form_id + @param group_name The name of this group. This is a required + variable, though it may be specified either explicitly or through + form_id - } { +} { - # We select out the name of the primary key. Note that the - # primary key is equivalent to group_id as this is a subtype of - # acs_group - - if { ![db_0or1row package_select { - select t.package_name, lower(t.id_column) as id_column - from acs_object_types t - where t.object_type = :group_type - }] } { - error "Object type \"$group_type\" does not exist" - } + # We select out the name of the primary key. Note that the + # primary key is equivalent to group_id as this is a subtype of + # acs_group + + if { ![db_0or1row package_select { + select t.package_name, lower(t.id_column) as id_column + from acs_object_types t + where t.object_type = :group_type + }] } { + error "Object type \"$group_type\" does not exist" + } - set var_list [list] - lappend var_list [list context_id $context_id] - lappend var_list [list $id_column $group_id] - if { ![empty_string_p $group_name] } { - lappend var_list [list group_name $group_name] - } - - return [package_instantiate_object \ - -creation_user $creation_user \ - -creation_ip $creation_ip \ - -package_name $package_name \ - -start_with "group" \ - -var_list $var_list \ - -form_id $form_id \ - -variable_prefix $variable_prefix \ - $group_type] - + set var_list [list] + lappend var_list [list context_id $context_id] + lappend var_list [list $id_column $group_id] + if { ![empty_string_p $group_name] } { + lappend var_list [list group_name $group_name] } - ad_proc delete { group_id } { - Deletes the group specified by group_id, including all - relational segments specified for the group and any relational - constraint that depends on this group in any way. + return [package_instantiate_object \ + -creation_user $creation_user \ + -creation_ip $creation_ip \ + -package_name $package_name \ + -start_with "group" \ + -var_list $var_list \ + -form_id $form_id \ + -variable_prefix $variable_prefix \ + $group_type] - @author Michael Bryzek (mbryzek@arsdigita.com) - @creation-date 10/2000 +} - @return object_type of the deleted group, if it - was actually deleted. Returns the empty string if the - object didn't exist to begin with +ad_proc group::delete { group_id } { + Deletes the group specified by group_id, including all + relational segments specified for the group and any relational + constraint that depends on this group in any way. - @param group_id The group to delete + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 10/2000 - } { - if { ![db_0or1row package_select { - select t.package_name, t.object_type - from acs_object_types t - where t.object_type = (select o.object_type - from acs_objects o - where o.object_id = :group_id) - }] } { - # No package means the object doesn't exist. We're done :) - return - } + @return object_type of the deleted group, if it + was actually deleted. Returns the empty string if the + object didn't exist to begin with - # Maybe the relational constraint deletion should be moved to - # the acs_group package... - - db_exec_plsql delete_group " - BEGIN - -- the acs_group package takes care of segments referred - -- to by rel_constraints.rel_segment. We delete the ones - -- references by rel_constraints.required_rel_segment here. + @param group_id The group to delete - for row in (select cons.constraint_id - from rel_constraints cons, rel_segments segs - where segs.segment_id = cons.required_rel_segment - and segs.group_id = :group_id) loop +} { + if { ![db_0or1row package_select { + select t.package_name, t.object_type + from acs_object_types t + where t.object_type = (select o.object_type + from acs_objects o + where o.object_id = :group_id) + }] } { + # No package means the object doesn't exist. We're done :) + return + } - rel_segment.del(row.constraint_id); + # Maybe the relational constraint deletion should be moved to + # the acs_group package... + + db_exec_plsql delete_group " + BEGIN + -- the acs_group package takes care of segments referred + -- to by rel_constraints.rel_segment. We delete the ones + -- references by rel_constraints.required_rel_segment here. - end loop; + for row in (select cons.constraint_id + from rel_constraints cons, rel_segments segs + where segs.segment_id = cons.required_rel_segment + and segs.group_id = :group_id) loop - -- delete the actual group - ${package_name}.del(:group_id); - END; - " + rel_segment.del(row.constraint_id); - return $object_type - } + end loop; + -- delete the actual group + ${package_name}.del(:group_id); + END; + " - ad_proc -public permission_p { - { -user_id "" } - { -privilege "read" } - group_id - } { - THIS PROC SHOULD GO AWAY! All calls to group::permission_p can be - replaced with party::permission_p + return $object_type +} - Wrapper for ad_permission to allow us to bypass having to - specify the read privilege - @author Michael Bryzek (mbryzek@arsdigita.com) - @creation-date 10/2000 +ad_proc -public group::permission_p { + { -user_id "" } + { -privilege "read" } + group_id +} { + THIS PROC SHOULD GO AWAY! All calls to group::permission_p can be + replaced with party::permission_p - } { - return [party::permission_p -user_id $user_id -privilege $privilege $group_id] - } + Wrapper for ad_permission to allow us to bypass having to + specify the read privilege - ad_proc -public join_policy { - { -group_id "" } - } { - Returns a group's join policy ('open', 'closed', or 'needs approval') + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 10/2000 - @author Oumi Mehrotra (oumi@arsdigita.com) - @creation-date 10/2000 +} { + return [party::permission_p -user_id $user_id -privilege $privilege $group_id] +} - } { +ad_proc -public group::join_policy { + { -group_id "" } +} { + Returns a group's join policy ('open', 'closed', or 'needs approval') - set join_policy [db_string select_join_policy { - select join_policy from groups where group_id = :group_id - }] + @author Oumi Mehrotra (oumi@arsdigita.com) + @creation-date 10/2000 - } +} { - ad_proc -public possible_member_states { + set join_policy [db_string select_join_policy { + select join_policy from groups where group_id = :group_id + }] - } { +} - } { - return [list approved "needs approval" banned rejected deleted] - } +ad_proc -public group::possible_member_states { - ad_proc -public default_member_state { - { -join_policy "" } - { -create_p "" } - -no_complain:boolean - } { - If user has 'create' privilege on group_id OR - the group's join policy is 'open', - then default_member_state will return "approved". +} { - If the group's join policy is 'needs approval' - then default_member_state will return 'needs approval'. +} { + return [list approved "needs approval" banned rejected deleted] +} - If the group's join policy is closed - then an error will be thrown, unless the no_complain flag is - set, in which case empty string is returned. +ad_proc -public group::default_member_state { + { -join_policy "" } + { -create_p "" } + -no_complain:boolean +} { + If user has 'create' privilege on group_id OR + the group's join policy is 'open', + then default_member_state will return "approved". - @author Oumi Mehrotra (oumi@arsdigita.com) - @creation-date 10/2000 - - @param join_policy - the group's join policy - (one of 'open', 'closed', or 'needs approval') + If the group's join policy is 'needs approval' + then default_member_state will return 'needs approval'. - @param create_p - 1 if the user has 'create' privilege on the group, - 0 otherwise. - } { + If the group's join policy is closed + then an error will be thrown, unless the no_complain flag is + set, in which case empty string is returned. - if {$create_p || [string equal $join_policy open]} { - return "approved" - } + @author Oumi Mehrotra (oumi@arsdigita.com) + @creation-date 10/2000 + + @param join_policy - the group's join policy + (one of 'open', 'closed', or 'needs approval') - if {[string equal $join_policy "needs approval"]} { - return "needs approval" - } + @param create_p - 1 if the user has 'create' privilege on the group, + 0 otherwise. +} { - if {$no_complain_p} { - error "group::default_member_state - user is not a group admin and join policy is $join_policy." - } + if {$create_p || [string equal $join_policy open]} { + return "approved" + } - return "" + if {[string equal $join_policy "needs approval"]} { + return "needs approval" } + if {$no_complain_p} { + error "group::default_member_state - user is not a group admin and join policy is $join_policy." + } - ad_proc -public member_p { - { -user_id "" } - { -group_name "" } - { -group_id "" } - -cascade:boolean - } { - Return 1 if the user is a member of the group specified. - You can specify a group name or group id. - If cascade is true, check to see if the user is - a member of the group by virtue of any other component group. - (e.g. if group B is a component of group A then if a user - is a member of group B then he is automatically a member of A - also.) - If cascade is false, then the user must have specifically - been granted membership on the group in question. - } { + return "" +} + +ad_proc -public group::member_p { + { -user_id "" } + { -group_name "" } + { -group_id "" } + -cascade:boolean +} { + Return 1 if the user is a member of the group specified. + You can specify a group name or group id. + If cascade is true, check to see if the user is + a member of the group by virtue of any other component group. + (e.g. if group B is a component of group A then if a user + is a member of group B then he is automatically a member of A + also.) + If cascade is false, then the user must have specifically + been granted membership on the group in question. +} { + if {[empty_string_p $user_id]} { set user_id [ad_verify_and_get_user_id] } @@ -303,7 +303,6 @@ if { [string equal $result "f"] } { return 0 } if { [string equal $result "t"] } { return 1 } } -} ad_proc -public group::get_rel_types_options {