package-procs.tcl

Does not contain a contract.

Location:
/packages/acs-subsite/tcl/package-procs.tcl
File Contents

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:
package-procs.tcl

Related Files

File Contents
