group_type::new (public)

 group_type::new [ -group_type group_type ] [ -execute_p execute_p ] \
    [ -supertype supertype ] pretty_name pretty_plural

Defined in packages/acs-subsite/tcl/group-type-procs.tcl

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):
%3 test_acs_subsite_group_type acs_subsite_group_type (test acs-subsite) group_type::new group_type::new test_acs_subsite_group_type->group_type::new db_1row db_1row (public) group_type::new->db_1row db_dml db_dml (public) group_type::new->db_dml db_exec_plsql db_exec_plsql (public) group_type::new->db_exec_plsql db_map db_map (public) group_type::new->db_map db_nextval db_nextval (public) group_type::new->db_nextval packages/acs-subsite/www/admin/group-types/new.tcl packages/acs-subsite/ www/admin/group-types/new.tcl packages/acs-subsite/www/admin/group-types/new.tcl->group_type::new

Testcases:
acs_subsite_group_type
Source code:
        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
Generic XQL file:
<fullquery name="group_type::new.select_group_id_column">
    <querytext>
      
	    select id_column from acs_object_types where object_type='group'
	
      </querytext>
</fullquery>

<fullquery name="group_type::new.supertype_table_column">
    <querytext>
      
	    select t.table_name as references_table,
                   t.id_column as references_column
  	      from acs_object_types t
	     where t.object_type = :supertype
	
      </querytext>
</fullquery>

<fullquery name="group_type::new.insert_group_type">
    <querytext>
		insert into group_types (group_type) values (:group_type)
	</querytext>
</fullquery>
packages/acs-subsite/tcl/group-type-procs.xql

PostgreSQL XQL file:
<fullquery name="group_type::new.drop_type">
    <querytext>

	  select acs_object_type__drop_type('$group_type', 'f');
      
      </querytext>
</fullquery>

<fullquery name="group_type::new.create_type">
    <querytext>

 select acs_object_type__create_type (
   :group_type,
   :pretty_name,
   :pretty_plural,
   :supertype,
   :table_name,
   :id_column,
   :package_name,
   'f',
   null,
   null
 )
      
      </querytext>
</fullquery>

<fullquery name="group_type::new.update_type">
    <querytext>
      
      begin
        update acs_object_types set dynamic_p='t' where object_type = :group_type;
	return null;
      end;

      </querytext>
</fullquery>

<fullquery name="group_type::new.copy_rel_types">
    <querytext>
      
      begin
        insert into group_type_rels 
	       (group_rel_type_id, rel_type, group_type)
	       select nextval('t_acs_object_id_seq'), r.rel_type, :group_type
	         from group_type_rels r
	        where r.group_type = :supertype;
        return null;
      end;

      </querytext>
</fullquery>
packages/acs-subsite/tcl/group-type-procs-postgresql.xql

Oracle XQL file:
<fullquery name="group_type::new.drop_type">
    <querytext>
    begin acs_object_type.drop_type('$group_type'); end;
  </querytext>
</fullquery>

<fullquery name="group_type::new.create_type">
    <querytext>
    BEGIN
     acs_object_type.create_type (
       supertype     => :supertype,
       object_type   => :group_type,
       pretty_name   => :pretty_name,
       pretty_plural => :pretty_plural,
       table_name    => upper(:table_name),
       id_column     => :id_column,
       package_name  => :package_name
     );
    END;
  </querytext>
</fullquery>

<fullquery name="group_type::new.update_type">
    <querytext>
    update acs_object_types set dynamic_p='t' where object_type = :group_type
  </querytext>
</fullquery>

<fullquery name="group_type::new.copy_rel_types">
    <querytext>
    insert into group_type_rels
    (group_rel_type_id, rel_type, group_type)
    select acs_object_id_seq.nextval, r.rel_type, :group_type
    from group_type_rels r
    where r.group_type = :supertype
  </querytext>
</fullquery>
packages/acs-subsite/tcl/group-type-procs-oracle.xql

[ hide source ] | [ make this the default ]
Show another procedure: