package_instantiate_object (public)

 package_instantiate_object [ -creation_user creation_user ] \
    [ -creation_ip creation_ip ] [ -package_name package_name ] \
    [ -var_list var_list ] [ -extra_vars extra_vars ] \
    [ -start_with start_with ] [ -form_id form_id ] \
    [ -variable_prefix variable_prefix ] object_type

Defined in packages/acs-subsite/tcl/package-procs.tcl

Creates a new object of the specified type by calling the associated PL/SQL package new function.

Switches:
-creation_user
(optional)
The current user. Defaults to [ad_conn user_id] if not specified and there is a connection
-creation_ip
(optional)
The current user's IP address. Defaults to [ad_conn peeraddr] if not specified and there is a connection
-package_name
(optional)
The PL/SQL package associated with this object type. Defaults to acs_object_types.package_name
-var_list
(optional)
A list of pairs of additional attributes and their values to pass to the constructor. Each pair is a list of two elements: key => value
-extra_vars
(optional)
an ns_set of extra vars
-start_with
(optional)
The object type to start with when gathering attributes for this object type. Defaults to the object type.
-form_id
(optional)
The form id from templating form system if we're using the forms API to specify attributes
-variable_prefix
(optional)
Parameters:
object_type - The object type of the object we are instantiating
Returns:
The object id of the newly created object

Example: 


    template::form create add_group
    template::element create add_group group_name -value "Publisher"

    set var_list [list  [list context_id $context_id]   [list group_id $group_id]]

    return [package_instantiate_object  -start_with "group"  -var_list $var_list  -form_id "add_group"  "group"]
Authors:
Michael Bryzek <mbryzek@arsdigita.com>
Ben Adida <ben@openforce.net>
Created:
02/01/2001

Partial Call Graph (max 5 caller/called nodes):
%3 test_auth_authenticate auth_authenticate (test acs-authentication) package_instantiate_object package_instantiate_object test_auth_authenticate->package_instantiate_object test_auth_create_user auth_create_user (test acs-authentication) test_auth_create_user->package_instantiate_object test_category_tree_procs category_tree_procs (test categories) test_category_tree_procs->package_instantiate_object test_object_p object_p (test acs-tcl) test_object_p->package_instantiate_object _ _ (public) package_instantiate_object->_ acs_object_type::get acs_object_type::get (public) package_instantiate_object->acs_object_type::get ad_conn ad_conn (public) package_instantiate_object->ad_conn db_exec_plsql db_exec_plsql (public) package_instantiate_object->db_exec_plsql package_object_attribute_list package_object_attribute_list (public) package_instantiate_object->package_object_attribute_list bug_tracker::bug::insert bug_tracker::bug::insert (public) bug_tracker::bug::insert->package_instantiate_object calendar::new calendar::new (public) calendar::new->package_instantiate_object content::folder::new content::folder::new (public) content::folder::new->package_instantiate_object forum::message::new forum::message::new (public) forum::message::new->package_instantiate_object forum::new forum::new (public) forum::new->package_instantiate_object

Testcases:
auth_authenticate, auth_create_user, object_p, category_tree_procs
Source code:

    if {$variable_prefix ne ""} {
        append variable_prefix "."
    }

    if {[catch {
        acs_object_type::get -object_type $object_type -array acs_type
        set package_name $acs_type(package_name)
    } errmsg]} {
        error "Object type \"$object_type\" does not exist"
    }    
    
    # Select out the package name if it wasn't passed in
    if { $package_name eq "" } {        
        set package_name $acs_type(package_name)
    }

    if { [ns_conn isconnected] } {
        if { $creation_user eq "" } {
            set creation_user [ad_conn user_id]
        }
        if { $creation_ip eq "" } {
            set creation_ip [ad_conn peeraddr]
        }
    }

    if {$creation_user == 0} {
        set creation_user ""
    }

    lappend var_list [list creation_user $creation_user]
    lappend var_list [list creation_ip $creation_ip]
    lappend var_list [list object_type $object_type]

    # The first thing we need to do is select out the list of all
    # the parameters that can be passed to this object type's new function.
    # This will prevent us from passing in any parameters that are
    # not defined

    foreach arg [package_plsql_args $package_name] {
        set real_params([string toupper $arg]) 1
    }

    # Use pieces to generate the parameter list to the new
    # function. Pieces is just a list of lists where each list contains only
    # one item - the name of the parameter. We keep track of
    # parameters we've already added in the array param_array (all keys are
    # in uppercase)

    set pieces [list]

    foreach pair $var_list {
        lassign $pair __key __value
        if { ![info exists real_params([string toupper $__key])] } {
            # The parameter is not accepted as a parameter to the
            # pl/sql function. Ignore it.
            continue;
        }
        lappend pieces [list $__key]
        set param_array([string toupper $__key]) 1
        # Set the value for binding
        set $__key $__value
    }

    # Go through the extra_vars (ben - OpenACS)
    if {$extra_vars ne "" } {
        foreach {__key __value} [ns_set array $extra_vars] {
            if { ![info exists real_params([string toupper $__key])] } {
                # The parameter is not accepted as a parameter to the
                # pl/sql function. Ignore it.
                continue;
            }
            lappend pieces [list $__key]
            set param_array([string toupper $__key]) 1
            # Set the value for binding
            set $__key $__value
        }
    }


    if { $form_id ne ""} {

        set __id_column $acs_type(id_column)
        if { [info exists real_params([string toupper $__id_column])]
             && ![info exists param_array([string toupper $__id_column])]
         } {
            set param_array([string toupper $__id_column]) 1
            set $__id_column [template::element::get_value $form_id "$variable_prefix$__id_column"]
            lappend pieces [list $__id_column]
        }

        if {$start_with eq ""} {
            set start_with $object_type
        }

        # Append the values from the template form for each attribute
        foreach row [package_object_attribute_list -start_with $start_with $object_type] {
            set __attribute [lindex $row 2]
            if { [info exists real_params([string toupper $__attribute])]
                 && ![info exists param_array([string toupper $__attribute])]
             } {
                set param_array([string toupper $__attribute]) 1
                set $__attribute [template::element::get_value $form_id "$variable_prefix$__attribute"]

                lappend pieces [list $__attribute]
            }
        }
    }

ns_log notice package_instantiate_object.create_object-Q=[subst {     select ${package_name}__new([plpgsql_utility::generate_attribute_parameter_call  -prepend ":"  ${package_name}__new  $pieces])}]

    set object_id [db_exec_plsql create_object {}]

    if { [ns_conn isconnected] } {
        subsite::callback -object_type $object_type "insert" $object_id
    }

    # BUG FIX (ben - OpenACS)
    return $object_id
Generic XQL file:
packages/acs-subsite/tcl/package-procs.xql

PostgreSQL XQL file:
<fullquery name="package_instantiate_object.create_object">
    <querytext>

        select ${package_name}__new([plpgsql_utility::generate_attribute_parameter_call \
                -prepend ":" \
                ${package_name}__new \
                $pieces])

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

Oracle XQL file:
<fullquery name="package_instantiate_object.create_object">
    <querytext>
      
    BEGIN
      :1 := ${package_name}.new([plsql_utility::generate_attribute_parameter_call \
	      -prepend ":" \
	      -indent [expr [string length $package_name] + 29] \
	      $pieces]
      );
    END; 
    
      </querytext>
</fullquery>
packages/acs-subsite/tcl/package-procs-oracle.xql

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