- 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.
[ hide source ]
| [ make this
the default ]
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: