table_name for this object_type
- (from the acs_object_types tables)
+ (from the acs_object_types tables)
@param column The id_column for this object_type
- (from the acs_object_types tables)
+ (from the acs_object_types 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.
+ 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
+ attributes
} {
if { $table eq "" || $column eq "" } {
- # pull out the table and column names based on the object type
- db_1row select_type_info {
- select t.table_name as table, t.id_column as column
- from acs_object_types t
- where t.object_type = :object_type
- }
+ # pull out the table and column names based on the object type
+ db_1row select_type_info {
+ select t.table_name as table, t.id_column as column
+ from acs_object_types t
+ where t.object_type = :object_type
+ }
}
# 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
+
+ # 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
+ # 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 {
- select upper(nvl(attr.table_name,t.table_name)) as attr_table_name,
- upper(nvl(attr.column_name, attr.attribute_name)) as attr_column_name,
- attr.ancestor_type, attr.min_n_values, attr.default_value
- from acs_object_type_attributes attr,
- (select t.object_type, t.table_name, level as type_level
- from acs_object_types t
- start with t.object_type = :object_type
- connect by prior t.supertype = t.object_type) t
- where attr.ancestor_type = t.object_type
- and attr.object_type = :object_type
- order by t.type_level
- } {
- # 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
+
+ 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
+ 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
+ # 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]
- }
+ 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
}
@@ -182,44 +170,44 @@
@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
- acs_object.object_type
- stored (either table_name from the attribute or for the object_type)
+ using. Used only to set a default for
+ acs_object.object_type
+ 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)
+ 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)
+ 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)
+ (e.g. required = min_n_values != 0)
@param attr_default The default values for this attribute as
- specified in the attributes table.
+ 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 "'[DoubleApos $attr_default]'"
- }
+ return "'[DoubleApos $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 "'[DoubleApos $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" }
- }
+ switch -- $column {
+ "OBJECT_TYPE" { return "'[DoubleApos $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 "'[DoubleApos $object_type]'" }
- }
+ switch -- $column {
+ "REL_TYPE" { return "'[DoubleApos $object_type]'" }
+ }
}
# return to null unless this attribute is required
@@ -229,28 +217,22 @@
ad_proc -public package_recreate_hierarchy {
- object_type
+ 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.
+ including all children types.
} {
- set object_type_list [db_list select_object_types {
- select t.object_type
- from acs_object_types t
- where t.dynamic_p = 't'
- start with t.object_type = :object_type
- connect by prior t.object_type = t.supertype
- }]
-
+ 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
@@ -262,21 +244,21 @@
# 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]
- }
+ 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
+ package_create $type
}
-
+
}
-ad_proc -private package_create {
+ad_proc -private package_create {
{ -debug_p "f" }
- object_type
+ object_type
} {
Creates a packages with a new function and delete procedure for
the specified object type. This function uses metadata exclusively
@@ -290,52 +272,53 @@
@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.
+ sql to create the package. Setting debug_p to t will not create the
+ package.
} {
-
+
if { ![package_type_dynamic_p $object_type] } {
- error "The specified object, $object_type, either does not exist or is not dynamic. Therefore, a package cannot be created for it"
- }
+ error "The specified object, $object_type, either does not exist or 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 [db_string select_package_name {
- select t.package_name
- from acs_object_types t
- where t.object_type = :object_type
+ select t.package_name
+ from acs_object_types t
+ where t.object_type = :object_type
}]
- lappend plsql [list "package" "create_package" [package_generate_spec $object_type]]
- lappend plsql [list "package body" "create_package_body" [package_generate_body $object_type]]
+ 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 {
+ # 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
+ lassign $pair type stmt_name code
- db_exec_plsql $stmt_name $code
-
- # Let's check to make sure the package is valid
- if { ![db_string package_valid_p {
- select case when exists (select 1
- from user_objects
- where status = 'INVALID'
- and object_name = upper(:package_name)
- and object_type = upper(:type))
- then 0 else 1 end
- from dual
- }] } {
- error "$object_type \"$package_name\" is not valid after compiling:\n\n$code\n\n"
- }
+ 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
@@ -359,16 +342,16 @@
} {
# First pull out some basic information about this object type
db_1row select_type_info {
- select t.table_name, t.id_column, lower(t.package_name) as package_name, t.supertype
- from acs_object_types t
- where t.object_type = :object_type
+ select t.table_name, t.id_column, lower(t.package_name) as package_name, t.supertype
+ from acs_object_types t
+ where t.object_type = :object_type
}
return [db_map spec]
}
-
-ad_proc -private package_generate_body {
+
+ad_proc -private package_generate_body {
object_type
} {
Generates plsql to create the package body
@@ -381,79 +364,64 @@
} {
# Pull out information about this object type
db_1row select_type_info {
- select t.table_name, t.id_column, lower(t.package_name) as package_name, t.supertype
- from acs_object_types t
- where t.object_type = :object_type
+ select t.table_name, t.id_column, lower(t.package_name) as package_name, t.supertype
+ from acs_object_types t
+ where t.object_type = :object_type
}
# Pull out information about the supertype
db_1row select_type_info {
- select t.table_name as supertype_table_name, t.id_column as supertype_id_column,
- lower(t.package_name) as supertype_package_name
- from acs_object_types t
- where t.object_type = :supertype
+ select t.table_name as supertype_table_name, t.id_column as supertype_id_column,
+ lower(t.package_name) as supertype_package_name
+ from acs_object_types t
+ where t.object_type = :supertype
}
set attribute_list [package_create_attribute_list \
- -supertype $supertype \
- -object_name "NEW" \
- -table $table_name \
- -column $id_column \
- $object_type]
-
+ -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 {
- select args.argument_name
- from user_arguments args
- where args.package_name =upper(:supertype_package_name)
- and args.object_name='NEW'
- }]
+ 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]
+ -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]
}
ad_proc -public package_object_view_reset {
- object_type
+ 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.
+ 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 {
- select t.object_type as ancestor_type
- from acs_object_types t
- start with t.object_type = :object_type
- connect by prior t.supertype = t.object_type
- } {
- 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]
- }
+ 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 {
- select t.object_type as sub_type
- from acs_object_types t
- start with t.object_type = :object_type
- connect by prior t.object_type = t.supertype
- } {
- 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]
- }
+ 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]
+ }
}
}
@@ -474,7 +442,7 @@
@param object_type The object for which to create a package spec
} {
if {$refresh_p == "t"} {
- package_object_view_reset $object_type
+ package_object_view_reset $object_type
}
return [util_memoize [list package_object_view_helper -start_with $start_with $object_type]]
}
@@ -486,64 +454,64 @@
object_type
} {
Returns a select statement to be used as an inner view for
- selecting out all the attributes for the object_type.
+ 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.
db_1row select_type_info {
- select t.table_name, t.id_column
- from acs_object_types t
- where t.object_type = :object_type
+ select t.table_name, t.id_column
+ from acs_object_types t
+ where t.object_type = :object_type
}
-
+
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"
+ # 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]
+ 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
- }
+ 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}"
+ # 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}"
- }
+ 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]"
+ lappend pk_formatted "[lindex $primary_keys $i] = [lindex $primary_keys $i+1]"
}
return "SELECT [string tolower [join $columns ",\n "]]
FROM [string tolower [join $tables ", "]]
@@ -563,35 +531,31 @@
} {
if { [ad_conn isconnected] } {
- set user_id [ad_conn user_id]
- db_1row select_comments {
- select acs_object.name(:user_id) as author,
- sysdate as creation_date
- from dual
- }
+ set user_id [ad_conn user_id]
+ db_1row select_comments {}
} else {
- db_1row select_comments {
- select 'Unknown' as author,
- sysdate as creation_date
- from dual
- }
+ db_1row select_author_unknwon {
+ select 'Unknown' as author,
+ sysdate as creation_date
+ from dual
+ }
}
return "
- --/** THIS IS AN AUTO GENERATED PACKAGE. $author was the
+ --/** THIS IS AN AUTO GENERATED PACKAGE. $author was the
-- user who created it
--
-- @creation-date $creation_date
--*/
"
}
-ad_proc package_object_attribute_list {
+ad_proc package_object_attribute_list {
{ -start_with "acs_object" }
{ -include_storage_types {type_specific} }
- object_type
+ object_type
} {
Returns a list of lists all the attributes (column name or
- attribute_name) to be used for this object type. Each list
+ 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)
@@ -605,28 +569,11 @@
set storage_clause ""
if {$include_storage_types ne ""} {
- set storage_clause "
+ set storage_clause "
and a.storage in ('[join $include_storage_types "', '"]')"
}
- return [db_list_of_lists attributes_select "
- select a.attribute_id,
- nvl(a.table_name, t.table_name) as table_name,
- nvl(a.column_name, a.attribute_name) as attribute_name,
- a.pretty_name,
- a.datatype,
- decode(a.min_n_values,0,'f','t') as required_p,
- a.default_value,
- t.table_name as object_type_table_name,
- t.id_column as object_type_id_column
- from acs_object_type_attributes a,
- (select t.object_type, t.table_name, t.id_column, level as type_level
- from acs_object_types t
- start with t.object_type=:start_with
- connect by prior t.object_type = t.supertype) t
- where a.object_type = :object_type
- and t.object_type = a.object_type $storage_clause
- order by type_level"]
+ return [db_list_of_lists attributes_select {}]
}
@@ -668,14 +615,14 @@
with this object type.
-
+
Note we limit the argument list to only object_type to make it
possible to use util_memoize_flush if not specified and there is a connection
@param package_name The PL/SQL package associated with this object
type. Defaults to 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
@@ -687,9 +634,9 @@
set object_name "NEW"
db_1row select_type_info {
- select t.package_name
- from acs_object_types t
- where t.object_type = :object_type
+ select t.package_name
+ from acs_object_types t
+ where t.object_type = :object_type
}
# We need to hit the data dictionary to find the table and column names
@@ -702,23 +649,9 @@
# 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 {
- select cols.table_name, cols.column_name
- from user_tab_columns cols,
- (select upper(t.table_name) as table_name
- from acs_object_types t
- start with t.object_type = :object_type
- connect by prior t.supertype = t.object_type) t
- where cols.column_name in
- (select args.argument_name
- from user_arguments args
- where args.position > 0
- and args.object_name = upper(:object_name)
- and args.package_name = upper(:package_name))
- and cols.table_name = t.table_name
- }]
+ return [db_list_of_lists select_object_type_param_list {}]
+
}
ad_proc -public package_instantiate_object {
@@ -730,7 +663,7 @@
{ -start_with "" }
{ -form_id "" }
{ -variable_prefix "" }
- object_type
+ object_type
} {
Creates a new object of the specified type by calling the
@@ -739,12 +672,12 @@
@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 if not specified and there is a connection
@param creation_ip The current user's ip address. Defaults to [ad_conn
- user_id] if not specified and there is a connection
+ user_id][ad_conn
- peeraddr] if not specified and there is a connection
+ peeraddr]acs_object_types.package_name
@@ -773,42 +706,42 @@
template::element create add_group group_name -value "Publisher"
set var_list [list \
- [list context_id $context_id] \
- [list group_id $group_id]]
+ [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"]
+ -start_with "group" \
+ -var_list $var_list \
+ -form_id "add_group" \
+ "group"]
-
-
+
+
} {
-
+
if {$variable_prefix ne ""} {
- append variable_prefix "."
+ append variable_prefix "."
}
# Select out the package name if it wasn't passed in
if { $package_name eq "" } {
- if { ![db_0or1row package_select {
- select t.package_name
- from acs_object_types t
- where t.object_type = :object_type
- }] } {
- error "Object type \"$object_type\" does not exist"
- }
+ if { ![db_0or1row package_select {
+ select t.package_name
+ from acs_object_types t
+ where t.object_type = :object_type
+ }] } {
+ error "Object type \"$object_type\" does not exist"
+ }
}
if { [ad_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 eq "" } {
+ set creation_user [ad_conn user_id]
+ }
+ if { $creation_ip eq "" } {
+ set creation_ip [ad_conn peeraddr]
+ }
}
if {$creation_user == 0} {
@@ -825,79 +758,83 @@
# not defined
foreach arg [util_memoize [list package_plsql_args $package_name]] {
- set real_params([string toupper $arg]) 1
+ 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 upper case)
-
+
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
+ 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 "" } {
- for {set i 0} {$i < [ns_set size $extra_vars]} {incr i} {
- set __key [ns_set key $extra_vars $i]
- set __value [ns_set value $extra_vars $i]
+ for {set i 0} {$i < [ns_set size $extra_vars]} {incr i} {
+ set __key [ns_set key $extra_vars $i]
+ set __value [ns_set value $extra_vars $i]
- 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 { ![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 ""} {
#DRB: This needs to be cached!
set __id_column [db_string get_id_column {}]
- if { [info exists real_params([string toupper $__id_column])] && ![info exists param_array([string toupper $__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]
- }
+ 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"]
+ # 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]
- }
- }
- }
+ lappend pieces [list $__attribute]
+ }
+ }
+ }
set object_id [db_exec_plsql create_object {}]
if { [ad_conn isconnected] } {
- subsite_callback -object_type $object_type "insert" $object_id
+ subsite_callback -object_type $object_type "insert" $object_id
}
# BUG FIX (ben - OpenACS)
@@ -907,8 +844,8 @@
ad_proc -public package_exec_plsql {
{ -var_list "" }
- package_name
- object_name
+ package_name
+ object_name
} {
Calls a pl/[pg]sql proc/func defined within the object type's package. Use of
@@ -918,8 +855,8 @@
@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 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
@@ -931,7 +868,7 @@
set var_list [list \
- [list group_id $group_id]]
+ [list group_id $group_id]]
package_exec_plsql -var_list $var_list group delete
@@ -943,7 +880,7 @@
set __object_name $object_name
foreach arg [util_memoize [list package_plsql_args -object_name $__object_name $__package_name]] {
- set real_params([string toupper $arg]) 1
+ set real_params([string toupper $arg]) 1
}
# Use pieces to generate the parameter list to the new
@@ -955,17 +892,17 @@
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.
+ 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
+ continue;
+ }
+ lappend pieces [list $__key]
+ set param_array([string toupper $__key]) 1
+ # Set the value for binding
+ set $__key $__value
}
if { [util_memoize [list package_function_p -object_name $__object_name $__package_name]] } {
@@ -976,3 +913,9 @@
}
+#
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End: