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: -
+- @author Michael Bryzek (mbryzek@arsdigita.com) - @creation-date 10/2000 + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 10/2000 - @returnExamples: +
- # 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; + "] + +
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 {