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:
Index: openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl,v
diff -u -N -r1.17 -r1.18
--- openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl 14 Jun 2018 09:16:48 -0000 1.17
+++ openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl 14 Jun 2018 09:18:13 -0000 1.18
@@ -9,20 +9,20 @@
ad_page_contract_filter rel_type_dynamic_p {name value} {
Checks whether the value (assumed to be a string referring to a
- relationship type) is a dynamic object type.
+ relationship type) is a dynamic object type.
@author Michael Bryzek (mbryzek@arsdigita.com)
@creation-date 12/30/2000
} {
if {[db_string rel_type_dynamic_p {
- select case when exists (select 1
+ select case when exists (select 1
from acs_object_types t
where t.dynamic_p = 't'
and t.object_type = :value)
- then 1 else 0 end
- from dual
+ then 1 else 0 end
+ from dual
}]} {
- return 1
+ return 1
}
ad_complain "Specific rel type either does not exist or is not dynamic and thus cannot be modified"
return 0
@@ -31,278 +31,278 @@
namespace eval rel_types {
ad_proc -public additional_rel_types_p {
- {-group_id "" }
- {-group_type "" }
+ {-group_id "" }
+ {-group_type "" }
} {
- Returns 1 if there is a relationship type not being used by
- the specified group_id or group_type. Useful for deciding when
- to offer the user a link to create or add a new permissible
- relationship type
+ Returns 1 if there is a relationship type not being used by
+ the specified group_id or group_type. Useful for deciding when
+ to offer the user a link to create or add a new permissible
+ relationship type
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 12/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 12/2000
} {
- if {$group_id ne ""} {
- return [additional_rel_types_group_p $group_id]
- } elseif {$group_type ne ""} {
- return [additional_rel_types_group_type_p $group_type]
- } else {
- error "rel_types::rel_types_p error: One of group_id or group_type must be specified"
- }
+ if {$group_id ne ""} {
+ return [additional_rel_types_group_p $group_id]
+ } elseif {$group_type ne ""} {
+ return [additional_rel_types_group_type_p $group_type]
+ } else {
+ error "rel_types::rel_types_p error: One of group_id or group_type must be specified"
+ }
}
ad_proc -private additional_rel_types_group_p {
- group_id
+ group_id
} {
- returns 1 if there is a rel type that is not defined as a
- segment for this group
+ returns 1 if there is a rel type that is not defined as a
+ segment for this group
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 12/30/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 12/30/2000
} {
- return [db_string group_rel_type_exists {}]
+ return [db_string group_rel_type_exists {}]
}
ad_proc -private additional_rel_types_group_type_p {
- group_type
+ group_type
} {
- returns 1 if there is a rel type that is not defined as
- allowable for the specified group_type.
+ returns 1 if there is a rel type that is not defined as
+ allowable for the specified group_type.
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 12/30/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 12/30/2000
} {
- return [db_string group_rel_type_exists {}]
+ return [db_string group_rel_type_exists {}]
}
ad_proc -public new {
- {-supertype "relationship" }
- {-role_one "" }
- {-role_two "" }
- {-table_name ""}
- {-create_table_p "t"}
- rel_type
- pretty_name
- pretty_plural
- object_type_one
- min_n_rels_one
- max_n_rels_one
- object_type_two
- min_n_rels_two
- max_n_rels_two
+ {-supertype "relationship" }
+ {-role_one "" }
+ {-role_two "" }
+ {-table_name ""}
+ {-create_table_p "t"}
+ rel_type
+ pretty_name
+ pretty_plural
+ object_type_one
+ min_n_rels_one
+ max_n_rels_one
+ object_type_two
+ min_n_rels_two
+ max_n_rels_two
{composable_p "t"}
} {
- Creates a new relationship type named rel_type
+ Creates a new relationship type named rel_type
- @author Michael Bryzek (mbryzek@arsdigita.com)
- @creation-date 12/30/2000
+ @author Michael Bryzek (mbryzek@arsdigita.com)
+ @creation-date 12/30/2000
} {
- # use 29 chars to leave 1 character in the name for later dynamic
- # views
+ # use 29 chars to leave 1 character in the name for later dynamic
+ # views
- set rel_type [plsql_utility::generate_oracle_name \
- -max_length 29 $rel_type]
- if {[plsql_utility::object_type_exists_p $rel_type]} {
- error "Specified relationship type, $rel_type, already exists (or another object of the same type exists)\n"
- }
+ set rel_type [plsql_utility::generate_oracle_name \
+ -max_length 29 $rel_type]
+ if {[plsql_utility::object_type_exists_p $rel_type]} {
+ error "Specified relationship type, $rel_type, already exists (or another object of the same type exists)\n"
+ }
- if {![db_0or1row parent_rel_type {
- select table_name as references_table,
- id_column as references_column
- from acs_object_types
- where object_type=:supertype}]} {
- error "The specified supertype \"$supertype\" does not exist"
- }
+ if {![db_0or1row parent_rel_type {
+ select table_name as references_table,
+ id_column as references_column
+ from acs_object_types
+ where object_type=:supertype}]} {
+ error "The specified supertype \"$supertype\" does not exist"
+ }
- # use 29 chars to leave 1 character in the name for later dynamic
- # views
+ # use 29 chars to leave 1 character in the name for later dynamic
+ # views
- if {$table_name eq ""} {
- set table_name [plsql_utility::generate_oracle_name \
- -max_length 29 "${rel_type}_ext"]
- }
- set package_name $rel_type
+ if {$table_name eq ""} {
+ set table_name [plsql_utility::generate_oracle_name \
+ -max_length 29 "${rel_type}_ext"]
+ }
+ set package_name $rel_type
- # We use rel_id for the primary key... since this is a relationship
+ # We use rel_id for the primary key... since this is a relationship
- set pk_constraint_name [plsql_utility::generate_constraint_name $table_name rel_id "pk"]
- set fk_constraint_name [plsql_utility::generate_constraint_name $table_name rel_id "fk"]
+ set pk_constraint_name [plsql_utility::generate_constraint_name $table_name rel_id "pk"]
+ set fk_constraint_name [plsql_utility::generate_constraint_name $table_name rel_id "fk"]
- set plsql [list]
+ set plsql [list]
- # Create the actual acs object type
+ # Create the actual acs object type
- lappend plsql_drop [list db_exec_plsql drop_type {}]
- lappend plsql [list db_exec_plsql create_type {}]
+ lappend plsql_drop [list db_exec_plsql drop_type {}]
+ lappend plsql [list db_exec_plsql create_type {}]
- # Mark the type as dynamic
+ # Mark the type as dynamic
- lappend plsql [list db_dml update_type FOO]
-
- # Force internationalisation of Roles
-
- # Internationalising of Attributes. This is done by storing the
- # attribute with its acs-lang key
-
- set message_key "rel_type_${rel_type}"
+ lappend plsql [list db_dml update_type FOO]
- # Register the language keys
-
- lang::message::register en_US acs-translations $message_key $pretty_name
- lang::message::register en_US acs-translations "${message_key}_plural" $pretty_plural
-
- # Replace the pretty_name and pretty_plural with the message key, so
- # it is inserted correctly in the database
-
- set pretty_name "#acs-translations.${message_key}#"
- set pretty_plural "#acs-translations.${message_key}_plural#"
+ # Force internationalisation of Roles
- foreach cmd $plsql {
- {*}$cmd
- }
+ # Internationalising of Attributes. This is done by storing the
+ # attribute with its acs-lang key
- # The following create table statement commits the transaction. If it
- # fails, we roll back what we've done.
+ set message_key "rel_type_${rel_type}"
- if {$create_table_p == "t"} {
- if {[catch {db_exec_plsql create_table [subst {
+ # Register the language keys
+
+ lang::message::register en_US acs-translations $message_key $pretty_name
+ lang::message::register en_US acs-translations "${message_key}_plural" $pretty_plural
+
+ # Replace the pretty_name and pretty_plural with the message key, so
+ # it is inserted correctly in the database
+
+ set pretty_name "#acs-translations.${message_key}#"
+ set pretty_plural "#acs-translations.${message_key}_plural#"
+
+ foreach cmd $plsql {
+ {*}$cmd
+ }
+
+ # The following create table statement commits the transaction. If it
+ # fails, we roll back what we've done.
+
+ if {$create_table_p == "t"} {
+ if {[catch {db_exec_plsql create_table [subst {
create table $table_name (
rel_id integer
constraint $fk_constraint_name
references $references_table ($references_column)
constraint $pk_constraint_name primary key
)}]} errmsg]} {
- # Roll back our work so far
+ # Roll back our work so far
- for {set i [expr {[llength $plsql_drop] - 1}]} {$i >= 0} {incr i -1} {
- set drop_cmd [lindex $plsql_drop $i]
- if {[catch $dropcmd err_msg_2]} {
- append errmsg "\nAdditional error while trying to roll back: $err_msg_2"
- return -code error $errmsg
- }
- }
- return -code error $errmsg
- }
- }
+ for {set i [expr {[llength $plsql_drop] - 1}]} {$i >= 0} {incr i -1} {
+ set drop_cmd [lindex $plsql_drop $i]
+ if {[catch $dropcmd err_msg_2]} {
+ append errmsg "\nAdditional error while trying to roll back: $err_msg_2"
+ return -code error $errmsg
+ }
+ }
+ return -code error $errmsg
+ }
+ }
- # Finally, create the PL/SQL package.
+ # Finally, create the PL/SQL package.
- package_recreate_hierarchy $rel_type
+ package_recreate_hierarchy $rel_type
- return $rel_type
+ return $rel_type
}
ad_proc -public add_permissible {
- group_type
- rel_type
+ group_type
+ rel_type
} {
- Add a permissible relationship for a given group type
+ Add a permissible relationship for a given group type
} {
- if {[catch {
- set group_rel_type_id [db_nextval acs_object_id_seq]
- db_dml insert_rel_type {}
- } errmsg]} {
- }
+ if {[catch {
+ set group_rel_type_id [db_nextval acs_object_id_seq]
+ db_dml insert_rel_type {}
+ } errmsg]} {
+ }
}
ad_proc -public remove_permissible {
- group_type
- rel_type
+ group_type
+ rel_type
} {
- Add a permissible relationship for a given group type
+ Add a permissible relationship for a given group type
} {
- if {[catch {
- db_dml delete_rel_type {}
- } errmsg]} {
- }
+ if {[catch {
+ db_dml delete_rel_type {}
+ } errmsg]} {
+ }
}
ad_proc -public create_role {
- {-pretty_name:required}
- {-pretty_plural:required}
- {-role}
+ {-pretty_name:required}
+ {-pretty_plural:required}
+ {-role}
} {
- Create a new Relationship Role
+ Create a new Relationship Role
- @author Malte Sussdorff (sussdorff@sussdorff.de)
- @creation-date 2005-06-04
+ @author Malte Sussdorff (sussdorff@sussdorff.de)
+ @creation-date 2005-06-04
- @param pretty_name
+ @param pretty_name
- @param pretty_plural
+ @param pretty_plural
- @param role
+ @param role
- @return 1 if successful
+ @return 1 if successful
} {
- if {![info exists role] || $role eq ""} {
- set role [util_text_to_url \
- -text $pretty_name \
- -replacement "_" \
- -existing_urls [db_list get_roles {}]]
- }
+ if {![info exists role] || $role eq ""} {
+ set role [util_text_to_url \
+ -text $pretty_name \
+ -replacement "_" \
+ -existing_urls [db_list get_roles {}]]
+ }
- set return_code 1
+ set return_code 1
- db_transaction {
+ db_transaction {
- # Force internationalisation of Roles
+ # Force internationalisation of Roles
- # Internationalising of Attributes. This is done by storing the
- # attribute with its acs-lang key
+ # Internationalising of Attributes. This is done by storing the
+ # attribute with its acs-lang key
- set message_key "role_${role}"
+ set message_key "role_${role}"
- # Register the language keys
+ # Register the language keys
- lang::message::register en_US acs-translations $message_key $pretty_name
- lang::message::register en_US acs-translations "${message_key}_plural" $pretty_plural
+ lang::message::register en_US acs-translations $message_key $pretty_name
+ lang::message::register en_US acs-translations "${message_key}_plural" $pretty_plural
- # Replace the pretty_name and pretty_plural with the message key, so
- # it is inserted correctly in the database
+ # Replace the pretty_name and pretty_plural with the message key, so
+ # it is inserted correctly in the database
- set pretty_name "#acs-translations.${message_key}#"
- set pretty_plural "#acs-translations.${message_key}_plural#"
- db_exec_plsql create_role {}
- } on_error {
- set return_code 0
- }
- return $return_code
+ set pretty_name "#acs-translations.${message_key}#"
+ set pretty_plural "#acs-translations.${message_key}_plural#"
+ db_exec_plsql create_role {}
+ } on_error {
+ set return_code 0
+ }
+ return $return_code
}
ad_proc -public delete_role {
- {-role}
+ {-role}
} {
- Drop a Relationship Role.
+ Drop a Relationship Role.
- @author Nick Carroll (nick.c@rroll.net)
- @creation-date 2005-11-18
+ @author Nick Carroll (nick.c@rroll.net)
+ @creation-date 2005-11-18
- @param role The role to delete.
+ @param role The role to delete.
- @return Returns 1 if successful, otherwise 0.
+ @return Returns 1 if successful, otherwise 0.
} {
- set return_code 1
+ set return_code 1
- db_transaction {
- # Create the message key (refer to rel_types::create_role).
- # Required to unregister translations.
- set message_key "role_${role}"
+ db_transaction {
+ # Create the message key (refer to rel_types::create_role).
+ # Required to unregister translations.
+ set message_key "role_${role}"
- # Unegister the language keys
- lang::message::unregister acs-translations $message_key
- lang::message::unregister acs-translations "${message_key}_plural"
+ # Unegister the language keys
+ lang::message::unregister acs-translations $message_key
+ lang::message::unregister acs-translations "${message_key}_plural"
- db_exec_plsql drop_role {}
- } on_error {
- set return_code 0
- }
- return $return_code
+ db_exec_plsql drop_role {}
+ } on_error {
+ set return_code 0
+ }
+ return $return_code
}
}