rel-type-add-2.tcl
Adds a relationship type to the list of permissible ones for this group
- Location:
- /packages/acs-subsite/www/admin/groups/rel-type-add-2.tcl
- Author:
- mbryzek@arsdigita.com
- Created:
- Tue Jan 2 12:10:17 2001
- CVS ID:
$Id: rel-type-add-2.tcl,v 1.10.2.2 2020/01/03 13:05:29 antoniop Exp $
Related Files
- packages/acs-subsite/www/admin/groups/rel-type-add-2.xql
- packages/acs-subsite/www/admin/groups/rel-type-add-2.tcl
[ hide source ]
File Contents
ad_page_contract { Adds a relationship type to the list of permissible ones for this group @author mbryzek@arsdigita.com @creation-date Tue Jan 2 12:10:17 2001 @cvs-id $Id: rel-type-add-2.tcl,v 1.10.2.2 2020/01/03 13:05:29 antoniop Exp $ } { group_id:integer,notnull rel_type:notnull { return_url:localurl "" } } -validate { rel_type_acceptable_p -requires {group_id:notnull rel_type:notnull} { # This test makes sure this group can accept the specified rel # type. This means the group is itself a type (or subtype) of # rel_type.object_type_one db_1row select_group_type { select o.object_type as group_type from acs_objects o where o.object_id = :group_id } if { ![db_0or1row types_match_p { with recursive type_hierarchy as ( select object_type from acs_object_types where object_type = (select object_type_one from acs_rel_types where rel_type = :rel_type) union all select t.object_type from acs_object_types t, type_hierarchy h where t.supertype = h.object_type and h.object_type <> :group_type ) select 1 from type_hierarchy where object_type = :group_type }] } { ad_complain "Groups of type \"$group_type\" cannot use relationships of type \"$rel_type.\"" } } } if { [catch { set group_rel_id [db_nextval acs_object_id_seq] db_dml insert_rel_type { insert into group_rels (group_rel_id, group_id, rel_type) values (:group_rel_id, :group_id, :rel_type) } } err_msg]} { # Does this pair already exists? if { ![db_string exists_p { select case when exists (select 1 from group_rels where group_id = :group_id and rel_type = :rel_type) then 1 else 0 end from dual }] } { ad_return_error "Error inserting to database" $err_msg ad_script_abort } } # Now let's see if there is no relational segment. If not, offer to create one if { [db_string segment_exists_p { select case when exists (select 1 from rel_segments s where s.group_id = :group_id and s.rel_type = :rel_type) then 1 else 0 end from dual }] } { if { $return_url eq "" } { set return_url [export_vars -base one group_id] } ad_returnredirect $return_url } else { ad_returnredirect [export_vars -base constraints-create {group_id rel_type return_url}] } ad_script_abort # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: