group-procs.tcl

Procs to manage groups

Location:
packages/acs-subsite/tcl/group-procs.tcl
Created:
Thu Dec 7 18:13:56 2000
Author:
mbryzek@arsdigita.com
CVS Identification:
$Id: group-procs.tcl,v 1.60.2.18 2024/08/07 15:36:22 mischa Exp $

Procedures in this file

Detailed information

group::add_member (public)

 group::add_member [ -no_perm_check ] [ -no_automatic_membership_rel ] \
    -group_id group_id -user_id user_id [ -rel_type rel_type ] \
    [ -member_state member_state ]

Adds a user to a group, checking that the rel_type is permissible given the user's privileges, Can default both the rel_type and the member_state to their relevant values.

Switches:
-no_perm_check (optional, boolean)
avoid permission check
-no_automatic_membership_rel (optional, boolean)
Use this flag, when we do not want to add automatically a membership_rel (e.g. in DotLRN)
-group_id (required)
group, to which a member should be added
-user_id (required)
user, which should be added to a group
-rel_type (optional)
relationship type to be used (defaults to membership_rel)
-member_state (optional)
state, in which member should be added (gets default via group::default_member_state)

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_check_composite_group acs_subsite_check_composite_group (test acs-subsite) group::add_member group::add_member test_acs_subsite_check_composite_group->group::add_member test_acs_subsite_expose_bug_1144 acs_subsite_expose_bug_1144 (test acs-subsite) test_acs_subsite_expose_bug_1144->group::add_member test_subsite_api subsite_api (test acs-subsite) test_subsite_api->group::add_member test_test_inheritance_and_custom_permissions test_inheritance_and_custom_permissions (test acs-tcl) test_test_inheritance_and_custom_permissions->group::add_member group::default_member_state group::default_member_state (public) group::add_member->group::default_member_state group::flush_members_cache group::flush_members_cache (private) group::add_member->group::flush_members_cache group::get group::get (public) group::add_member->group::get permission::cache_flush permission::cache_flush (public) group::add_member->permission::cache_flush permission::permission_p permission::permission_p (public) group::add_member->permission::permission_p install::xml::action::add-subsite-admin install::xml::action::add-subsite-admin (public) install::xml::action::add-subsite-admin->group::add_member install::xml::action::add-subsite-member install::xml::action::add-subsite-member (public) install::xml::action::add-subsite-member->group::add_member membership_rel::change_state membership_rel::change_state (public) membership_rel::change_state->group::add_member packages/acs-subsite/lib/user-new.tcl packages/acs-subsite/ lib/user-new.tcl packages/acs-subsite/lib/user-new.tcl->group::add_member packages/acs-subsite/www/admin/relations/add.tcl packages/acs-subsite/ www/admin/relations/add.tcl packages/acs-subsite/www/admin/relations/add.tcl->group::add_member

Testcases:
acs_subsite_expose_bug_1144, acs_subsite_check_composite_group, subsite_api, test_inheritance_and_custom_permissions

group::admin_p (public)

 group::admin_p -group_id group_id -user_id user_id
Switches:
-group_id (required)
-user_id (required)
Returns:
1 if user_id is in the admin_rel for group_id

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_check_composite_group acs_subsite_check_composite_group (test acs-subsite) group::admin_p group::admin_p test_acs_subsite_check_composite_group->group::admin_p relation::get_id relation::get_id (public) group::admin_p->relation::get_id packages/acs-subsite/www/index.tcl packages/acs-subsite/ www/index.tcl packages/acs-subsite/www/index.tcl->group::admin_p

Testcases:
acs_subsite_check_composite_group

group::default_member_state (public)

 group::default_member_state [ -join_policy join_policy ] \
    [ -create_p create_p ] [ -no_complain ]

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'. 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.

Switches:
-join_policy (optional)
- the group's join policy (one of 'open', 'closed', or 'needs approval')
-create_p (optional, defaults to "false")
- 1 if the user has 'create' privilege on the group, 0 otherwise.
-no_complain (optional, boolean)
Author:
Oumi Mehrotra <oumi@arsdigita.com>
Created:
10/2000

Partial Call Graph (max 5 caller/called nodes):
%3 group::add_member group::add_member (public) group::default_member_state group::default_member_state group::add_member->group::default_member_state packages/acs-subsite/www/admin/groups/new.tcl packages/acs-subsite/ www/admin/groups/new.tcl packages/acs-subsite/www/admin/groups/new.tcl->group::default_member_state packages/acs-subsite/www/admin/parties/new.tcl packages/acs-subsite/ www/admin/parties/new.tcl packages/acs-subsite/www/admin/parties/new.tcl->group::default_member_state packages/acs-subsite/www/admin/users/new.tcl packages/acs-subsite/ www/admin/users/new.tcl packages/acs-subsite/www/admin/users/new.tcl->group::default_member_state packages/acs-subsite/www/group-join.tcl packages/acs-subsite/ www/group-join.tcl packages/acs-subsite/www/group-join.tcl->group::default_member_state

Testcases:
No testcase defined.

group::delete (public)

 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.

Parameters:
group_id (required)
The group to delete
Returns:
object_type of the deleted group, if it was actually deleted. Returns the empty string if the object didn't exist to begin with
Author:
Michael Bryzek <mbryzek@arsdigita.com>
Created:
10/2000

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_expose_bug_775 acs_subsite_expose_bug_775 (test acs-subsite) group::delete group::delete test_acs_subsite_expose_bug_775->group::delete test_group_localization group_localization (test acs-subsite) test_group_localization->group::delete db_0or1row db_0or1row (public) group::delete->db_0or1row db_exec_plsql db_exec_plsql (public) group::delete->db_exec_plsql lang::message::unregister lang::message::unregister (public) group::delete->lang::message::unregister group_type::delete group_type::delete (public) group_type::delete->group::delete packages/acs-subsite/www/admin/groups/delete-2.tcl packages/acs-subsite/ www/admin/groups/delete-2.tcl packages/acs-subsite/www/admin/groups/delete-2.tcl->group::delete

Testcases:
group_localization, acs_subsite_expose_bug_775

group::description (public)

 group::description -group_id group_id

Returns a group's description

Switches:
-group_id (required)
Created:
09/2008

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_group_type acs_subsite_group_type (test acs-subsite) group::description group::description test_acs_subsite_group_type->group::description group::get group::get (public) group::description->group::get packages/acs-subsite/www/admin/configure.tcl packages/acs-subsite/ www/admin/configure.tcl packages/acs-subsite/www/admin/configure.tcl->group::description

Testcases:
acs_subsite_group_type

group::flush_members_cache (private)

 group::flush_members_cache -group_id group_id

Flush group members cache.

Switches:
-group_id (required)
Author:
Timo Hentschel <timo@timohentschel.de>
Created:
2005-07-26
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 group::add_member group::add_member (public) group::flush_members_cache group::flush_members_cache group::add_member->group::flush_members_cache group::remove_member group::remove_member (public) group::remove_member->group::flush_members_cache

Testcases:
No testcase defined.

group::get (public)

 group::get -group_id group_id [ -array array ]

Get basic info about a group: group_name, join_policy.

Switches:
-group_id (required)
-array (optional)
The name of an array in the caller's namespace where the info gets delivered.
Returns:
dict containing group_name, title, join_policy, and description
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_group_type acs_subsite_group_type (test acs-subsite) group::get group::get test_acs_subsite_group_type->group::get group::get_not_cached group::get_not_cached (private) group::get->group::get_not_cached group::add_member group::add_member (public) group::add_member->group::get group::description group::description (public) group::description->group::get group::get_element group::get_element (public) group::get_element->group::get group::join_policy group::join_policy (public) group::join_policy->group::get packages/acs-subsite/www/admin/relations/add.tcl packages/acs-subsite/ www/admin/relations/add.tcl packages/acs-subsite/www/admin/relations/add.tcl->group::get

Testcases:
acs_subsite_group_type

group::get_element (public)

 group::get_element -group_id group_id -element element

Get an element from the basic info about a group: group_name, join_policy.

Switches:
-group_id (required)
-element (required)
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 test_subsite_api subsite_api (test acs-subsite) group::get_element group::get_element test_subsite_api->group::get_element group::get group::get (public) group::get_element->group::get group::title group::title (public) group::title->group::get_element packages/acs-authentication/lib/local-search.tcl packages/acs-authentication/ lib/local-search.tcl packages/acs-authentication/lib/local-search.tcl->group::get_element packages/acs-subsite/www/admin/groups/delete.tcl packages/acs-subsite/ www/admin/groups/delete.tcl packages/acs-subsite/www/admin/groups/delete.tcl->group::get_element packages/acs-subsite/www/admin/rel-segments/new-2.tcl packages/acs-subsite/ www/admin/rel-segments/new-2.tcl packages/acs-subsite/www/admin/rel-segments/new-2.tcl->group::get_element

Testcases:
subsite_api

group::get_id (public)

 group::get_id -group_name group_name [ -subsite_id subsite_id ] \
    [ -application_group_id application_group_id ]

Retrieve the group_id to a given group-name. If you have more than one group with this name, it will return the first one it finds. Keep that in mind when using this procedure.

Switches:
-group_name (required)
the name of the group to look for
-subsite_id (optional)
the ID of the subsite to search for the group name
-application_group_id (optional)
the ID of the application group to search for the group name
Returns:
the first group_id of the groups found for that group_name.
Authors:
Christian Langmann <C_Langmann@gmx.de>
Malte Sussdorff <openacs@sussdorff.de>
Created:
2005-06-09

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_group_type acs_subsite_group_type (test acs-subsite) group::get_id group::get_id test_acs_subsite_group_type->group::get_id group::get_id_not_cached group::get_id_not_cached (private) group::get_id->group::get_id_not_cached util_memoize util_memoize (public) group::get_id->util_memoize group::member_p group::member_p (public) group::member_p->group::get_id group::party_member_p group::party_member_p (public) group::party_member_p->group::get_id group::title group::title (public) group::title->group::get_id

Testcases:
acs_subsite_group_type

group::get_id_not_cached (private)

 group::get_id_not_cached -group_name group_name \
    [ -subsite_id subsite_id ] \
    [ -application_group_id application_group_id ]

Retrieve the group_id to a given group-name.

Switches:
-group_name (required)
the name of the group to look for
-subsite_id (optional)
-application_group_id (optional)
Returns:
the id of the group
Error:
Authors:
Christian Langmann <C_Langmann@gmx.de>
Malte Sussdorff <openacs@sussdorff.de>
Created:
2005-06-09

Partial Call Graph (max 5 caller/called nodes):
%3 group::get_id group::get_id (public) group::get_id_not_cached group::get_id_not_cached group::get_id->group::get_id_not_cached ad_log ad_log (public) group::get_id_not_cached->ad_log application_group::group_id_from_package_id application_group::group_id_from_package_id (public) group::get_id_not_cached->application_group::group_id_from_package_id db_list db_list (public) group::get_id_not_cached->db_list

Testcases:
No testcase defined.

group::get_join_policy_options (public)

 group::get_join_policy_options

Returns a list of valid join policies in a format suitable for a form builder drop-down.

Partial Call Graph (max 5 caller/called nodes):
%3 test_subsite_api subsite_api (test acs-subsite) group::get_join_policy_options group::get_join_policy_options test_subsite_api->group::get_join_policy_options _ _ (public) group::get_join_policy_options->_ packages/acs-subsite/www/admin/configure.tcl packages/acs-subsite/ www/admin/configure.tcl packages/acs-subsite/www/admin/configure.tcl->group::get_join_policy_options packages/acs-subsite/www/admin/subsite-add.tcl packages/acs-subsite/ www/admin/subsite-add.tcl packages/acs-subsite/www/admin/subsite-add.tcl->group::get_join_policy_options

Testcases:
subsite_api

group::get_member_state_pretty (public)

 group::get_member_state_pretty -member_state member_state \
    [ -component component ] [ -user_name user_name ] \
    [ -community_name community_name ] [ -site_name site_name ] \
    [ -url url ] [ -locale locale ]

Returns the pretty-name of a member state.

Switches:
-member_state (required)
-component (optional, defaults to "pretty_name")
-user_name (optional)
-community_name (optional)
-site_name (optional)
-url (optional)
-locale (optional)

Partial Call Graph (max 5 caller/called nodes):
%3 packages/acs-admin/www/users/member-state-change.tcl packages/acs-admin/ www/users/member-state-change.tcl group::get_member_state_pretty group::get_member_state_pretty packages/acs-admin/www/users/member-state-change.tcl->group::get_member_state_pretty packages/acs-subsite/lib/user-subsites.tcl packages/acs-subsite/ lib/user-subsites.tcl packages/acs-subsite/lib/user-subsites.tcl->group::get_member_state_pretty packages/acs-subsite/www/members/index.tcl packages/acs-subsite/ www/members/index.tcl packages/acs-subsite/www/members/index.tcl->group::get_member_state_pretty packages/acs-subsite/www/members/member-state-change.tcl packages/acs-subsite/ www/members/member-state-change.tcl packages/acs-subsite/www/members/member-state-change.tcl->group::get_member_state_pretty lang::util::localize lang::util::localize (public) group::get_member_state_pretty->lang::util::localize

Testcases:
No testcase defined.

group::get_members (public)

 group::get_members -group_id group_id [ -type type ] \
    [ -rel_type rel_type ] [ -member_state member_state ]

Get party_ids of all members from cache.

Switches:
-group_id (required)
-type (optional, defaults to "party")
Type of members - party, person, user
-rel_type (optional)
-member_state (optional)
when specified, return only members in this membership state
Author:
Timo Hentschel <timo@timohentschel.de>
Created:
2005-07-26
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 test_subsite_api subsite_api (test acs-subsite) group::get_members group::get_members test_subsite_api->group::get_members group::get_members_not_cached group::get_members_not_cached (private) group::get_members->group::get_members_not_cached packages/forums/www/admin/subscribe-others.tcl packages/forums/ www/admin/subscribe-others.tcl packages/forums/www/admin/subscribe-others.tcl->group::get_members

Testcases:
subsite_api

group::get_members_not_cached (private)

 group::get_members_not_cached -group_id group_id -type type \
    [ -rel_type rel_type ] [ -member_state member_state ]

Get party_ids of all members.

Switches:
-group_id (required)
-type (required)
Type of members - party, person, user
-rel_type (optional)
-member_state (optional)
when specified, return only members in this membership state
Author:
Timo Hentschel <timo@timohentschel.de>
Created:
2005-07-26
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 group::get_members group::get_members (public) group::get_members_not_cached group::get_members_not_cached group::get_members->group::get_members_not_cached db_list db_list (public) group::get_members_not_cached->db_list

Testcases:
No testcase defined.

group::get_not_cached (private)

 group::get_not_cached -group_id group_id

Get basic info about a group: group_name, join_policy.

Switches:
-group_id (required)
Returns:
dict containing group_name, title, join_policy, and description

Partial Call Graph (max 5 caller/called nodes):
%3 group::get group::get (public) group::get_not_cached group::get_not_cached group::get->group::get_not_cached db_1row db_1row (public) group::get_not_cached->db_1row

Testcases:
No testcase defined.

group::get_rel_segment (public)

 group::get_rel_segment -group_id group_id -type type

Get a segment for a particular relation type for a given group.

Switches:
-group_id (required)
-type (required)

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_rel_segment_new acs_subsite_rel_segment_new (test acs-subsite) group::get_rel_segment group::get_rel_segment test_acs_subsite_rel_segment_new->group::get_rel_segment test_test_inheritance_and_custom_permissions test_inheritance_and_custom_permissions (test acs-tcl) test_test_inheritance_and_custom_permissions->group::get_rel_segment db_string db_string (public) group::get_rel_segment->db_string install::xml::object_id::application-group install::xml::object_id::application-group (public) install::xml::object_id::application-group->group::get_rel_segment install::xml::object_id::group install::xml::object_id::group (public) install::xml::object_id::group->group::get_rel_segment packages/acs-subsite/www/permissions/toggle-inherit.tcl packages/acs-subsite/ www/permissions/toggle-inherit.tcl packages/acs-subsite/www/permissions/toggle-inherit.tcl->group::get_rel_segment

Testcases:
acs_subsite_rel_segment_new, test_inheritance_and_custom_permissions

group::get_rel_types_options (public)

 group::get_rel_types_options -group_id group_id \
    [ -object_type object_type ]

Get the valid relationship-types for this group in a format suitable for a select widget in the form builder. The label used is the name of the role for object two.

Switches:
-group_id (required)
The ID of the group for which to get options.
-object_type (optional, defaults to "person")
The object type which must occupy side two of the relationship. Typically 'person' or 'group'.
Returns:
a list of lists with label (role two pretty name) and ID (rel_type)

Partial Call Graph (max 5 caller/called nodes):
%3 packages/acs-subsite/lib/user-new.tcl packages/acs-subsite/ lib/user-new.tcl group::get_rel_types_options group::get_rel_types_options packages/acs-subsite/lib/user-new.tcl->group::get_rel_types_options packages/acs-subsite/www/members/member-invite.tcl packages/acs-subsite/ www/members/member-invite.tcl packages/acs-subsite/www/members/member-invite.tcl->group::get_rel_types_options db_foreach db_foreach (public) group::get_rel_types_options->db_foreach lang::util::localize lang::util::localize (public) group::get_rel_types_options->lang::util::localize

Testcases:
No testcase defined.

group::group_p (private)

 group::group_p -group_id group_id

Test, of group exists

Switches:
-group_id (required)
The group_id of the group

Partial Call Graph (max 5 caller/called nodes):
%3 db_string db_string (public) group::group_p group::group_p group::group_p->db_string

Testcases:
No testcase defined.

group::join_policy (public)

 group::join_policy -group_id group_id

Returns a group's join policy ('open', 'closed', or 'needs approval')

Switches:
-group_id (required)
Author:
Oumi Mehrotra <oumi@arsdigita.com>
Created:
10/2000

Partial Call Graph (max 5 caller/called nodes):
%3 test_subsite_api subsite_api (test acs-subsite) group::join_policy group::join_policy test_subsite_api->group::join_policy group::get group::get (public) group::join_policy->group::get packages/acs-subsite/www/admin/configure.tcl packages/acs-subsite/ www/admin/configure.tcl packages/acs-subsite/www/admin/configure.tcl->group::join_policy packages/acs-subsite/www/group-join.tcl packages/acs-subsite/ www/group-join.tcl packages/acs-subsite/www/group-join.tcl->group::join_policy packages/acs-subsite/www/index.tcl packages/acs-subsite/ www/index.tcl packages/acs-subsite/www/index.tcl->group::join_policy

Testcases:
subsite_api

group::member_p (public)

 group::member_p [ -user_id user_id ] [ -group_name group_name ] \
    [ -group_id group_id ] [ -subsite_id subsite_id ] [ -cascade ]

Return 1 if the user is a member of the group specified. You can specify a group name or group id. If there is more than one group with this name, it will use the first one. 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.

Switches:
-user_id (optional)
-group_name (optional)
-group_id (optional)
-subsite_id (optional)
Only useful when using group_name. Marks the subsite in which to search for the group_id that belongs to the group_name
-cascade (optional, boolean)
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_check_composite_group acs_subsite_check_composite_group (test acs-subsite) group::member_p group::member_p test_acs_subsite_check_composite_group->group::member_p ad_conn ad_conn (public) group::member_p->ad_conn ad_log ad_log (public) group::member_p->ad_log group::get_id group::get_id (public) group::member_p->group::get_id group::member_p_not_cached group::member_p_not_cached (private) group::member_p->group::member_p_not_cached packages/acs-authentication/lib/local-search.tcl packages/acs-authentication/ lib/local-search.tcl packages/acs-authentication/lib/local-search.tcl->group::member_p packages/acs-subsite/www/group-join.tcl packages/acs-subsite/ www/group-join.tcl packages/acs-subsite/www/group-join.tcl->group::member_p packages/acs-subsite/www/group-leave.tcl packages/acs-subsite/ www/group-leave.tcl packages/acs-subsite/www/group-leave.tcl->group::member_p packages/acs-subsite/www/index.tcl packages/acs-subsite/ www/index.tcl packages/acs-subsite/www/index.tcl->group::member_p packages/acs-subsite/www/members/member-invite.tcl packages/acs-subsite/ www/members/member-invite.tcl packages/acs-subsite/www/members/member-invite.tcl->group::member_p

Testcases:
acs_subsite_check_composite_group

group::member_p_not_cached (private)

 group::member_p_not_cached -user_id user_id -group_id group_id \
    [ -cascade_p cascade_p ]

Return 1 if the user is a member of the group specified. If cascade_p 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_p is false, then the user must have specifically been granted membership on the group in question.

Switches:
-user_id (required)
-group_id (required)
-cascade_p (optional, defaults to "f")
Returns:
boolean value
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 group::member_p group::member_p (public) group::member_p_not_cached group::member_p_not_cached group::member_p->group::member_p_not_cached db_boolean db_boolean (public) group::member_p_not_cached->db_boolean db_string db_string (public) group::member_p_not_cached->db_string

Testcases:
No testcase defined.

group::new (public)

 group::new [ -form_id form_id ] [ -variable_prefix variable_prefix ] \
    [ -creation_user creation_user ] [ -creation_ip creation_ip ] \
    [ -group_id group_id ] [ -context_id context_id ] \
    [ -group_name group_name ] [ -pretty_name pretty_name ] \
    [ group_type ]

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:


    # 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;
    "]

    

Switches:
-form_id (optional)
The form id from templating form system (see example above)
-variable_prefix (optional)
-creation_user (optional)
-creation_ip (optional)
-group_id (optional)
-context_id (optional)
-group_name (optional)
The name of this group. This is a required variable, though it may be specified either explicitly or through form_id
-pretty_name (optional)
Parameters:
group_type (optional, defaults to "group")
The type of group we are creating. Defaults to group which is what you want in most cases.
Returns:
group_id of the newly created group
Author:
Michael Bryzek <mbryzek@arsdigita.com>
Created:
10/2000

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_check_composite_group acs_subsite_check_composite_group (test acs-subsite) group::new group::new test_acs_subsite_check_composite_group->group::new test_acs_subsite_expose_bug_775 acs_subsite_expose_bug_775 (test acs-subsite) test_acs_subsite_expose_bug_775->group::new test_acs_subsite_group_type acs_subsite_group_type (test acs-subsite) test_acs_subsite_group_type->group::new test_acs_subsite_rel_segment_new acs_subsite_rel_segment_new (test acs-subsite) test_acs_subsite_rel_segment_new->group::new test_group_localization group_localization (test acs-subsite) test_group_localization->group::new db_0or1row db_0or1row (public) group::new->db_0or1row db_dml db_dml (public) group::new->db_dml lang::util::convert_to_i18n lang::util::convert_to_i18n (public) group::new->lang::util::convert_to_i18n lang::util::message_key_regexp lang::util::message_key_regexp (public) group::new->lang::util::message_key_regexp package_instantiate_object package_instantiate_object (public) group::new->package_instantiate_object packages/acs-subsite/www/admin/groups/new.tcl packages/acs-subsite/ www/admin/groups/new.tcl packages/acs-subsite/www/admin/groups/new.tcl->group::new

Testcases:
group_localization, acs_subsite_expose_bug_775, acs_subsite_check_composite_group, acs_subsite_group_type, acs_subsite_rel_segment_new

group::party_member_p (public)

 group::party_member_p [ -party_id party_id ] [ -group_id group_id ] \
    [ -group_name group_name ] [ -subsite_id subsite_id ]

Return 1 if the party is an approved member of the group specified. One can specify a group_id (preferred) or a group name. Note: The group name is not unique by definition, and if you call this function with a duplicate group name it will return the first one (arbitrary)!!! Using the group name as a parameter is thus strongly discouraged unless you are really, really sure the name is unique.

The party must have specifically been granted membership on the group in question.

Switches:
-party_id (optional)
-group_id (optional)
-group_name (optional)
-subsite_id (optional)

Partial Call Graph (max 5 caller/called nodes):
%3 test_subsite_api subsite_api (test acs-subsite) group::party_member_p group::party_member_p test_subsite_api->group::party_member_p ad_log ad_log (public) group::party_member_p->ad_log db_0or1row db_0or1row (public) group::party_member_p->db_0or1row group::get_id group::get_id (public) group::party_member_p->group::get_id packages/acs-subsite/www/members/index.tcl packages/acs-subsite/ www/members/index.tcl packages/acs-subsite/www/members/index.tcl->group::party_member_p

Testcases:
subsite_api

group::permission_p (public, deprecated)

 group::permission_p [ -user_id user_id ] [ -privilege privilege ] \
    group_id
Deprecated. Invoking this procedure generates a warning.

THIS PROC SHOULD GO AWAY! All calls to group::permission_p can be replaced with permission::permission_p Wrapper for ad_permission to allow us to bypass having to specify the read privilege

Switches:
-user_id (optional)
-privilege (optional, defaults to "read")
Parameters:
group_id (required)
Author:
Michael Bryzek <mbryzek@arsdigita.com>
Created:
10/2000
See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 ad_log_deprecated ad_log_deprecated (public) permission::permission_p permission::permission_p (public) group::permission_p group::permission_p group::permission_p->ad_log_deprecated group::permission_p->permission::permission_p

Testcases:
No testcase defined.

group::possible_member_states (public)

 group::possible_member_states

Returns the list of possible member states: approved, needs approval, banned, merged, rejected, deleted.

Partial Call Graph (max 5 caller/called nodes):
%3 packages/acs-subsite/www/admin/groups/elements-display-list.tcl packages/acs-subsite/ www/admin/groups/elements-display-list.tcl group::possible_member_states group::possible_member_states packages/acs-subsite/www/admin/groups/elements-display-list.tcl->group::possible_member_states packages/acs-subsite/www/admin/relations/one.tcl packages/acs-subsite/ www/admin/relations/one.tcl packages/acs-subsite/www/admin/relations/one.tcl->group::possible_member_states packages/acs-subsite/www/members/index.tcl packages/acs-subsite/ www/members/index.tcl packages/acs-subsite/www/members/index.tcl->group::possible_member_states

Testcases:
No testcase defined.

group::remove_member (public)

 group::remove_member -group_id group_id -user_id user_id

Removes a user from a group. No permission checking.

Switches:
-group_id (required)
-user_id (required)

Partial Call Graph (max 5 caller/called nodes):
%3 test_subsite_api subsite_api (test acs-subsite) group::remove_member group::remove_member test_subsite_api->group::remove_member db_list db_list (public) group::remove_member->db_list db_transaction db_transaction (public) group::remove_member->db_transaction group::flush_members_cache group::flush_members_cache (private) group::remove_member->group::flush_members_cache relation_remove relation_remove (public) group::remove_member->relation_remove membership_rel::change_state membership_rel::change_state (public) membership_rel::change_state->group::remove_member packages/acs-subsite/www/members/member-remove.tcl packages/acs-subsite/ www/members/member-remove.tcl packages/acs-subsite/www/members/member-remove.tcl->group::remove_member

Testcases:
subsite_api

group::title (public)

 group::title [ -group_name group_name ] [ -group_id group_id ]

Get the title of a group based either on group_name or on the group_id.

Switches:
-group_name (optional)
The name of the group. Note this is not the I18N title we want to retrieve with this procedure
-group_id (optional)
The group_id of the group

Partial Call Graph (max 5 caller/called nodes):
%3 test_acs_subsite_group_type acs_subsite_group_type (test acs-subsite) group::title group::title test_acs_subsite_group_type->group::title group::get_element group::get_element (public) group::title->group::get_element group::get_id group::get_id (public) group::title->group::get_id

Testcases:
acs_subsite_group_type

group::update (public)

 group::update -group_id group_id [ -array array ] [ dict ]

Updates a group.The updated values can be either specified as dict or as array. Valid columns are group_name, join_policy and description. Valid join_policy values are 'open', 'closed', 'needs approval'.

Switches:
-group_id (required)
The ID of the group to update.
-array (optional)
Name of array containing the columns to update.
Parameters:
dict (optional)
dict for columns to update.

Partial Call Graph (max 5 caller/called nodes):
%3 install::xml::action::set-join-policy install::xml::action::set-join-policy (public) group::update group::update install::xml::action::set-join-policy->group::update packages/acs-subsite/www/admin/configure.tcl packages/acs-subsite/ www/admin/configure.tcl packages/acs-subsite/www/admin/configure.tcl->group::update packages/acs-subsite/www/admin/subsite-add.tcl packages/acs-subsite/ www/admin/subsite-add.tcl packages/acs-subsite/www/admin/subsite-add.tcl->group::update db_dml db_dml (public) group::update->db_dml lang::util::convert_to_i18n lang::util::convert_to_i18n (public) group::update->lang::util::convert_to_i18n

Testcases:
No testcase defined.
[ hide source ] | [ make this the default ]

Content File Source

ad_library {

    Procs to manage groups

    @author mbryzek@arsdigita.com
    @creation-date Thu Dec  7 18:13:56 2000
    @cvs-id $Id: group-procs.tcl,v 1.60.2.18 2024/08/07 15:36:22 mischa Exp $

}


namespace eval group {}

d_proc -public group::new {
    { -form_id "" }
    { -variable_prefix "" }
    { -creation_user "" }
    { -creation_ip "" }
    { -group_id "" }
    { -context_id "" }
    { -group_name "" }
    { -pretty_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.

    <p>
    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.

    <p><b>Examples:</b>
    <pre>

    # 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;
    "]

    </pre>

    @author Michael Bryzek (mbryzek@arsdigita.com)
    @creation-date 10/2000

    @return <code>group_id</code> of the newly created group

    @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
    <code>form_id</code>.

    @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
    <code>form_id</code>

} {

    # 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 context_id $context_id]
    lappend var_list [list $id_column $group_id]
    if { $group_name ne "" } {
        lappend var_list [list group_name $group_name]
        if {$pretty_name eq ""} {
            set pretty_name $group_name
        }
    }

    set group_id [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]

    # We can't change the group_name to an I18N version as this would
    # break compatibility with group::member_p -group_name and the
    # like. So instead we change the title of the object of the group
    # (through the pretty name). We just have to change the display of
    # groups to the title at the appropriate places.
    #
    # In case, a pretty_name was already provided in form of a message
    # key, there is no need to convert this a second time.

    if {![regexp [lang::util::message_key_regexp$pretty_name]} {
        set pretty_name [lang::util::convert_to_i18n \
                             -object_id $group_id \
                             -message_key "group_title_${group_id}" \
                             -text $pretty_name]
    }

    # Update the title to the pretty name
    if {$pretty_name ne ""} {
        db_dml title_update "update acs_objects set title = :pretty_name where object_id = :group_id"
    }

    # Make sure the resolving of group id by name has a chance to
    # include this new group
    util_memoize_flush_pattern [list group::get_id_not_cached \
                                    -group_name $group_name]*

    return $group_id
}

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.

    @author Michael Bryzek (mbryzek@arsdigita.com)
    @creation-date 10/2000

    @return <code>object_type</code> of the deleted group, if it
            was actually deleted. Returns the empty string if the
            object didn't exist to begin with

    @param group_id The group to delete

} {
    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
    }

    # Maybe the relational constraint deletion should be moved to
    # the acs_group package...

    db_exec_plsql delete_group {}

    # Remove the automatically generated message key localizing the
    # group name
    lang::message::unregister acs-translations "group_title_${group_id}"

    return $object_type
}

d_proc -private group::get_not_cached {
    {-group_id:required}
} {
    Get basic info about a group: group_name, join_policy.

    @return dict containing group_name, title, join_policy, and description
} {
    db_1row group_info {
        select group_name, title, join_policy, description
        from   groups g, acs_objects o
        where  group_id = :group_id
        and object_id = :group_id
    } -column_array row
    return [array get row]
}

d_proc -public group::get {
    {-group_id:required}
    {-array}
} {
    Get basic info about a group: group_name, join_policy.

    @param array The name of an array in the caller's namespace where the info gets delivered.
    @return dict containing group_name, title, join_policy, and description
    @see group::get_element
} {
    set info [acs::group_cache eval -partition_key $group_id \
                  info-$group_id- {
                      group::get_not_cached -group_id $group_id
                  }]

    if {[info exists array]} {
        upvar 1 $array row
        array set row $info
    }
    return $info
}


d_proc -public group::get_element {
    {-group_id:required}
    {-element:required}
} {
    Get an element from the basic info about a group: group_name, join_policy.

    @see group::get
} {
    return [dict get [group::get -group_id $group_id$element]
}

d_proc -public group::get_id {
    {-group_name:required}
    {-subsite_id ""}
    {-application_group_id ""}
} {
    Retrieve the group_id to a given group-name. If you have more than one group with this name, it will return the first one it finds.
    Keep that in mind when using this procedure.

    @author Christian Langmann (C_Langmann@gmx.de)
    @author Malte Sussdorff (openacs@sussdorff.de)
    @creation-date 2005-06-09

    @param group_name the name of the group to look for
    @param subsite_id the ID of the subsite to search for the group name
    @param application_group_id the ID of the application group to search for the group name

    @return the first group_id of the groups found for that group_name.

} {
    return [util_memoize [list group::get_id_not_cached \
                              -group_name $group_name \
                              -subsite_id $subsite_id \
                              -application_group_id $application_group_id]]
}

d_proc -private group::get_id_not_cached {
    {-group_name:required}
    {-subsite_id ""}
    {-application_group_id ""}
} {
    Retrieve the group_id to a given group-name.

    @author Christian Langmann (C_Langmann@gmx.de)
    @author Malte Sussdorff (openacs@sussdorff.de)
    @creation-date 2005-06-09

    @param group_name the name of the group to look for

    @return the id of the group

    @error
} {
    if {$subsite_id ne ""} {
        if {$application_group_id ne ""} {
            ad_log warning "group::get_id '$group_name': overwriting specified application_group_id by application group of subsite"
        }
        set application_group_id [application_group::group_id_from_package_id \
                                      -package_id $subsite_id]
    }

    if {$application_group_id ne ""} {
        set group_ids [db_list get_group_id_with_application {
            SELECT g.group_id
            FROM   acs_rels rels
            INNER JOIN composition_rels comp ON rels.rel_id = comp.rel_id
            INNER JOIN groups g              ON rels.object_id_two = g.group_id
            WHERE rels.object_id_one = :application_group_id
            AND   g.group_name = :group_name
        }]
    } else {
        set group_ids [db_list get_group_id {
            select group_id
            from groups
            where group_name = :group_name
        }]
    }
    if {[llength $group_ids] > 1} {
        ad_log warning "group::get_id for '$group_name' returns more than one value; returning the first one"
    }
    return [lindex $group_ids 0]
}

d_proc -public group::get_members {
    {-group_id:required}
    {-type "party"}
    {-rel_type ""}
    {-member_state ""}
} {
    Get party_ids of all members from cache.

    @param type Type of members - party, person, user
    @param member_state when specified, return only members in this
                        membership state

    @see group::get_members_not_cached
    @see group::flush_members_cache

    @author Timo Hentschel (timo@timohentschel.de)
    @creation-date 2005-07-26
} {
    acs::group_cache eval -partition_key $group_id \
        members-$group_id-$type-$rel_type-$member_state {
            group::get_members_not_cached -group_id $group_id \
                -type $type -rel_type $rel_type -member_state $member_state
        }
}

d_proc -private group::get_members_not_cached {
    {-group_id:required}
    {-type:required}
    {-rel_type ""}
    {-member_state ""}
} {
    Get party_ids of all members.

    @param type Type of members - party, person, user
    @param member_state when specified, return only members in this
                        membership state

    @see group::get_members
    @see group::flush_members_cache

    @author Timo Hentschel (timo@timohentschel.de)
    @creation-date 2005-07-26
} {
    return [db_list group_members {
        select distinct member_id
        from group_member_map m
        where group_id = :group_id
          and (:member_state is null or
               (select member_state from membership_rels
                 where rel_id = m.rel_id) = :member_state)
          and (:type is null or
               :type = 'party' or
               (select object_type from acs_objects
                 where object_id = m.member_id) = :type)
          and (:rel_type is null or
               rel_type = :rel_type)
    }]
}


d_proc -private group::flush_members_cache {
    {-group_id:required}
} {
    Flush group members cache.

    @see group::get_members
    @see group::get_members_not_cached

    @author Timo Hentschel (timo@timohentschel.de)
    @creation-date 2005-07-26
} {
    ::acs::group_cache flush_pattern -partition_key $group_id *-$group_id-*
}

d_proc -deprecated -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 permission::permission_p

    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

    @see permission::permission_p

} {
    return [permission::permission_p -party_id $user_id -privilege $privilege -object_id $group_id]
}

d_proc -public group::join_policy {
    {-group_id:required}
} {
    Returns a group's join policy ('open', 'closed', or 'needs approval')

    @author Oumi Mehrotra (oumi@arsdigita.com)
    @creation-date 10/2000

} {
    return [dict get [group::get -group_id $group_id] join_policy]
}

d_proc -public group::description {
    {-group_id:required}
} {
    Returns a group's description

    @creation-date 09/2008

} {
    return [dict get [group::get -group_id $group_id] description]
}

d_proc -public group::update {
    {-group_id:required}
    {-array}
    {dict ""}
} {

    Updates a group.The updated values can be either specified as dict or as array.
    Valid columns are group_name, join_policy and description.
    Valid join_policy values are 'open', 'closed', 'needs approval'.

    @param group_id The ID of the group to update.
    @param array    Name of array containing the columns to update.
    @param dict     dict for columns to update.
} {

    # Construct clauses for the update statement
    set columns { group_name join_policy description }
    if {[llength $dict] == 0} {
        upvar $array row
        set dict [array get row]
    }
    set set_clauses [list]
    
    foreach {name value} $dict {
        if {$name ni $columns} {
            error "Attribute '$name' isn't valid for groups."
        }
        lappend set_clauses "$name = :$name"
        set $name $value
    }

    if { [llength $set_clauses] == 0 } {
        # No rows to update
        return
    }

    db_dml update_group "
        update groups
        set    [join $set_clauses ,]
        where  group_id = :group_id
    "

    if {[info exists group_name]} {
        set pretty_name [lang::util::convert_to_i18n \
                             -message_key "group_title_${group_id}" \
                             -text "$group_name"]
        db_dml update_object_title {
            update acs_objects
            set title = :pretty_name
            where object_id = :group_id
        }
    }
    acs::group_cache flush -partition_key $group_id info-$group_id-
}

ad_proc -public group::possible_member_states {} {
    Returns the list of possible member states: approved, needs approval, banned, merged, rejected, deleted.
} {
    return [list approved "needs approval" banned merged rejected deleted]
}

d_proc -public group::get_member_state_pretty {
    {-member_state:required}
    {-component pretty_name}
    {-user_name ""}
    {-community_name ""}
    {-site_name ""}
    {-url ""}
    {-locale ""}
} {
    Returns the pretty-name of a member state.
} {
    if {$member_state ni {approved banned deleted merged "needs approval" rejected}} {
        error "invalid member_state '$member_state'"
    }
    #
    # We can't use spaces in message keys, so replace it with a "_".
    #
    regsub -all -- " " $member_state "_" member_state

    switch -- $component {
        pretty_name {
            set message #acs-kernel.member_state_$member_state#
        }
        action {
            if {$user_name eq ""} { error "user_name must be specified and must be nonempty" }
            set message #acs-kernel.member_state_action_$member_state#
        }
        account_mail {
            if {$site_name eq ""} { error "site_name must be specified and must be nonempty" }
            if {[string match "#*#" $site_name]} {
                # site names can be localized
                set site_name [lang::util::localize $site_name $locale]
            }
            if {$url eq ""} { error "url must be specified and must be nonempty" }
            set message #acs-kernel.member_state_account_mail_$member_state#
        }
        community_mail {
            if {$community_name eq ""} { error "community_name must be specified and must be nonempty" }
            if {[string match "#*#" $community_name]} {
                # community_names can be localized
                set community_name [lang::util::localize $community_name $locale]
            }
            if {$url eq ""} { error "url must be specified and must be nonempty" }
            set message #acs-kernel.member_state_community_mail_$member_state#
        }
        default {
            error "invalid component '$component'"
        }
    }

    return [lang::util::localize $message $locale]
}


ad_proc -public group::get_join_policy_options {} {
    Returns a list of valid join policies in a format suitable for a form builder drop-down.
} {
    return [list \
                [list [_ acs-kernel.common_open] "open"] \
                [list [_ acs-kernel.common_needs_approval] "needs approval"] \
                [list [_ acs-kernel.common_closed] "closed"]]
}

d_proc -public group::default_member_state {
    { -join_policy "" }
    { -create_p false }
    -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'.

    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.

    @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')

    @param create_p - 1 if the user has 'create' privilege on the group,
                      0 otherwise.
} {
    if {$create_p || $join_policy eq "open"} {
        return "approved"
    }

    if {$join_policy eq "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."
    }

    return ""
}


d_proc -public group::member_p {
    {-user_id ""}
    {-group_name ""}
    {-group_id ""}
    {-subsite_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 there is more than one group with this name, it will use the first one.

    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.

    @param subsite_id Only useful when using group_name. Marks the subsite in which to search for the group_id that belongs to the group_name

    @see group::flush_members_cache

} {

    if { $user_id eq "" } {
        set user_id [ad_conn user_id]
    }

    if { $group_name eq "" && $group_id eq "" } {
        ad_log warning "group::member_p: neither group_name nor group_id was provided; returning 0"
        return 0
    }

    if { $group_name ne "" } {
        set group_id [group::get_id -group_name $group_name -subsite_id $subsite_id]
        if { $group_id eq "" } {
            ad_log warning "group::member_p: could not lookup '$group_name' (for subsite_id '$subsite_id'); returning 0"
            return 0
        }
    }

    return [acs::group_cache eval -partition_key $group_id \
                member-$group_id-$user_id-$cascade_p {
                    group::member_p_not_cached -group_id $group_id -user_id $user_id -cascade_p $cascade_p
                }]
    #return [util_memoize [list group::member_p_not_cached -group_id $group_id -user_id $user_id -cascade_p $cascade_p]]
}

d_proc -private group::member_p_not_cached {
    -user_id:required
    -group_id:required
    {-cascade_p f}
} {
    Return 1 if the user is a member of the group specified.

    If cascade_p 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_p is false, then the user must have specifically been
    granted membership on the group in question.

    @return boolean value
    @see group::flush_members_cache

} {

    set cascade [db_boolean $cascade_p]
    set result [db_string user_is_member {} -default "f"]

    return [string is true -strict $result]
}

d_proc -public group::party_member_p {
    -party_id
    { -group_id "" }
    { -group_name "" }
    { -subsite_id "" }
} {

    Return 1 if the party is an approved member of the group
    specified.

    One can specify a group_id (preferred) or a group name.
    <strong>Note:</strong> The group name is <strong>not</strong>
    unique by definition, and if you call this function with a
    duplicate group name it <strong>will</strong> return the first one
    (arbitrary)!!! Using the group name as a parameter is thus
    strongly discouraged unless you are really, really sure the name
    is unique.</p>

    <p>The party must have specifically been granted
    membership on the group in question.</p>

} {
    if { $group_name ne "" } {
        if {$group_id ne ""} {
            ad_log warning "group::party_member_p: ignore specified group_id $group_id, using name '$group_name' instead"
        }
        set group_id [group::get_id -group_name $group_name -subsite_id $subsite_id]
    }

    if { $group_id eq "" } {
        set result 0
    } else {
        # Limiting to one row is required for those groups that define
        # relational segments (e.g. subsites, as for admins two rows
        # will be there for both their roles of member and
        # administrator).
        set result [db_0or1row party_is_member {
            select 1 from dual where exists
            (select 1 from group_approved_member_map
             where member_id = :party_id
             and group_id = :group_id)
        }]
    }
    return $result
}

d_proc -public group::get_rel_segment {
    {-group_id:required}
    {-type:required}
} {
    Get a segment for a particular relation type for a given group.
} {
    return [db_string select_segment_id {
        select segment_id from rel_segments
        where group_id = :group_id and rel_type = :type
    }]
}

d_proc -public group::get_rel_types_options {
    {-group_id:required}
    {-object_type "person"}
} {
    Get the valid relationship-types for this group in a format suitable for a select widget in the form builder.
    The label used is the name of the role for object two.

    @param group_id The ID of the group for which to get options.

    @param object_type The object type which must occupy side two of the relationship. Typically 'person' or 'group'.
    @return a list of lists with label (role two pretty name) and ID (rel_type)
} {
    # LARS:
    # The query has a hack to make sure 'membership_rel' appears before all other rel types
    set rel_types [list]
    db_foreach select_rel_types {} {
        # Localize the name
        lappend rel_types [list [lang::util::localize $pretty_name$rel_type]
    }
    return $rel_types
}

d_proc -public group::admin_p {
    {-group_id:required}
    {-user_id:required}
} {
    @return 1 if user_id is in the admin_rel for group_id
} {
    set admin_rel_id [relation::get_id \
                          -object_id_one $group_id \
                          -object_id_two $user_id \
                          -rel_type "admin_rel"]

    # The party is an admin if the call above returned something nonempty
    return [expr {$admin_rel_id ne ""}]
}


d_proc -public group::add_member {
    {-no_perm_check:boolean}
    {-no_automatic_membership_rel:boolean}
    {-group_id:required}
    {-user_id:required}
    {-rel_type ""}
    {-member_state ""}
} {
    Adds a user to a group, checking that the rel_type is permissible given the user's privileges,
    Can default both the rel_type and the member_state to their relevant values.

    @param no_perm_check avoid permission check
    @param no_automatic_membership_rel Use this flag, when we do not want to add automatically a membership_rel (e.g. in DotLRN)
    @param group_id group, to which a member should be added
    @param user_id user, which should be added to a group
    @param rel_type relationship type to be used (defaults to membership_rel)
    @param member_state state, in which member should be added  (gets default via group::default_member_state)

} {
    set admin_p [permission::permission_p -object_id $group_id -privilege "admin"]

    # Only admins can add non-membership_rel members
    if { $rel_type eq ""
         || (!$no_perm_check_p
             && $rel_type ne ""
             && $rel_type ne "membership_rel"
             && ![permission::permission_p -object_id $group_id -privilege "admin"])
     } {
        set rel_type "membership_rel"
    }

    group::get -group_id $group_id -array group

    if { !$no_perm_check_p } {
        set create_p [permission::permission_p -object_id $group_id -privilege "create"]
        if { $group(join_policy) eq "closed" && !$create_p } {
            error "You do not have permission to add members to the group '$group(group_name)'"
        }
    } else {
        set create_p 1
    }

    if { $member_state eq "" } {
        set member_state [group::default_member_state \
                              -join_policy $group(join_policy) \
                              -create_p $create_p]
    }

    if { !$no_automatic_membership_rel_p && $rel_type ne "membership_rel" } {
        # add them with a membership_rel first
        relation_add -member_state $member_state "membership_rel" $group_id $user_id
    }
    relation_add -member_state $member_state $rel_type $group_id $user_id

    #
    # Flush all permission checks pertaining to this user.
    #
    permission::cache_flush -party_id $user_id
    #
    # Flush members cache for the group
    #
    flush_members_cache -group_id $group_id
}


d_proc -public group::remove_member {
    {-group_id:required}
    {-user_id:required}
} {
    Removes a user from a group. No permission checking.
} {

    # Find all acs_rels between this group and this user, which are membership_rels or descendants thereof (admin_rels, for example)
    set rel_id_list [db_list select_rel_ids {
        select r.rel_id
        from   acs_rels r,
               membership_rels mr
        where  r.rel_id = mr.rel_id
        and    r.object_id_one = :group_id
        and    r.object_id_two = :user_id
    }]

    db_transaction {
        foreach rel_id $rel_id_list {
            relation_remove $rel_id
        }
    }

    flush_members_cache -group_id $group_id
}

d_proc -public group::title {
    {-group_name ""}
    {-group_id ""}
} {

    Get the title of a group based either on group_name or on the group_id.

    @param group_id The group_id of the group
    @param group_name The name of the group. Note this is not the I18N title we want to retrieve with this procedure
} {
    if {$group_name ne ""} {
        if {$group_id ne ""} {
            error "specify either -group_name or -group_id, but not both"
        }
        set group_id [group::get_id -group_name $group_name]
    }

    if {$group_id ne ""} {
        return [group::get_element -group_id $group_id -element "title"]
    } else {
        return ""
    }
}

d_proc -private group::group_p {
    {-group_id:required}
} {
    Test, of group exists

    @param group_id The group_id of the group
} {
    return [acs::group_cache eval -partition_key $group_id \
                exists-$group_id- {
                    db_string group {select 1 from groups where group_id = :group_id} -default 0
                }]
}


# Local variables:
#    mode: tcl
#    tcl-indent-level: 4
#    indent-tabs-mode: nil
# End: