+ +
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. @@ -38,33 +38,33 @@ # 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) @@ -92,7 +92,7 @@ # 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 @@ -131,8 +131,8 @@ if {![regexp [lang::util::message_key_regexp] $pretty_name]} { set pretty_name [lang::util::convert_to_i18n -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" @@ -158,8 +158,8 @@ 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 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 :) @@ -168,9 +168,9 @@ # Maybe the relational constraint deletion should be moved to # the acs_group package... - + db_exec_plsql delete_group " - BEGIN + 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. @@ -185,7 +185,7 @@ end loop; -- delete the actual group - ${package_name}.del(:group_id); + ${package_name}.del(:group_id); END; " @@ -198,7 +198,7 @@ {-array:required} } { 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. @see group::get_element @@ -271,8 +271,8 @@ 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 {}] } else { @@ -340,24 +340,24 @@ util_memoize_flush_regexp [list group::member_p_not_cached -group_id $group_id (.*)] } -ad_proc -deprecated -public group::permission_p { +ad_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 party::permission_p + 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 party::permission_p + @see permission::permission_p } { - return [party::permission_p -user_id $user_id -privilege $privilege $group_id] + return [permission::permission_p -party_id $user_id -privilege $privilege -object_id $group_id] } ad_proc -public group::join_policy { @@ -392,16 +392,16 @@ {-array:required} } { Updates a group. - + @param group_id The ID of the group to update. @param array Name of array containing the columns to update. - Valid columns are group_name, join_policy. + Valid columns are group_name, join_policy. Valid join_policy values are 'open', 'closed', 'needs approval'. } { upvar $array row - + # Construct clauses for the update statement set columns { group_name join_policy description } set set_clauses [list] @@ -459,7 +459,7 @@ # 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# @@ -475,7 +475,7 @@ set site_name [lang::util::localize $site_name $locale] } if {$url eq ""} { error "url must be specified and must be non-empty" } - set message #acs-kernel.member_state_account_mail_$member_state# + 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 non-empty" } @@ -490,7 +490,7 @@ error "invalid component '$component'" } } - + return [lang::util::localize $message $locale] } @@ -509,9 +509,9 @@ { -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 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'. @@ -522,11 +522,11 @@ @author Oumi Mehrotra (oumi@arsdigita.com) @creation-date 10/2000 - - @param join_policy - the group's join policy + + @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, + @param create_p - 1 if the user has 'create' privilege on the group, 0 otherwise. } { if {$create_p || $join_policy eq "open"} { @@ -584,7 +584,7 @@ return 0 } } - + return [util_memoize [list group::member_p_not_cached -group_id $group_id -user_id $user_id -cascade_p $cascade_p]] } @@ -612,7 +612,7 @@ set cascade [db_boolean $cascade_p] set result [db_string user_is_member {} -default "f"] - + return [template::util::is_true $result] } @@ -622,7 +622,7 @@ { -group_name "" } { -subsite_id "" } } { - + Return 1 if the party is an approved member of the group specified. @@ -636,7 +636,7 @@
The party must have specifically been granted membership on the group in question.
- + } { if { $group_name ne "" } { if {$group_id ne ""} { @@ -705,7 +705,7 @@ -rel_type "admin_rel"] # The party is an admin if the call above returned something non-empty - return [expr {$admin_rel_id ne ""}] + return [expr {$admin_rel_id ne ""}] } @@ -762,18 +762,18 @@ {-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 { + 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 @@ -795,7 +795,7 @@ } { if {$group_name ne ""} { set group_id [group::get_id -group_name $group_name] - } + } if {$group_id ne ""} { return [util_memoize [list group::title_not_cached -group_id $group_id]] Index: openacs-4/packages/acs-subsite/tcl/party-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/Attic/party-procs.tcl,v diff -u -r1.11 -r1.12 --- openacs-4/packages/acs-subsite/tcl/party-procs.tcl 25 Apr 2018 08:40:23 -0000 1.11 +++ openacs-4/packages/acs-subsite/tcl/party-procs.tcl 7 Jun 2018 16:52:40 -0000 1.12 @@ -13,37 +13,41 @@ namespace eval party { - ad_proc -public permission_p { - { -user_id "" } - { -privilege "read" } - party_id + ad_proc -deprecated -public permission_p { + { -user_id "" } + { -privilege "read" } + party_id } { - Wrapper for ad_permission to allow us to bypass having to - specify the read privilege + 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 + Deprecated: just another wrapper for permission::permission_p + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 10/2000 + + @see permission::permission_p + } { - return [permission::permission_p -party_id $user_id -object_id $party_id -privilege $privilege] + return [permission::permission_p -party_id $user_id -object_id $party_id -privilege $privilege] } - ad_proc new { + ad_proc new { { -form_id "" } { -variable_prefix "" } { -creation_user "" } { -creation_ip "" } - { -party_id "" } - { -context_id "" } + { -party_id "" } + { -context_id "" } { -email "" } - party_type + party_type } { Creates a party of this type by calling the .new function for the package associated with the given party_type. This function will fail if there is no package. - -+ +
There are now several ways to create a party 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 party type. @@ -53,33 +57,33 @@ # OPTION 1: Create the party using the Tcl Procedure. Useful if the # only attribute you need to specify is the party name - + db_transaction { set party_id [party::new -email "joe@foo.com" $party_type] } - - + + # OPTION 2: Create the party using the Tcl API with a templating # form. Useful when there are multiple attributes to specify for the # party - + template::form create add_party template::element create add_party email -value "joe@foo.com" - + db_transaction { set party_id [party::new -form_id add_party $party_type ] } - + # OPTION 3: Create the party using the PL/SQL package automatically # created for it - + # creating the new party set party_id [db_exec_plsql add_party " begin :1 := ${party_type}.new (email => 'joe@foo.com'); end; "] - + @author Oumi Mehrotra (oumi@arsdigita.com) @@ -102,7 +106,7 @@ # We select out the name of the primary key. Note that the # primary key is equivalent to party_id as this is a subtype of # acs_party - + if { ![db_0or1row package_select { select t.package_name, lower(t.id_column) as id_column from acs_object_types t @@ -134,14 +138,14 @@ {-rel_type "membership_rel"} } { creates multirow datasource containing party types starting with - the $start_with party type. The datasource has columns that are + the $start_with party type. The datasource has columns that are identical to the relation_types_allowed_to_group_multirow, which is why - the columns are broadly named "object_*" instead of "party_*". A - common template can be used for generating select widgets etc. for + the columns are broadly named "object_*" instead of "party_*". A + common template can be used for generating select widgets etc. for both this datasource and the relation_types_allowed_to_groups_multirow datasource. - All subtypes of $start_with are returned, but the "valid_p" column in + All subtypes of $start_with are returned, but the "valid_p" column in the datasource indicates whether the type is a valid one for $group_id. Includes fields that are useful for @@ -156,10 +160,10 @@ @author Oumi Mehrotra (oumi@arsdigita.com) @creation-date 2000-02-07 - + @param datasource_name @param start_with - @param rel_type - if unspecified, then membership_rel is used + @param rel_type - if unspecified, then membership_rel is used } { template::multirow create $datasource_name \ @@ -180,15 +184,15 @@ } } - + ad_proc -public email { {-party_id:required} } { this returns the parties email. Cached } { return [util_memoize [list ::party::email_not_cached -party_id $party_id]] } - + ad_proc -private email_not_cached { {-party_id:required} } { @@ -203,7 +207,7 @@ {-email ""} } { Gets the party name of the provided party_id - + @author Miguel Marin (miguelmarin@viaro.net) @author Viaro Networks www.viaro.net @@ -219,7 +223,7 @@ } elseif {"" ne $party_id && "" ne $email } { error "Only provide party_id OR email, not both" } - + if {$party_id eq ""} { set party_id [party::get_by_email -email $email] } @@ -229,34 +233,34 @@ } else { if { [apm_package_installed_p "organizations"] } { set name [db_string get_org_name {} -default ""] - } - + } + if { $name eq "" } { set name [db_string get_group_name {} -default ""] } if { $name eq "" } { set name [db_string get_party_name {} -default ""] } - + } return $name } ad_proc -public party_p { -object_id:required } { - + @author Malte Sussdorff @creation-date 2007-01-26 - + @param object_id object_id which is checked if it is a party @return true if object_id is a party - + } { return [db_string party_p {} -default 0] } - + } # Local variables: Index: openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl 7 Aug 2017 23:47:58 -0000 1.6 +++ openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl 7 Jun 2018 16:52:40 -0000 1.7 @@ -7,7 +7,7 @@ @author mbryzek@arsdigita.com @creation-date Tue Dec 12 16:37:45 2000 @cvs-id $Id$ - + } ad_proc -public rel_segments_new { @@ -16,7 +16,7 @@ { -creation_ip "" } group_id rel_type - segment_name + segment_name } { Creates a new relational segment @@ -39,10 +39,10 @@ } ad_proc -public rel_segments_delete { - segment_id + segment_id } { Deletes the specified relational segment including all relational - constraints that depend on it. + constraints that depend on it. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 1/12/2001 @@ -58,10 +58,10 @@ } db_exec_plsql rel_segment_delete {} - + } -ad_proc -public rel_segments_permission_p { +ad_proc -deprecated -public rel_segments_permission_p { { -user_id "" } { -privilege "read" } segment_id @@ -70,9 +70,13 @@ Wrapper for ad_permission to allow us to bypass having to specify the read privilege + Deprecated: just another wrapper for permission::permission_p + @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/2000 + @see permission::permission_p + } { return [permission::permission_p -party_id $user_id -object_id $segment_id -privilege $privilege] } Index: openacs-4/packages/acs-subsite/tcl/relation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/relation-procs.tcl,v diff -u -r1.19 -r1.20 --- openacs-4/packages/acs-subsite/tcl/relation-procs.tcl 18 Apr 2018 08:07:33 -0000 1.19 +++ openacs-4/packages/acs-subsite/tcl/relation-procs.tcl 7 Jun 2018 16:52:40 -0000 1.20 @@ -12,16 +12,20 @@ namespace eval relation {} -ad_proc -public relation_permission_p { +ad_proc -deprecated -public relation_permission_p { { -user_id "" } { -privilege "read" } rel_id } { Wrapper for ad_permission_p that lets us default to read permission + Deprecated: just another wrapper for permission::permission_p + @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/2000 + @see permission::permission_p + } { return [permission::permission_p -party_id $user_id -object_id $rel_id -privilege $privilege] } Index: openacs-4/packages/forums/tcl/forums-security-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/forums/tcl/forums-security-procs.tcl,v diff -u -r1.19 -r1.20 --- openacs-4/packages/forums/tcl/forums-security-procs.tcl 8 Nov 2017 12:05:55 -0000 1.19 +++ openacs-4/packages/forums/tcl/forums-security-procs.tcl 7 Jun 2018 16:59:24 -0000 1.20 @@ -13,18 +13,22 @@ ad_proc -private do_abort {} { do an abort if security violation } { - if { [ad_conn user_id] == 0 } { + if { [ad_conn user_id] == 0 } { ad_redirect_for_registration } else { ad_returnredirect "not-allowed" } ad_script_abort - } + } - ad_proc -public can_read_forum_p { + ad_proc -deprecated -public can_read_forum_p { {-user_id ""} {-forum_id:required} } { + Deprecated: just another wrapper to permission::permission_p + + @see permission::permission_p + } { return [permission::permission_p -party_id $user_id -object_id $forum_id -privilege read] } @@ -49,7 +53,7 @@ -user_id $user_id]} { return true } - + forum::get -forum_id $forum_id -array forum # Others can post if forum is not closed. The public can post @@ -67,10 +71,14 @@ } } - ad_proc -public can_moderate_forum_p { + ad_proc -deprecated -public can_moderate_forum_p { {-user_id ""} {-forum_id:required} } { + Deprecated: just another wrapper to permission::permission_p + + @see permission::permission_p + } { return [permission::permission_p -party_id $user_id -object_id $forum_id -privilege forum_moderate] } @@ -93,17 +101,17 @@ set array(admin_p) [forum::security::can_moderate_forum_p -forum_id $forum_id] set array(moderate_p) $array(admin_p) set array(post_p) [expr {$array(admin_p) || [forum::security::can_post_forum_p -forum_id $forum_id -user_id $user_id]}] - } + } ### Deprecated procs ### - # 2017-09-26: + # 2017-09-26: # we decided to simplify forums management and unwire dependency # with the registered_users group. This prevented forums package # to be ever used in a subsite aware context. Now posting policy # and new-threads-allowed won't be managed via setting # permsissions, but through plain table columns. Forum will also # decide for permissions on the messages. - + ad_proc -deprecated -public can_read_message_p { {-user_id ""} {-message_id:required} @@ -119,7 +127,7 @@ forum::message::get -message_id $message_id -array message return [require_read_forum -forum_id $message(forum_id) -user_id $user_id] } - + ad_proc -deprecated -public can_post_message_p { {-user_id ""} {-message_id:required} @@ -148,7 +156,7 @@ {-user_id ""} {-message_id:required} } { - forum::message::get -message_id $message_id -array message + forum::message::get -message_id $message_id -array message return [require_moderate_forum -forum_id $message(forum_id) -user_id $user_id] }