Index: openacs-4/packages/acs-tcl/acs-tcl.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/acs-tcl.info,v
diff -u -r1.95.2.74 -r1.95.2.75
--- openacs-4/packages/acs-tcl/acs-tcl.info 13 Aug 2024 14:33:16 -0000 1.95.2.74
+++ openacs-4/packages/acs-tcl/acs-tcl.info 20 Aug 2024 13:58:28 -0000 1.95.2.75
@@ -9,7 +9,7 @@
f
t
-
+
OpenACS
The Kernel Tcl API library.
2023-05-15
@@ -18,9 +18,9 @@
GPL version 2
3
-
+
-
+
Index: openacs-4/packages/acs-tcl/tcl/acs-db-12-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/acs-db-12-procs.tcl,v
diff -u -r1.1.2.6 -r1.1.2.7
--- openacs-4/packages/acs-tcl/tcl/acs-db-12-procs.tcl 13 Aug 2024 09:06:04 -0000 1.1.2.6
+++ openacs-4/packages/acs-tcl/tcl/acs-db-12-procs.tcl 20 Aug 2024 13:58:28 -0000 1.1.2.7
@@ -46,10 +46,23 @@
#
# Mapping of SQL "package" name and "object" name to the names as
- # stored in the database.
+ # stored in the database. We have several SQL functions defined
+ # via function_args, that do not belong to a 'package', having an
+ # empty 'package_name'.
#
+ # Examples:
+ # acs_message_get_tree_sortkey
+ # acs_object_type_get_tree_sortkey
+ # cmp_pg_version
+ # column_exists
+ # ...
+ #
::acs::db::postgresql method sql_function_name {package_name object_name} {
- return ${package_name}__${object_name}
+ if {${package_name} ne ""} {
+ return ${package_name}__${object_name}
+ } else {
+ return ${object_name}
+ }
}
::acs::db::oracle method sql_function_name {package_name object_name} {
return ${package_name}.${object_name}
@@ -98,6 +111,7 @@
set db_definitions ""
foreach item [:get_all_package_functions -dbn $dbn] {
lassign $item package_name object_name sql_info
+ #ns_log notice "get_all_package_functions returns ($package_name $object_name)"
if {[string match "*TRG" [string toupper $object_name]]} {
# no need to provide interface to trigger functions
@@ -222,9 +236,36 @@
}
lappend result $arg
}
+ #ns_log notice "build_function_argument_list: $result"
return $result
}
+ ::acs::db::postgresql method argument_name_match {
+ -key
+ -function_arg_names
+ -db_names
+ } {
+ #
+ # Does the name from function_args match the names obtained
+ # from PostgreSQL?
+ #
+ set success 1
+ foreach function_arg_name $function_arg_names db_name $db_names {
+ if {$db_name ne ""
+ && $function_arg_name ne $db_name
+ && ![string match *_$function_arg_name $db_name]
+ } {
+ set success 0
+ #ns_log notice ===== argument match $key function_arg_name '$function_arg_name' does not match name from db '$db_name' \n \
+ function_arg_names <$function_arg_names> db_names <$db_names>
+ break
+ }
+ }
+
+ #ns_log notice ===== argument match $key function_arg_names '$function_arg_names' db '$db_names' => $success
+ return $success
+ }
+
::acs::db::postgresql public method get_all_package_functions {{-dbn ""}} {
#
# PostgreSQL version of obtaining information about the
@@ -279,19 +320,22 @@
select distinct
af.function,
substring(af.function from 0 for position('__' in af.function)) as package_name,
- substring(af.function from position('__' in af.function)+2) as object_name,
+ case when position('__' in af.function)>0 then substring(af.function from position('__' in af.function)+2) else af.function end as object_name,
+ array_to_string(proargnames, ' '),
oidvectortypes(proargtypes),
format_type(prorettype, NULL)
from pg_proc, acs_function_args af
where proname = lower(af.function)
}]
foreach item $pg_data {
- lassign $item key package_name object_name argument_types result_type
+ lassign $item key package_name object_name proargnames argument_types result_type
+ #ns_log notice "got from db" key $key package_name $package_name object_name $object_name
set argument_types [lmap argument_type [split $argument_types ,] {
string trim $argument_type
}]
- set nr_defined_args [llength [dict get $db_definitions $key argument_names]]
+ set function_arg_names [string tolower [dict get $db_definitions $key argument_names]]
+ set nr_defined_args [llength $function_arg_names]
if {[llength $argument_types] < $nr_defined_args} {
#
# This might be a definition with fewer arguments; we
@@ -303,9 +347,47 @@
} elseif {[llength $argument_types] < $nr_defined_args} {
ns_log warning "generate_stubs: $key has less arguments in " \
"function_definitions ($nr_defined_args) than in DB [llength $argument_types]"
+ ns_log notice ".... have already types [dict exists $db_definitions $key types]"
continue
}
- # ns_log notice "adding $key /$nr_defined_args, package_name: '$package_name'"
+
+ if {$proargnames eq ""} {
+ ns_log warning "$key /$nr_defined_args has no argument names in DB. " \
+ "Names should match <$function_arg_names>"
+ } elseif {[llength $proargnames] > $nr_defined_args} {
+ #
+ # In case a function returns tuples from the DB, the
+ # name of the attributes of these tuples are also
+ # returned in proargnames from PostgreSQL. Just take
+ # the names, for which we have types.
+ #
+ set proargnames [lrange $proargnames 0 $nr_defined_args-1]
+ #ns_log notice $key FIXED proargnames <$proargnames>
+ }
+
+ # if {$key eq "CONTENT_ITEM__TRASH_RECOVER_SINGLE_ITEM"} {
+ # ns_log notice "$key /$nr_defined_args, package_name: '$package_name'" \
+ # function_arg_names <$function_arg_names> \n \
+ # db_names <$proargnames> \n \
+ # db_types <$argument_types>
+ # }
+
+ if {![:argument_name_match \
+ -key $key \
+ -function_arg_names $function_arg_names \
+ -db_names $proargnames]} {
+ continue
+ }
+
+ if {[dict exists $db_definitions $key types]} {
+ ns_log warning "$key /$nr_defined_args, package_name: '$package_name' ignoring duplicate function" \
+ function_arg_names <$function_arg_names> \n \
+ db_names <$proargnames> \n \
+ db_types <$argument_types> \
+ have already <[dict get $db_definitions $key types]>
+
+ continue
+ }
dict set db_definitions $key result_type $result_type
dict set db_definitions $key types $argument_types
dict set db_definitions $key package_name $package_name
@@ -422,6 +504,14 @@
{*}$cmd
}
+ ::acs::db::SQL method dbfunction_argument_value {-name -type} {
+ if {[dict exists [:typemap] $type]} {
+ string cat CAST(: [string tolower $name] " AS " $type )
+ } else {
+ string cat : [string tolower $name]
+ }
+ }
+
#
# In some cases, we need locks on SQL select statements, when the
# select updates tuples, e.g., via a function. This is required at
@@ -540,9 +630,11 @@
#
# Build interface based on bind vars for PostgreSQL
#
- set bind_var_names [lmap argument_name [dict get $sql_info argument_names] {
- string cat : [string tolower $argument_name]
- }]
+ set bind_var_names [lmap \
+ argument_name [dict get $sql_info argument_names] \
+ type [dict get $sql_info types] {
+ :dbfunction_argument_value -name $argument_name -type $type
+ }]
return [list tcl "" sql_arguments [join $bind_var_names ,]]
}
@@ -554,17 +646,21 @@
set arguments ""
foreach \
argument_name [dict get $sql_info argument_names] \
- defaulted [dict get $sql_info defaulted] {
+ defaulted [dict get $sql_info defaulted] \
+ type [dict get $sql_info types] \
+ {
set argument_name [string tolower $argument_name]
+ set argument_value [:dbfunction_argument_value -name $argument_name -type $type]
+
if {$defaulted eq "Y"} {
lappend optional_parameters $argument_name
} else {
- lappend arguments "$argument_name => :$argument_name"
+ lappend arguments "$argument_name => :$argument_value"
}
}
#
# We have to check at runtime if the arguments where provided
- #
+ # Missing: casts for optional parameters
if {[llength $optional_parameters] > 0} {
set tcl_code [ns_trim -delimiter | [string map [list @optional_parameters@ $optional_parameters] {
|set __optional_parameters ""
@@ -593,7 +689,8 @@
}
set arg_info [:sql_function_argument_list $sql_info]
- return [:build_psql_body \
+ set type_comment [subst {\# TYPES: [dict get $sql_info types]\n}]
+ return $type_comment[:build_psql_body \
[dict get $arg_info tcl] \
"${sql_function_name}([dict get $arg_info sql_arguments])" \
[dict get $sql_info result_type]]
Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -r1.189.2.196 -r1.189.2.197
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 17 Aug 2024 17:07:30 -0000 1.189.2.196
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 20 Aug 2024 13:58:28 -0000 1.189.2.197
@@ -4122,7 +4122,7 @@
-namespace:required
} {
- Conveniance function to register URNs based on the information provided by the resource_info dict.
+ Convenience function to register URNs based on the information provided by the resource_info dict.
The dict members "urnMap", "prefix", and optionally "csp_lists" are used.
@param resource_info a dict containing urnMap, prefix, and optionally csp_lists.