- Publicity: Public Only All
group-type-procs.tcl
Procs for creating group types
- Location:
- packages/acs-subsite/tcl/group-type-procs.tcl
- Created:
- Tue Nov 7 22:52:39 2000
- Author:
- mbryzek@arsdigita.com
- CVS Identification:
$Id: group-type-procs.tcl,v 1.12.2.4 2020/09/01 17:38:56 antoniop Exp $
Procedures in this file
- group_type::delete (public)
- group_type::drop_all_groups_p (public)
- group_type::new (public)
Detailed information
group_type::delete (public)
group_type::delete -group_type group_type
Deletes a group type
- Switches:
- -group_type
(required)- type to be deleted
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- acs_subsite_group_type
group_type::drop_all_groups_p (public)
group_type::drop_all_groups_p [ -user_id user_id ] group_type
Returns 1 if the user has permission to delete all groups of the specified type. 0 otherwise.
user_id
defaults toad_conn user_id
if we have a connection. If there is no connection, and no user id, throws an error.
- Switches:
- -user_id
(optional)- Parameters:
- group_type
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
group_type::new (public)
group_type::new [ -group_type group_type ] [ -execute_p execute_p ] \ [ -supertype supertype ] pretty_name pretty_plural
Creates a new group type
Example:
# create a new group of type user_discount_class set group_type [group_type::new -group_type $group_type -supertype group "User Discount Class" "User Discount Classes"]
- Switches:
- -group_type
(optional)- The type of group_type to create. If empty, we generate a unique group_type based on "group_id" where id is the next value from acs_object_id_seq.
- -execute_p
(defaults to"t"
) (optional)- If t, we execute the pl/sql. If f, we return a string that represents the pl/sql we are about to execute.
- -supertype
(defaults to"group"
) (optional)- Parameters:
- pretty_name
pretty_plural
- Returns:
- the
group_type
of the object created- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- acs_subsite_group_type
Content File Source
ad_library { Procs for creating group types @author mbryzek@arsdigita.com @creation-date Tue Nov 7 22:52:39 2000 @cvs-id $Id: group-type-procs.tcl,v 1.12.2.4 2020/09/01 17:38:56 antoniop Exp $ } namespace eval group_type { d_proc -public drop_all_groups_p { { -user_id "" } group_type } { Returns 1 if the user has permission to delete all groups of the specified type. 0 otherwise. <code>user_id</code> defaults to <code>ad_conn user_id</code> if we have a connection. If there is no connection, and no user id, throws an error. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/2000 } { if { $user_id eq "" } { if { ![ns_conn isconnected] } { error "group_type::drop_all_groups_p: User ID not specified and we have no connection from which to obtain current user ID." } set user_id [ad_conn user_id] } return [db_string group_exists_p { select case when exists (select 1 from acs_objects o where object_type = :group_type and not acs_permission.permission_p(o.object_id, :user_id, 'delete')) then 1 else 0 end from dual }] } d_proc -public new { { -group_type "" } { -execute_p "t" } { -supertype "group" } pretty_name pretty_plural } { Creates a new group type <p><b>Example:</b> <pre> # create a new group of type user_discount_class set group_type [group_type::new -group_type $group_type \ -supertype group \ "User Discount Class" "User Discount Classes"] </pre> @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/2000 @param group_type The type of group_type to create. If empty, we generate a unique group_type based on "group_id" where id is the next value from acs_object_id_seq. @param execute_p If t, we execute the pl/sql. If f, we return a string that represents the pl/sql we are about to execute. @return the <code>group_type</code> of the object created } { if { $group_type eq "" } { # generate a unique group type name. Note that we expect # the while loop to finish immediately while { $group_type eq "" || [plsql_utility::object_type_exists_p $group_type] } { set group_type "GROUP_[db_nextval "acs_object_id_seq"]" } } else { # use 29 chars to leave 1 character in the name for later dynamic views set group_type [plsql_utility::generate_oracle_name -max_length 29 $group_type] if { [plsql_utility::object_type_exists_p $group_type] } { error "Specified group type, $group_type, already exists" } } set table_name "${group_type}_ext" # Since all group types are extensions of groups, maintain a # unique group_id primary key set id_column [db_string select_group_id_column { select id_column from acs_object_types where object_type='group' }] set package_name [string tolower $group_type] # pull out information about the supertype db_1row supertype_table_column { select t.table_name as references_table, t.id_column as references_column from acs_object_types t where t.object_type = :supertype } # What happens if a constraint with the same name already # exists? We need to add robustness to the auto-generation of constraint # names at a later date. Probability of name collision is # small though so we leave it for a future version set constraint(fk) [plsql_utility::generate_constraint_name $table_name $id_column "fk"] set constraint(pk) [plsql_utility::generate_constraint_name $table_name $id_column "pk"] # Store the plsql in a list so that we can choose, at the end, # to either execute it or return it as a debug message set plsql [list] set plsql_drop [list] if { [db_table_exists $table_name] } { # What to do? Options: # a) throw an error # b) select a new table name (Though this is probably an # error in the package creation script...) # Choose (a) error "The type extension table, $table_name, for the object type, $group_type, already exists. You must either drop the existing table or enter a different group type" } # Create the table if it doesn't exist. lappend plsql_drop [list drop_type [db_map drop_type]] lappend plsql [list "create_type" [db_map create_type]] # Mark the type as dynamic lappend plsql [list update_type [db_map update_type]] # Now, copy the allowable relation types from the super type lappend plsql_drop [list remove_rel_types "delete from group_type_rels where group_type = :group_type"] lappend plsql [list copy_rel_types [db_map copy_rel_types]] if { $execute_p == "f" } { set text "-- Create script" foreach pair $plsql { append text "[plsql_utility::parse_sql [lindex $pair 1]]\n\n" } # Now add the drop script append text "-- Drop script\n"; for { set i [expr {[llength $plsql_drop] - 1}] } { $i >= 0 } { incr i -1 } { # Don't need the sql keys when we display debugging information append text "-- [lindex $plsql_drop $i 1]\n\n" } return $text } foreach pair $plsql { db_exec_plsql [lindex $pair 0] [lindex $pair 1] } # The following create table statement commits the # transaction. If it fails, we roll back what we've done. if { [catch {db_exec_plsql create_table [subst { create table $table_name ( $id_column integer constraint $constraint(pk) primary key constraint $constraint(fk) references $references_table ($references_column) )}]} errmsg] } { # Roll back our work so far for { set i [expr {[llength $plsql_drop] - 1}] } { $i >= 0 } { incr i -1 } { set pair [lindex $plsql_drop $i] if { [catch {db_exec_plsql [lindex $drop_pair 0] [lindex $drop_pair 1]} err_msg_2] } { append errmsg "\nAdditional error while trying to roll back: $err_msg_2" return -code error $errmsg } } return -code error $errmsg } # We need to add something to the group_types table, too! (Ben - OpenACS) db_dml insert_group_type {} # Finally, create the PL/SQL package. package_recreate_hierarchy $group_type return $group_type } d_proc -public delete { -group_type:required } { Deletes a group type @param group_type type to be deleted } { # How do we handle the situation where we delete the groups we can, # but there are groups that we do not have permission to delete? For # now, we check in advance if there is a group that must be deleted # that this user can't delete, and if there is, we return an error # message (in the validate block of page contract). If another group # is added while we're deleting, then it's possible that we'll fail # when actually dropping the type, but that seems reasonable to me. # - mbryzek (famous last words...) set user_id [ad_conn user_id] if { ![db_0or1row select_type_info { select t.table_name, t.package_name from acs_object_types t where t.object_type=:group_type }] } { set table_name "" set package_name $group_type } if { ![db_string package_exists {}] } { set package_name "" } db_transaction { # First delete the groups if { $package_name ne "" } { foreach group_id [db_list select_group_ids { select o.object_id from acs_objects o where o.object_type = :group_type and acs_permission.permission_p(o.object_id, :user_id, 'delete') }] { group::delete $group_id } db_exec_plsql package_drop {} } # Remove the specified rel_types db_dml delete_rel_types { delete from group_type_rels where group_type = :group_type } # Remove the group_type db_dml delete_group_type { delete from group_types where group_type = :group_type } if { [db_string type_exists { select case when exists (select 1 from acs_object_types t where t.object_type = :group_type) then 1 else 0 end from dual }] } { db_exec_plsql drop_type {} } # Make sure we drop the table last if { $table_name ne "" && [db_table_exists $table_name] } { db_dml drop_table [subst { drop table $table_name }] } } # Reset the attribute view for objects of this type package_object_view_reset $group_type } } # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: