This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a commit to branch 3.2
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
The following commit(s) were added to refs/heads/3.2 by this push:
new 9a3bee1 add consistent handling of TDBC named arguments substitution
on a table when there are no columns of it needing special formatting (via
special_fields_formatter object), reimplementation of update,insert and delete
for the ::DIO::Tdbc driver
9a3bee1 is described below
commit 9a3bee12ec7c7ad656f8b33e0e3427bd1378a872
Author: Massimo Manghi <[email protected]>
AuthorDate: Thu Oct 16 02:26:09 2025 +0200
add consistent handling of TDBC named arguments substitution on a table
when there are no columns of it needing special formatting (via
special_fields_formatter object), reimplementation of update,insert and delete
for the ::DIO::Tdbc driver
---
ChangeLog | 8 ++
rivet/packages/dio/dio.tcl | 41 +++++----
rivet/packages/dio/dio_Tdbc.tcl | 184 +++++++++++++++++++++++++++++++++-----
rivet/packages/dio/formatters.tcl | 11 +++
4 files changed, 206 insertions(+), 38 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 5357961..88468b6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2025-10-15 Massimo Manghi <[email protected]>
+ * rivet/packages/dio/dio_Tdbc.tcl: reimplementing methods
+ update, delete and insert to enable DIO Tdbc driver to handle also
+ SQL queries using the TDBC named argument substitution
+ * rivet/packages/dio/dio.tcl: better handling of the special field
+ formatter. The special fields formatter usage disables on specific
+ tables the SQL queries with named arguments substitution
+
2025-10-07 Massimo Manghi <[email protected]>
* rivet/packages/dio/dio_Tdbc.tcl: removing method insert from
class ::DIO::Tdbc, the real responsible of honoring SQL statements
diff --git a/rivet/packages/dio/dio.tcl b/rivet/packages/dio/dio.tcl
index 8ab32e0..2a874e4 100644
--- a/rivet/packages/dio/dio.tcl
+++ b/rivet/packages/dio/dio.tcl
@@ -19,7 +19,8 @@ package require Itcl
package require dio::formatters
# Command ::rivet::lempty is extensively used within this class but it's
-# defined only when we run DIO from mod_rivet. We load it here for convenience
+# defined only when we run DIO from mod_rivet. For convenience we load it
+# here if needed
if {[info commands ::rivet::lempty] == ""} {
@@ -47,7 +48,6 @@ proc handle {interface args} {
}
#puts "interface: $interface ($tdbc_driver)"
-
set first [lindex $args 0]
if {![::rivet::lempty $first] && [string index $first 0] != "-"} {
set obj [lindex $args 0]
@@ -56,15 +56,22 @@ proc handle {interface args} {
uplevel \#0 package require dio_$interface
#puts "tdbc: '$tdbc_driver' obj: '$obj' args 3: '$args'"
-
if {$tdbc_driver == ""} {
# old connectors based on traditional dbms drivers
- return [uplevel \#0 ::DIO::$interface $obj $args]
+ set dio_o [uplevel \#0 ::DIO::$interface $obj $args]
} else {
- return [uplevel \#0 ::DIO::$interface $obj $tdbc_driver {*}$args]
+ set dio_o [uplevel \#0 ::DIO::$interface $obj $tdbc_driver {*}$args]
}
+
+ # the Tdbc driver may rename the drive because we created
+ # a set of equivalence classes among DBMS (eg mariadb,sqlite etc)
+ # therefore the class for the interface passed by the constructor
+ # may not exist and it's ::DIO::Tdbc responsability to create it
+
+ $dio_o create_field_formatter
+ return $dio_o
}
##
@@ -73,7 +80,6 @@ proc handle {interface args} {
::itcl::class Database {
constructor {args} {
eval configure $args
- set special_fields_formatter [::DIO::formatters::${interface}
::DIO::formatters::#auto]
}
destructor {
@@ -120,17 +126,17 @@ proc handle {interface args} {
set elem [lindex $args $i]
switch -- [::string tolower $elem] {
- "-and" {
+ "-and" {
# -and -- switch to AND-style processing
set bool AND
}
- "-or" {
+ "-or" {
# -or -- switch to OR-style processing
set bool OR
}
- "-table" {
+ "-table" {
# -table -- identify which table the query is about
set myTable [lindex $args [incr i]]
}
@@ -415,7 +421,7 @@ proc handle {interface args} {
return -code error -errorcode missing_keyfield "-keyfield not
specified in DIO object"
}
- set $keyVar $data(-keyfield)
+ set $keyVar $data(-keyfield)
}
#
@@ -497,11 +503,11 @@ proc handle {interface args} {
#
method update {arrayName args} {
table_check $args
- upvar 1 $arrayName $arrayName $arrayName array
+ upvar 1 $arrayName $arrayName $arrayName row_a
set key [makekey $arrayName $myKeyfield]
- set fields [::array names array]
+ set fields [::array names row_a]
set req [build_update_query array $fields $myTable]
append req [build_key_where_clause $myKeyfield $key]
@@ -634,8 +640,12 @@ proc handle {interface args} {
return [string "select count(*) from $myTable"]
}
+ public method create_field_formatter {} {
+ set special_fields_formatter [::DIO::formatters::[::string totitle
$interface] ::DIO::formatters::#auto]
+ }
+
protected method set_field_formatter {formatter_class} {
- $special_fields_formatter destroy
+ if {$special_fields_formatter != ""} { $special_fields_formatter
destroy }
set special_fields_formatter [$formatter_class
::DIO::formatters::#auto]
}
@@ -683,8 +693,7 @@ proc handle {interface args} {
method host {{string ""}} { return [configure_variable host $string] }
method port {{string ""}} { return [configure_variable port $string] }
- public variable special_fields_formatter \
- [::DIO::formatters::RootFormatter ::DIO::formatters::#auto]
+ public variable special_fields_formatter ""
public variable interface ""
public variable errorinfo ""
@@ -924,4 +933,4 @@ proc handle {interface args} {
} ; ## namespace eval DIO
-package provide DIO 1.2.1
+package provide DIO 1.2.3
diff --git a/rivet/packages/dio/dio_Tdbc.tcl b/rivet/packages/dio/dio_Tdbc.tcl
index 5c3469a..48c9eb9 100644
--- a/rivet/packages/dio/dio_Tdbc.tcl
+++ b/rivet/packages/dio/dio_Tdbc.tcl
@@ -20,8 +20,9 @@
# under the License.
package require tdbc
-package require DIO 1.2
-package provide dio_Tdbc 1.2.2
+package require DIO 1.2.3
+package provide dio_Tdbc 1.2.3
+package require struct::set
namespace eval DIO {
::itcl::class Tdbc {
@@ -69,7 +70,9 @@ namespace eval DIO {
}
}
- set tdbc_connector "tdbc::${connector_name}"
+ set interface $connector_name
+ $this set_field_formatter ::DIO::formatters::[::string totitle
$interface]
+ set tdbc_connector "tdbc::${interface}"
uplevel #0 package require ${tdbc_connector}
}
@@ -118,39 +121,176 @@ namespace eval DIO {
}
}
+ # delete -
#
- # build_insert_query --
#
- # Override ::DIO::build_insert_query method taking advantage of
- # the named parameters feature of TDBC SQL statements objects
+
+ method delete {key args} {
+ table_check $args
+
+ set sql "DELETE FROM $myTable"
+ set sql_values [dict create]
+ if {[$special_fields_formatter has_special_fields $table]} {
+ append sql [build_key_where_clause $myKeyfield $key]
+ } else {
+ set where_key_value_pairs [lmap field $myKeyfield {
+ set v "${field}=:${field}"
+ }]
+ set sql "$sql WHERE [join $where_key_value_pairs { AND }]"
+ foreach field $myKeyfield k $key { dict set sql_values $field
$k }
+ }
+
+ #puts $sql
+
+ $this check_connector
+ set tdbc_statement [uplevel 1 $connector prepare [::list $sql]]
+
+ #puts "--> $sql_values"
+ if {[catch {set tdbc_result [$tdbc_statement execute $sql_values]}
e errorinfo]} {
+ $tdbc_statement close
+ return -code error -errorinfo [::list $errorinfo]
+ } else {
+
+ # we must store also the TDBC SQL statement as it owns
+ # the TDBC results set represented by tdbc_result. Closing
+ # a tdbc::statement closes also any active tdbc::resultset
+ # owned by it
+
+ set result_obj [$this result TDBC -resultid $tdbc_result
\
+ -statement $tdbc_statement
\
+ -isselect false
\
+ -fields [::list
[$tdbc_result columns]]]
+ }
+
+ # this doesn't work on postgres, you've got to use cmdRows,
+ # we need to figure out what to do with this
+
+ set numrows [$result_obj numrows]
+ $result_obj destroy
+ return $numrows
+ }
+
+
#
+ # update - reimplementation of the ::DIO::Database::update
+ # method that is supposed to exploit the named arguments
+ # feature of TDBC.
+ #
+ method update {arrayName args} {
+ upvar 1 $arrayName row_a
+ $this table_check $args
+
+ # myTable is implicitly set by table_check
+
+ $this configure -table $myTable
+ set key [makekey row_a $myKeyfield]
+
+ #puts "-> table: $table"
+ #puts "-> key: $key"
+ #puts "-> keyfield: $myKeyfield"
+
+ set sql_values [dict create {*}[::array get row_a]]
+ set fields [::array names row_a]
+ if {[$special_fields_formatter has_special_fields $table]} {
+
+ # the special fields formatter is fundamentally incompatible
with
+ # TDBC's named arguments mechanism. We resort to the
superclass method
+ # where a literal SQL statement is built
+
+ set sql [$this build_update_query row_a $fields $table]
+ append sql [$this build_key_where_clause $myKeyfield $key]
+
+ } else {
+
+ set set_key_value_pairs [lmap field $fields {
+ set v "${field}=:${field}"
+ }]
+ set where_key_value_pairs [lmap field $myKeyfield {
+ set v "${field}=:${field}"
+ }]
+
+ ::lappend where_key_value_pairs "1 = 1"
+ set sql [join [::list "UPDATE $table" \
+ "SET [join $set_key_value_pairs {, }]"
\
+ "WHERE [join $where_key_value_pairs {
AND }]"] " "]
- protected method build_insert_query {arrayName fields {myTable ""}} {
+ }
+
+ #puts $sql
+ $this check_connector
+ set tdbc_statement [uplevel 1 $connector prepare [::list $sql]]
+
+ #puts "--> $sql_values"
+ if {[catch {set tdbc_result [$tdbc_statement execute $sql_values]}
e errorinfo]} {
+ $tdbc_statement close
+ return -code error -errorinfo [::list $errorinfo]
+ } else {
+
+ # we must store also the TDBC SQL statement as it owns
+ # the TDBC results set represented by tdbc_result. Closing
+ # a tdbc::statement closes also any active tdbc::resultset
+ # owned by it
+
+ set result_obj [$this result TDBC -resultid $tdbc_result
\
+ -statement $tdbc_statement
\
+ -isselect false
\
+ -fields [::list
[$tdbc_result columns]]]
+ }
+
+ # this doesn't work on postgres, you've got to use cmdRows,
+ # we need to figure out what to do with this
+
+ set numrows [$result_obj numrows]
+ $result_obj destroy
+ return $numrows
+ }
+
+ #
+ # insert -
+ #
+ # overriding method 'insert' as in case of registered special fields
+ # we have to give up with the idea of using the named arguments
approach
+ #
+ method insert {table arrayName} {
upvar 1 $arrayName row_a
- if {[::rivet::lempty $myTable]} { set myTable $table }
- set vars [::list]
- set named_pars_l [::list]
+ set sql_values [dict create {*}[::array get row_a]]
+ set fields [::array names row_a]
+ if {[$special_fields_formatter has_special_fields $table]} {
+ set sql [build_insert_query row_a [::array names row_a] $table]
+ } else {
+ set values [lmap field $fields { set v ":${field}" }]
- # we adopt the TDBC named parameters approach to deal with binary
- # data that may cause the SQL sanity checks to fail
+ set sql "INSERT INTO $table ([join $fields {,}]) VALUES ([join
$values {,}])"
+ }
- foreach field $fields {
- if {![info exists row_a($field)]} { continue }
- lappend vars "$field"
+ #puts $sql
- # we reformat the fields evaluating through the "special
fields formatter"
- # and assign their value to the array row_a which shadows
$arrayName in
- # the caller frame
+ $this check_connector
+ set tdbc_statement [uplevel 1 $connector prepare [::list $sql]]
- set row_a($field) [$this build_special_field $myTable $field
$row_a($field)]
+ if {[catch {set tdbc_result [$tdbc_statement execute $sql_values]}
e errorinfo]} {
+ $tdbc_statement close
+ return -code error -errorinfo [::list $errorinfo]
+ } else {
- # we don't evaluate an SQL statement, we build it for
evaluation by the caller
+ # we must store also the TDBC SQL statement as it owns
+ # the TDBC results set represented by tdbc_result. Closing
+ # a tdbc::statement closes also any active tdbc::resultset
+ # owned by it
- lappend named_pars_l ":${arrayName}($field)"
+ set result_obj [$this result TDBC -resultid $tdbc_result
\
+ -statement $tdbc_statement
\
+ -isselect false
\
+ -fields [::list
[$tdbc_result columns]]]
}
- return "INSERT INTO $myTable ([join $vars {,}]) VALUES ([join
$named_pars_l {,}])"
+ # this doesn't work on postgres, you've got to use cmdRows,
+ # we need to figure out what to do with this
+
+ set numrows [$result_obj numrows]
+ $result_obj destroy
+ return $numrows
}
#
diff --git a/rivet/packages/dio/formatters.tcl
b/rivet/packages/dio/formatters.tcl
index 2e6f605..b61082b 100644
--- a/rivet/packages/dio/formatters.tcl
+++ b/rivet/packages/dio/formatters.tcl
@@ -44,6 +44,17 @@ namespace eval ::DIO::formatters {
dict set special_fields $table_name $field_name $ftype
}
+ public method get_special_fields {table_name} {
+ if {[dict exists $special_fields $table_name]} {
+ return [dict keys [dict get $special_fields $table_name]
+ }
+ return ""
+ }
+
+ public method has_special_fields {table_name} {
+ return [dict exists $special_fields $table_name]
+ }
+
public method build {table_name field_name val convert_to} {
if {[dict exists $special_fields $table_name $field_name]} {
set field_type [dict get $special_fields $table_name
$field_name]
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
