Index: openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl 28 Aug 2003 09:41:39 -0000 1.4 +++ openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl 2 Oct 2003 22:35:54 -0000 1.5 @@ -10,241 +10,241 @@ } -namespace eval application_group { - ad_proc contains_party_p { - { -package_id "" } - { -party_id "" } - -include_self:boolean - } { - Determines whether the party in question (identified by party_id) is - a contained by the application group identified by package_id. - If package_id is not specified, and we have a connection, then the - proc will grab the package_id of the current package (i.e., - [ad_conn package_id]). +namespace eval application_group {} - } { +ad_proc application_group::contains_party_p { + { -package_id "" } + { -party_id "" } + -include_self:boolean +} { + Determines whether the party in question (identified by party_id) is + a contained by the application group identified by package_id. + If package_id is not specified, and we have a connection, then the + proc will grab the package_id of the current package (i.e., + [ad_conn package_id]). - if {[empty_string_p $package_id] && [ad_conn isconnected]} { - set package_id [ad_conn package_id] - } +} { - if {[empty_string_p $package_id]} { - error "application_group::contains_party_p - package_id not specified" - } + if {[empty_string_p $package_id] && [ad_conn isconnected]} { + set package_id [ad_conn package_id] + } - # Check if the party is a member of the application group, OR - # the party *is* the application group. This proc considers the - # applcation group to contain itself. - if {$include_self_p} { - set found_p [db_string app_group_contains_party_p { - select case when exists ( - select 1 - from application_group_element_map - where package_id = :package_id - and element_id = :party_id - union all - select 1 - from application_groups - where package_id = :package_id - and group_id = :party_id - ) then 1 else 0 end - from dual - }] - } else { - set found_p [db_string app_group_contains_party_p { - select case when exists ( - select 1 - from application_group_element_map - where package_id = :package_id - and element_id = :party_id - ) then 1 else 0 end - from dual - }] + if {[empty_string_p $package_id]} { + error "application_group::contains_party_p - package_id not specified" + } - } + # Check if the party is a member of the application group, OR + # the party *is* the application group. This proc considers the + # applcation group to contain itself. + if {$include_self_p} { + set found_p [db_string app_group_contains_party_p { + select case when exists ( + select 1 + from application_group_element_map + where package_id = :package_id + and element_id = :party_id + union all + select 1 + from application_groups + where package_id = :package_id + and group_id = :party_id + ) then 1 else 0 end + from dual + }] + } else { + set found_p [db_string app_group_contains_party_p { + select case when exists ( + select 1 + from application_group_element_map + where package_id = :package_id + and element_id = :party_id + ) then 1 else 0 end + from dual + }] - return $found_p - } - ad_proc contains_relation_p { - { -package_id "" } - { -rel_id "" } - } { - Determines whether the relation in question (identified by rel_id) is - a contained by the application group identified by package_id. - If package_id is not specified, and we have a connection, then the - proc will grab the package_id of the current package (i.e., - [ad_conn package_id]). - } { + return $found_p - if {[empty_string_p $package_id] && [ad_conn isconnected]} { - set package_id [ad_conn package_id] - } +} - if {[empty_string_p $package_id]} { - error "application_group::contains_party_p - package_id not specified" - } +ad_proc application_group::contains_relation_p { + { -package_id "" } + { -rel_id "" } +} { + Determines whether the relation in question (identified by rel_id) is + a contained by the application group identified by package_id. + If package_id is not specified, and we have a connection, then the + proc will grab the package_id of the current package (i.e., + [ad_conn package_id]). +} { - # Check if the rel belongs to the application group, OR - # the party *is* the application group. This proc considers the - # application group to contain itself. - set found_p [db_string app_group_contains_rel_p { - select case when exists ( - select 1 - from application_group_element_map - where package_id = :package_id - and rel_id = :rel_id - ) then 1 else 0 end - from dual - }] + if {[empty_string_p $package_id] && [ad_conn isconnected]} { + set package_id [ad_conn package_id] + } - return $found_p + if {[empty_string_p $package_id]} { + error "application_group::contains_party_p - package_id not specified" } - ad_proc contains_segment_p { - { -package_id "" } - { -segment_id "" } - } { - Determines whether the segment in question (identified by segment_id) - "belongs" to the application group identified by package_id. - If package_id is not specified, and we have a connection, then the - proc will grab the package_id of the current package (i.e., - [ad_conn package_id]). + # Check if the rel belongs to the application group, OR + # the party *is* the application group. This proc considers the + # application group to contain itself. + set found_p [db_string app_group_contains_rel_p { + select case when exists ( + select 1 + from application_group_element_map + where package_id = :package_id + and rel_id = :rel_id + ) then 1 else 0 end + from dual + }] - } { + return $found_p +} - if {[empty_string_p $package_id] && [ad_conn isconnected]} { - set package_id [ad_conn package_id] - } +ad_proc application_group::contains_segment_p { + { -package_id "" } + { -segment_id "" } +} { + Determines whether the segment in question (identified by segment_id) + "belongs" to the application group identified by package_id. + If package_id is not specified, and we have a connection, then the + proc will grab the package_id of the current package (i.e., + [ad_conn package_id]). - if {[empty_string_p $package_id]} { - error "application_group::contains_segment_p - package_id not specified" - } +} { - # Check if the party is a member of the application group, OR - # the party *is* the application group. This proc considers the - # applcation group to contain itself. - set found_p [db_string app_group_contains_segment_p { - select case when exists ( - select 1 - from application_group_segments - where package_id = :package_id - and segment_id = :segment_id - ) then 1 else 0 end - from dual - }] + if {[empty_string_p $package_id] && [ad_conn isconnected]} { + set package_id [ad_conn package_id] + } - return $found_p + if {[empty_string_p $package_id]} { + error "application_group::contains_segment_p - package_id not specified" } + # Check if the party is a member of the application group, OR + # the party *is* the application group. This proc considers the + # applcation group to contain itself. + set found_p [db_string app_group_contains_segment_p { + select case when exists ( + select 1 + from application_group_segments + where package_id = :package_id + and segment_id = :segment_id + ) then 1 else 0 end + from dual + }] - ad_proc group_id_from_package_id { - -no_complain:boolean - { -package_id "" } - } { - Get the application_group of a package. By default, if no application - group exists, we throw an error. The -no_complain flag will prevent - the error from being thrown, in which case you'll just get an - empty string if the application group doesn't exist. - } { + return $found_p +} - if {$no_complain_p} { - set no_complain_p t - } else { - set no_complain_p f - } - if { [ad_conn isconnected] } { - if {[empty_string_p $package_id]} { - set package_id [ad_conn package_id] - } - } +ad_proc application_group::group_id_from_package_id { + -no_complain:boolean + { -package_id "" } +} { + Get the application_group of a package. By default, if no application + group exists, we throw an error. The -no_complain flag will prevent + the error from being thrown, in which case you'll just get an + empty string if the application group doesn't exist. +} { - if {[empty_string_p $package_id]} { - error "application_group::group_id_from_package_id - no package_id specified." - } + if {$no_complain_p} { + set no_complain_p t + } else { + set no_complain_p f + } - set group_id [db_exec_plsql application_group_from_package_id_query { - begin - :1 := application_group.group_id_from_package_id ( - package_id => :package_id, - no_complain_p => :no_complain_p - ); - end; - }] + if { [ad_conn isconnected] } { + if {[empty_string_p $package_id]} { + set package_id [ad_conn package_id] + } + } - return $group_id + if {[empty_string_p $package_id]} { + error "application_group::group_id_from_package_id - no package_id specified." } - ad_proc new { - { -group_id "" } - { -group_type "application_group"} - { -package_id "" } - { -group_name "" } - { -creation_user "" } - { -creation_ip "" } - { -email "" } - { -url "" } - } { - Creates an application group - (i.e., group of "users/parties of this application") + set group_id [db_exec_plsql application_group_from_package_id_query { + begin + :1 := application_group.group_id_from_package_id ( + package_id => :package_id, + no_complain_p => :no_complain_p + ); + end; + }] - Returns the group_id of the new application group. - } { + return $group_id +} - if { [ad_conn isconnected] } { - # Since we have a connection, default user_id / peeraddr - # if they're not specified - if { [empty_string_p $creation_user] } { - set creation_user [ad_conn user_id] - } - if { [empty_string_p $creation_ip] } { - set creation_ip [ad_conn peeraddr] - } - if { [empty_string_p $package_id] } { - set package_id [ad_conn package_id] - } - } +ad_proc application_group::new { + { -group_id "" } + { -group_type "application_group"} + { -package_id "" } + { -group_name "" } + { -creation_user "" } + { -creation_ip "" } + { -email "" } + { -url "" } +} { + Creates an application group + (i.e., group of "users/parties of this application") - if {[empty_string_p $package_id]} { - error "application_group::new - package_id not specified" - } + Returns the group_id of the new application group. +} { - if {[empty_string_p $group_name]} { - set group_name [db_string group_name_query { - select substr(instance_name, 1, 90) - from apm_packages - where package_id = :package_id - }] - append group_name " Parties" - } + if { [ad_conn isconnected] } { + # Since we have a connection, default user_id / peeraddr + # if they're not specified + if { [empty_string_p $creation_user] } { + set creation_user [ad_conn user_id] + } + if { [empty_string_p $creation_ip] } { + set creation_ip [ad_conn peeraddr] + } + if { [empty_string_p $package_id] } { + set package_id [ad_conn package_id] + } + } - db_transaction { - # creating the new group - set group_id [db_exec_plsql add_group {}] - } + if {[empty_string_p $package_id]} { + error "application_group::new - package_id not specified" + } - return $group_id + if {[empty_string_p $group_name]} { + set group_name [db_string group_name_query { + select substr(instance_name, 1, 90) + from apm_packages + where package_id = :package_id + }] + append group_name " Parties" + } + db_transaction { + # creating the new group + set group_id [db_exec_plsql add_group {}] } - ad_proc delete { - -group_id:required - } { - Delete the given application group and all relational segments and constraints dependent - on it (handled by the PL/[pg]SQL API - } { - # LARS HACK: - # Delete permissions on: - # - the application group - # - any relational segment of this group - # - any relation with this gorup - # We really ought to have cascading deletes on acs_permissions.grantee_id (and object_id) - db_dml delete_perms {} + return $group_id - db_exec_plsql delete {} - } +} +ad_proc application_group::delete { + -group_id:required +} { + Delete the given application group and all relational segments and constraints dependent + on it (handled by the PL/[pg]SQL API +} { + # LARS HACK: + # Delete permissions on: + # - the application group + # - any relational segment of this group + # - any relation with this gorup + # We really ought to have cascading deletes on acs_permissions.grantee_id (and object_id) + db_dml delete_perms {} + + db_exec_plsql delete {} + } 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 {