- Publicity: Public Only All
package-procs.tcl
Procs to help build PL/SQL packages
- Location:
- packages/acs-subsite/tcl/package-procs.tcl
- Created:
- Wed Dec 27 16:02:44 2000
- Author:
- mbryzek@arsdigita.com
- CVS Identification:
$Id: package-procs.tcl,v 1.40.2.11 2024/07/25 13:08:52 mischa Exp $
Procedures in this file
- package_attribute_default (private)
- package_create (private)
- package_create_attribute_list (private)
- package_exec_plsql (public)
- package_function_p (private)
- package_generate_body (private)
- package_generate_spec (private)
- package_insert_default_comment (private)
- package_instantiate_object (public)
- package_object_attribute_list (public)
- package_object_view (public)
- package_object_view_helper (private)
- package_object_view_reset (public)
- package_plsql_args (private)
- package_recreate_hierarchy (public)
- package_table_columns_for_type (private)
- package_type_dynamic_p (public)
Detailed information
package_attribute_default (private)
package_attribute_default [ -min_n_values min_n_values ] \ [ -attr_default attr_default ] object_type table column
Returns a sql value to be used as the default in a pl/sql function or procedure parameter list. This is a special case, hardcoded function that specifies defaults for standard acs_object attributes.
- Switches:
- -min_n_values (optional, defaults to
"0"
)- Used to determine if an argument is required (e.g. required = min_n_values != 0)
- -attr_default (optional)
- The default values for this attribute as specified in the attributes table.
- Parameters:
- object_type (required)
- The object type that owns the attribute we are using. Used only to set a default for
acs_object.object_type
stored (either table_name from the attribute or for the object_type)- table (required)
- The table in which the value of this attribute is stored (either table_name from the attribute or for the object_type)
- column (required)
- The column in which the value of this attribute is stored (either column_name or attribute_name from the attributes table)
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/28/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_create (private)
package_create [ -debug_p debug_p ] object_type
Creates a packages with a new function and delete procedure for the specified object type. This function uses metadata exclusively to create the package. Resets the package_object_view cache Throws an error if the specified object type does not exist or is not dynamic
- Switches:
- -debug_p (optional, defaults to
"f"
)- If "t" then we return a text block containing the sql to create the package. Setting debug_p to t will not create the package.
- Parameters:
- object_type (required)
- The object type for which to create a package
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/27/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_create_attribute_list (private)
package_create_attribute_list [ -supertype supertype ] \ [ -object_name object_name ] [ -limit_to limit_to ] \ [ -table table ] [ -column column ] [ -column_value column_value ] \ object_type
Generates the list of attributes for this object type. Each element in the list is (table_name, column_name, default_value, column_value) where
default_value
andcolumn_value
are optional. Note that if either of table_name, id_column is unspecified, we retrieve the values for both from the acs_object_types table
- Switches:
- -supertype (optional)
- The supertype of the object we are creating. If specified, along with object_name, we lookup the parameters to supertype.object_name and include any missing parameters in our argument list.
- -object_name (optional)
- The name of the function / procedure we are creating. See supertype for explanation.
- -limit_to (optional)
- If empty, this argument is ignored. Otherwise, it is a list of all the columns to be included in the attribute list. Any attribute whose column_name is not in this list is then ignored.
- -table (optional)
- The
table_name
for this object_type (from theacs_object_types
tables)- -column (optional)
- The
id_column
for this object_type (from theacs_object_types
tables)- -column_value (optional)
- The value for this column in the present calling function. Useful when you are calling supertype function and need to refer to the supertype argument by a different name locally.
- Parameters:
- object_type (required)
- The object type for which we are generating attributes
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_exec_plsql (public)
package_exec_plsql [ -var_list var_list ] package_name object_name
Calls a pl/[pg]sql proc/func defined within the object type's package. Use of this Tcl API proc avoids the need for the developer to write separate SQL for each RDBMS we support.
- Switches:
- -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
- Parameters:
- package_name (required)
- The PL/[pg]SQL package
- object_name (required)
- The PL/[pg]SQL function within the package
- Returns:
- empty string for procs, function return value for funcs
Example:
set var_list [list [list group_id $group_id]] package_exec_plsql -var_list $var_list group delete- Author:
- Don Baccus <dhogaza@pacifier.com>
- Created:
- 12/31/2003
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- auth_authenticate
package_function_p (private)
package_function_p -object_name object_name package_name
- Switches:
- -object_name (required)
- Parameters:
- package_name (required)
- Returns:
- true if the package's object is a function.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_generate_body (private)
package_generate_body object_type
Generates plsql to create the package body
- Parameters:
- object_type (required)
- The name of the object type for which we are creating the package
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 10/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_generate_spec (private)
package_generate_spec object_type
Generates pl/sql to create a package specification. Does not execute the pl/sql - simply returns it.
- Parameters:
- object_type (required)
- The object for which to create a package spec
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 10/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_insert_default_comment (private)
package_insert_default_comment
Returns a string to be used verbatim as the default comment we insert into meta-generated packages and package bodies. If we have a connection, we grab the user's name from ad_conn user_id.
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/29/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
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
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 (required)
- 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):
- Testcases:
- auth_authenticate, auth_create_user, object_p, category_tree_procs
package_object_attribute_list (public)
package_object_attribute_list [ -start_with start_with ] \ [ -include_storage_types include_storage_types ] object_type
Returns a list of lists all the attributes (column name or attribute_name) to be used for this object type. Each list elements contains:
(attribute_id, table_name, attribute_name, pretty_name, datatype, required_p, default_value)
- Switches:
- -start_with (optional, defaults to
"acs_object"
)- The highest parent object type for which to include attributes
- -include_storage_types (optional, defaults to
"type_specific"
)- Parameters:
- object_type (required)
- The object type for which to include attributes
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/29/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- image_new, content_item
package_object_view (public)
package_object_view [ -refresh_p refresh_p ] \ [ -start_with start_with ] object_type
Returns a select statement to be used as an inner view for selecting out all the attributes for the object_type. util_memoizes the result
- Switches:
- -refresh_p (optional, defaults to
"f"
)- If t, force a reload of the cache
- -start_with (optional, defaults to
"acs_object"
)- The highest parent object type for which to include attributes
- Parameters:
- object_type (required)
- The object for which to create a package spec
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 10/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_object_view_helper (private)
package_object_view_helper [ -start_with start_with ] object_type
Returns a select statement to be used as an inner view for selecting out all the attributes for the object_type.
- Switches:
- -start_with (optional, defaults to
"acs_object"
)- The highest parent object type for which to include attributes
- Parameters:
- object_type (required)
- The object for which to create a package spec
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 10/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_object_view_reset (public)
package_object_view_reset object_type
Resets the cached views for all chains (e.g. all variations of start_with in package_object_view) for the specified object type.
- Parameters:
- object_type (required)
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_plsql_args (private)
package_plsql_args [ -object_name object_name ] package_name
Return a list of parameters expected to a plsql function defined within a given package and cache these per thread. Changes in the interface will require a server restart.
- Switches:
- -object_name (optional, defaults to
"NEW"
)- The function name which we're looking up
- Parameters:
- package_name (required)
- The package which owns the function
- Returns:
- list of parameters
- Author:
- Ben Adida <ben@openforce.net>
- Created:
- 11/2001
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_recreate_hierarchy (public)
package_recreate_hierarchy object_type
Recreates all the packages for the hierarchy starting with the specified object type down to a leaf. Resets the package_object_view cache. Note: Only updates packages for dynamic objects (those with dynamic_p set to t)
- Parameters:
- object_type (required)
- The object type for which to recreate packages, including all children types.
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/28/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_table_columns_for_type (private)
package_table_columns_for_type object_type
Generates the list of tables and columns that are parameters of the object named
NEW
for PL/SQL package associated with this object type.Note we limit the argument list to only object_type to make it possible to use
util_memoize_flush
to clear any cached values for this procedure.
- Parameters:
- object_type (required)
- The object type for which we are generating the list
- Returns:
- a list of lists where each list element is a pair of table name, column name
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
package_type_dynamic_p (public)
package_type_dynamic_p object_type
Returns 1 if the object type is dynamic. 0 otherwise
- Parameters:
- object_type (required)
- Author:
- Michael Bryzek <mbryzek@arsdigita.com>
- Created:
- 12/30/2000
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Content File Source
ad_library { Procs to help build PL/SQL packages @author mbryzek@arsdigita.com @creation-date Wed Dec 27 16:02:44 2000 @cvs-id $Id: package-procs.tcl,v 1.40.2.11 2024/07/25 13:08:52 mischa Exp $ } d_proc -public package_type_dynamic_p { object_type } { Returns 1 if the object type is dynamic. 0 otherwise @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/30/2000 } { return [db_0or1row object_type_dynamic_p { select 1 from acs_object_types where dynamic_p = 't' and object_type = :object_type }] } d_proc -private package_create_attribute_list { { -supertype "" } { -object_name "" } { -limit_to "" } { -table "" } { -column "" } { -column_value "" } object_type } { Generates the list of attributes for this object type. Each element in the list is (table_name, column_name, default_value, column_value) where <code>default_value</code> and <code>column_value</code> are optional. Note that if either of table_name, id_column is unspecified, we retrieve the values for both from the acs_object_types table @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/2000 @param supertype The supertype of the object we are creating. If specified, along with object_name, we lookup the parameters to supertype.object_name and include any missing parameters in our argument list. @param object_name The name of the function / procedure we are creating. See supertype for explanation. @param limit_to If empty, this argument is ignored. Otherwise, it is a list of all the columns to be included in the attribute list. Any attribute whose column_name is not in this list is then ignored. @param table The <code>table_name</code> for this object_type (from the <code>acs_object_types</code> tables) @param column The <code>id_column</code> for this object_type (from the <code>acs_object_types</code> tables) @param column_value The value for this column in the present calling function. Useful when you are calling supertype function and need to refer to the supertype argument by a different name locally. @param object_type The object type for which we are generating attributes } { if { $table eq "" || $column eq "" } { # pull out the table and column names based on the object type acs_object_type::get -object_type $object_type -array acs_type set table $acs_type(table_name) set column $acs_type(id_column) } # set toupper for case-insensitive searching set limit_to [string toupper $limit_to] # For the actual package spec and body, we build up a list of # the arguments and use a helper proc to generate the actual # pl/sql code. Note that the helper procs also return nicely # formatted pl/sql code set attr_list [list] # Start with the primary key for this object type. Continuing with # convention that id_column can be null (will default to new # object_id) lappend attr_list [list $table "$column" NULL $column_value] # the all_attributes array is used to ensure we do not have # duplicate column names set all_attributes([string toupper $column]) 1 if { $column_value ne "" } { # column value is the same physical column as $column - just # named differently in the attribute list. We still don't want # duplicates set all_attributes([string toupper $column_value]) 1 } # Now, loop through and gather all the attributes for this object # type and all its supertypes in order starting with this object # type up the type hierarchy db_foreach select_all_attributes {} { # First make sure the attribute is okay if { $limit_to ne "" } { # We have a limited list of arguments to use. Make sure # this attribute is one of them if {$attr_column_name ni $limit_to} { # This column is not in the list of allowed # columns... ignore continue } } set default [package_attribute_default \ -min_n_values $min_n_values \ -attr_default $default_value \ $object_type $attr_table_name $attr_column_name] lappend attr_list [list $attr_table_name $attr_column_name $default] set all_attributes($attr_column_name) 1 } if { $supertype ne "" && $object_name ne "" } { foreach row [util_memoize [list package_table_columns_for_type $supertype]] { lassign $row table_name column_name # Note that limit_to doesn't apply here as we always need # to include these arguments else the call will fail if { [info exists all_attributes($column_name)] } { continue } set all_attributes($column_name) 1 set default [package_attribute_default $object_type $table_name $column_name] lappend attr_list [list $table_name $column_name $default] } } return $attr_list } d_proc -private package_attribute_default { { -min_n_values "0" } { -attr_default "" } object_type table column } { Returns a sql value to be used as the default in a pl/sql function or procedure parameter list. This is a special case, hardcoded function that specifies defaults for standard acs_object attributes. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/28/2000 @param object_type The object type that owns the attribute we are using. Used only to set a default for <code>acs_object.object_type</code> stored (either table_name from the attribute or for the object_type) @param table The table in which the value of this attribute is stored (either table_name from the attribute or for the object_type) @param column The column in which the value of this attribute is stored (either column_name or attribute_name from the attributes table) @param min_n_values Used to determine if an argument is required (e.g. required = min_n_values != 0) @param attr_default The default values for this attribute as specified in the attributes table. } { # We handle defaults grossly here, but I don't currently have # a better idea how to do this if { $attr_default ne "" } { return [::ns_dbquotevalue $attr_default] } # Special cases for acs_object and acs_rels # attributes. Default case sets default to null unless the # attribute is required (min_n_values > 0) if {$table eq "ACS_OBJECTS"} { switch -- $column { "OBJECT_TYPE" { return [::ns_dbquotevalue $object_type] } "CREATION_DATE" { return [db_map creation_date] } "CREATION_IP" { return "NULL" } "CREATION_USER" { return "NULL" } "LAST_MODIFIED" { return [db_map last_modified] } "MODIFYING_IP" { return "NULL" } } } elseif {$table eq "ACS_RELS"} { switch -- $column { "REL_TYPE" { return [::ns_dbquotevalue $object_type] } } } # return to null unless this attribute is required # (min_n_values > 0) return [expr {$min_n_values > 0 ? "" : "NULL"}] } d_proc -public package_recreate_hierarchy { object_type } { Recreates all the packages for the hierarchy starting with the specified object type down to a leaf. Resets the package_object_view cache. Note: Only updates packages for dynamic objects (those with dynamic_p set to t) @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/28/2000 @param object_type The object type for which to recreate packages, including all children types. } { set object_type_list [db_list select_object_types {}] # Something changed... flush the data dictionary cache for the # type hierarchy starting with this object's type. Note that we # flush the cache in advance to reuse it when generating future packages # for object_types in the same level of the hierarchy. Note also that # maintaining this cache only gives us a few hits in the cache in # the degenerate case (one subtype), but the query we're caching # is dreadfully slow because of data dictionary tables. So # ensuring we only run the query once significantly improves # performance. -mbryzek foreach object_type $object_type_list { if { [util_memoize_cached_p [list package_table_columns_for_type $object_type]] } { util_memoize_flush [list package_table_columns_for_type $object_type] } } foreach type $object_type_list { package_create $type } } d_proc -private package_create { { -debug_p "f" } object_type } { Creates a packages with a new function and delete procedure for the specified object type. This function uses metadata exclusively to create the package. Resets the package_object_view cache Throws an error if the specified object type does not exist or is not dynamic @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/27/2000 @param object_type The object type for which to create a package @param debug_p If "t" then we return a text block containing the sql to create the package. Setting debug_p to t will not create the package. } { if {[catch { acs_object_type::get -object_type $object_type -array acs_type } errmsg]} { error "The specified object, $object_type does not exist." } if { ![string is true -strict $acs_type(dynamic_p)] } { error "The specified object, $object_type is not dynamic. Therefore, a package cannot be created for it" } # build up a list of the pl/sql to execute as it will make it # easier to return a string for debugging purposes. set package_name $acs_type(package_name) lappend plsql \ [list "package" "create_package" [package_generate_spec $object_type]] \ [list "package body" "create_package_body" [package_generate_body $object_type]] if { $debug_p == "t" } { foreach pair $plsql { # append text "[plsql_utility::parse_sql [lindex $pair 1]]\n\n" append text [lindex $pair 2] } return $text } foreach pair $plsql { lassign $pair type stmt_name code db_exec_plsql $stmt_name $code # Let's check to make sure the package is valid # # This seems to be a speciality in Oracle: The status of a # program unit (PL/SQL package, procedure, or function) is set # to INVALID if a database object on which it depends is # changed. That program unit must then be recompiled (which # Oracle Database will often do automatically the next time # you try to use that program unit). # if { ![db_string package_valid_p {}] } { error "$object_type \"$package_name\" is not valid after compiling:\n\n$code\n\n" } } # Now reset the object type view in case we've cached some attribute queries package_object_view_reset $object_type # Return the object type - what else to return? return $object_type } d_proc -private package_generate_spec { object_type } { Generates pl/sql to create a package specification. Does not execute the pl/sql - simply returns it. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 10/2000 @param object_type The object for which to create a package spec } { # First pull out some basic information about this object type acs_object_type::get -object_type $object_type -array acs_type set table_name $acs_type(table_name) set id_column $acs_type(id_column) set package_name [string tolower $acs_type(package_name)] set supertype $acs_type(supertype) return [db_map spec] } d_proc -private package_generate_body { object_type } { Generates plsql to create the package body @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 10/2000 @param object_type The name of the object type for which we are creating the package } { # Pull out information about this object type acs_object_type::get -object_type $object_type -array acs_type set table_name $acs_type(table_name) set id_column $acs_type(id_column) set package_name [string tolower $acs_type(package_name)] set supertype $acs_type(supertype) # Pull out information about the supertype acs_object_type::get -object_type $supertype -array acs_type set supertype_table_name $acs_type(table_name) set supertype_id_column $acs_type(id_column) set supertype_package_name [string tolower $acs_type(package_name)] set attribute_list [package_create_attribute_list \ -supertype $supertype \ -object_name "NEW" \ -table $table_name \ -column $id_column \ $object_type] # Prune down the list of attributes in supertype_attr_list to # those specific to the function call in the supertype's package set supertype_params [db_list select_supertype_function_params {}] set supertype_attr_list [package_create_attribute_list \ -supertype $supertype \ -object_name "NEW" \ -limit_to $supertype_params \ -table $supertype_table_name \ -column $supertype_id_column \ -column_value $id_column \ $supertype] return [db_map body] } d_proc -public package_object_view_reset { object_type } { Resets the cached views for all chains (e.g. all variations of start_with in package_object_view) for the specified object type. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/2000 } { # First flush the cache for all pairs of object_type, ancestor_type (start_with) db_foreach select_ancestor_types {} { if { [util_memoize_cached_p [list package_object_view_helper -start_with $ancestor_type $object_type]] } { util_memoize_flush [list package_object_view_helper -start_with $ancestor_type $object_type] } } # flush the cache for all pairs of sub_type, object_type(start_with) db_foreach select_sub_types {} { if { [util_memoize_cached_p [list package_object_view_helper -start_with $object_type $sub_type]] } { util_memoize_flush [list package_object_view_helper -start_with $object_type $sub_type] } } } d_proc -public package_object_view { { -refresh_p "f" } { -start_with "acs_object" } object_type } { Returns a select statement to be used as an inner view for selecting out all the attributes for the object_type. util_memoizes the result @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 10/2000 @param refresh_p If t, force a reload of the cache @param start_with The highest parent object type for which to include attributes @param object_type The object for which to create a package spec } { if {$refresh_p == "t"} { package_object_view_reset $object_type } return [util_memoize [list package_object_view_helper -start_with $start_with $object_type]] } d_proc -private package_object_view_helper { { -start_with "acs_object" } object_type } { Returns a select statement to be used as an inner view for selecting out all the attributes for the object_type. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 10/2000 @param start_with The highest parent object type for which to include attributes @param object_type The object for which to create a package spec } { # Let's add the primary key for our lowest object type. We do this # separately in case there are no other attributes for this object type # Note that we also alias this primary key to object_id so # that the calling code can generically use it. acs_object_type::get -object_type $object_type -array acs_type set table_name $acs_type(table_name) set id_column $acs_type(id_column) set columns [list "${table_name}.${id_column}"] if { [string tolower $id_column] ne "object_id" } { # Add in an alias for object_id lappend columns "${table_name}.${id_column} as object_id" } set tables [list "${table_name}"] set primary_keys [list "${table_name}.${id_column}"] foreach row [package_object_attribute_list -start_with $start_with $object_type] { set table [lindex $row 1] set column [lindex $row 2] set object_column [lindex $row 8] if {[string tolower $column] eq "object_id"} { # We already have object_id... skip this column continue } # Do the column check first to include only the tables we need if {"$table.$column" in $columns} { # We already have a column with the same name. Keep the # first one as it's lower in the type hierarchy. continue } # first time we're seeing this column lappend columns "${table}.${column}" if {$table ni $tables} { # First time we're seeing this table lappend tables $table lappend primary_keys "${table}.${object_column}" } } set pk_formatted [list] for { set i 0 } { $i < [llength $primary_keys] - 1 } { incr i } { lappend pk_formatted "[lindex $primary_keys $i] = [lindex $primary_keys $i+1]" } set where_clause "" if {[llength $pk_formatted] > 0} { set where_clause [join [string tolower $pk_formatted] "\n AND "] set where_clause " WHERE $where_clause" } return "SELECT [string tolower [join $columns ",\n "]] FROM [string tolower [join $tables ", "]] $where_clause" } ad_proc -private package_insert_default_comment { } { Returns a string to be used verbatim as the default comment we insert into meta-generated packages and package bodies. If we have a connection, we grab the user's name from ad_conn user_id. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/29/2000 } { set author [expr {[ns_conn isconnected] ? [acs_user::get_element -element name] : "Unknown"}] set creation_date [db_string current_timestamp { select current_timestamp from dual}] return " --/** THIS IS AN AUTO GENERATED PACKAGE. $author was the -- user who created it -- -- @creation-date $creation_date --*/ " } d_proc package_object_attribute_list { { -start_with "acs_object" } { -include_storage_types {type_specific} } object_type } { Returns a list of lists all the attributes (column name or attribute_name) to be used for this object type. Each list elements contains: <code>(attribute_id, table_name, attribute_name, pretty_name, datatype, required_p, default_value)</code> @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/29/2000 @param start_with The highest parent object type for which to include attributes @param object_type The object type for which to include attributes } { set storage_clause "" if {$include_storage_types ne ""} { set storage_clause " and a.storage in ([ns_dbquotelist $include_storage_types])" } return [db_list_of_lists attributes_select {}] } d_proc -private package_plsql_args { { -object_name "NEW" } package_name } { Return a list of parameters expected to a plsql function defined within a given package and cache these per thread. Changes in the interface will require a server restart. @author Ben Adida (ben@openforce.net) @creation-date 11/2001 @param package_name The package which owns the function @param object_name The function name which we're looking up @return list of parameters } { return [acs::per_thread_cache eval -key acs-subsite.package_plsql_args($object_name-$package_name) { db_list select_package_func_param_list {} }] } d_proc -private package_function_p { -object_name:required package_name } { @return true if the package's object is a function. } { return [acs::per_thread_cache eval -key acs-subsite.package_function_p($object_name-$package_name) { db_0or1row function_p "" }] } d_proc -private package_table_columns_for_type { object_type } { Generates the list of tables and columns that are parameters of the object named <code>NEW</code> for PL/SQL package associated with this object type. <p> Note we limit the argument list to only object_type to make it possible to use <code>util_memoize_flush<code> to clear any cached values for this procedure. @author Michael Bryzek (mbryzek@arsdigita.com) @creation-date 12/2000 @param object_type The object type for which we are generating the list @return a list of lists where each list element is a pair of table name, column name } { set object_name "NEW" acs_object_type::get -object_type $object_type -array acs_type set package_name $acs_type(package_name) # We need to hit the data dictionary to find the table and column names # for all the arguments to the object_types function/procedure # named "object_name." Note that we join against # acs_object_types to select out the tables and columns for the # object_type up the type tree starting from this object_type. # # NOTE: This query is tuned already, yet still slow (~1 # second on my box right now). Be careful modifying # it... It's slow because of the underlying data dictionary query # against user_arguments return [db_list_of_lists select_object_type_param_list {}] } d_proc -public package_instantiate_object { { -creation_user "" } { -creation_ip "" } { -package_name "" } { -var_list "" } { -extra_vars "" } { -start_with "" } { -form_id "" } { -variable_prefix "" } object_type } { Creates a new object of the specified type by calling the associated PL/SQL package new function. @author Michael Bryzek (mbryzek@arsdigita.com) @author Ben Adida (ben@openforce.net) @creation-date 02/01/2001 @param creation_user The current user. Defaults to <code>[ad_conn user_id]</code> if not specified and there is a connection @param creation_ip The current user's IP address. Defaults to <code>[ad_conn peeraddr]</code> if not specified and there is a connection @param package_name The PL/SQL package associated with this object type. Defaults to <code>acs_object_types.package_name</code> @param var_list 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 @param extra_vars an ns_set of extra vars @param start_with The object type to start with when gathering attributes for this object type. Defaults to the object type. @param form_id The form id from templating form system if we're using the forms API to specify attributes @param object_type The object type of the object we are instantiating @return The object id of the newly created object <p><b>Example:</b> <pre> 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"] </pre> } { 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 } d_proc -public package_exec_plsql { { -var_list "" } package_name object_name } { Calls a pl/[pg]sql proc/func defined within the object type's package. Use of this Tcl API proc avoids the need for the developer to write separate SQL for each RDBMS we support. @author Don Baccus (dhogaza@pacifier.com) @creation-date 12/31/2003 @param package_name The PL/[pg]SQL package @param object_name The PL/[pg]SQL function within the package @param var_list 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 @return empty string for procs, function return value for funcs <p><b>Example:</b> <pre> set var_list [list \ [list group_id $group_id]] package_exec_plsql -var_list $var_list group delete </pre> } { # Ugly hack for the case where a proc has params named "package_name" or "object_name". set __package_name $package_name set __object_name $object_name foreach arg [package_plsql_args -object_name $__object_name $__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. ns_log Warning "package_exec_plsql: skipping $__key not found in params for $__package_name $__object_name" continue } lappend pieces [list $__key] set param_array([string toupper $__key]) 1 # Set the value for binding set $__key $__value } if { [package_function_p -object_name $__object_name $__package_name] } { return [db_exec_plsql exec_func_plsql {}] } else { db_exec_plsql exec_proc_plsql {} } } # # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: