user_id defaults to ad_conn
- user_id if we have a connection. If there is no
- connection, and no user id, throws an error.
+ Returns 1 if the user has permission to delete all groups of
+ the specified type. 0 otherwise. user_id defaults to ad_conn
+ user_id 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
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 12/2000
} {
- if { $user_id eq "" } {
- if { ![ad_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.\n"
- }
- set user_id [ad_conn user_id]
- }
- return [db_string group_exists_p {}]
+ if { $user_id eq "" } {
+ if { ![ad_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.\n"
+ }
+ set user_id [ad_conn user_id]
+ }
+ return [db_string group_exists_p {}]
}
-
+
ad_proc -public new {
- { -group_type "" }
- { -execute_p "t" }
- { -supertype "group" }
- pretty_name
- pretty_plural
+ { -group_type "" }
+ { -execute_p "t" }
+ { -supertype "group" }
+ pretty_name
+ pretty_plural
} {
- Creates a new group type
+ 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"] -+
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"] +- @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. + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 12/2000 - @param execute_p If t, we execute the pl/sql. If f, we return + @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
group_type of the object created
+ @return the group_type 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 [string toupper "${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 upper(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,
+ 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 [string toupper "${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 upper(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
- }
+ 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
+ # 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"]
+ 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
+ # 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]
+ 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"
- }
+ 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]]
-
+ # 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]]
@@ -128,57 +128,57 @@
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]
- }
+ 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
+ }
- # The following create table statement commits the
- # transaction. If it fails, we roll back what we've done.
+ foreach pair $plsql {
+ db_exec_plsql [lindex $pair 0] [lindex $pair 1]
+ }
- if { [catch {db_exec_plsql create_table [subst {
- create table $table_name (
- $id_column integer
+ # 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)
+ 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
+ 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 {}
+ # We need to add something to the group_types table, too! (Ben - OpenACS)
+ db_dml insert_group_type {}
- # Finally, create the PL/SQL package.
+ # Finally, create the PL/SQL package.
- package_recreate_hierarchy $group_type
+ package_recreate_hierarchy $group_type
- return $group_type
+ return $group_type
}
-
+
}
# Local variables: