This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a commit to branch tdbc
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
The following commit(s) were added to refs/heads/tdbc by this push:
new c974957 further development for tdbc support
c974957 is described below
commit c974957ad8d64e660574e1b12a5b70ea4fae1b68
Author: Massimo Manghi <mxman...@apache.org>
AuthorDate: Wed May 15 17:16:19 2024 +0200
further development for tdbc support
---
ChangeLog | 9 ++++++---
rivet/packages/dio/dio.tcl | 9 ++++++---
rivet/packages/dio/tdbc.tcl | 43 +++++++++++++++++++++++++++++++++++--------
3 files changed, 47 insertions(+), 14 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 64cb4d0..7eaea62 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,10 @@
+2024-05-15 Massimo Manghi <mxman...@apache.org>
+ * rivet/packages/dio/tdbc.tcl,dio.tcl: add early support for tdbc
database interface
+
2024-05-11 Massimo Manghi <mxman...@apache.org>
- * rivet/packages/aida/aida.tcl,sql.tcl: experimental files moved from
packages/dio
- * rivet/packages/rivet_ncgi/rivet_ncgi.tcl: fully qualifying rivet commands
- * Makefile.am: Remove svn Id:
+ * rivet/packages/aida/aida.tcl,sql.tcl: experimental files moved from
packages/dio
+ * rivet/packages/rivet_ncgi/rivet_ncgi.tcl: fully qualifying rivet
commands
+ * Makefile.am: Remove svn Id:
2024-04-12 Massimo Manghi <mxman...@apache.org>
* src/mod_rivet_ng/mod_rivet_common.c: Determining the server_rec also
diff --git a/rivet/packages/dio/dio.tcl b/rivet/packages/dio/dio.tcl
index 0333336..9de78d1 100644
--- a/rivet/packages/dio/dio.tcl
+++ b/rivet/packages/dio/dio.tcl
@@ -1,13 +1,13 @@
# dio.tcl -- implements a database abstraction layer.
# Copyright 2002-2004 The Apache Software Foundation
-
+#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
-
+#
# http://www.apache.org/licenses/LICENSE-2.0
-
+#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
@@ -28,6 +28,9 @@ proc handle {interface args} {
set args [lreplace $args 0 0]
}
uplevel \#0 package require dio_$interface
+
+ puts "obj: $obj args: $args"
+
return [uplevel \#0 ::DIO::$interface $obj $args]
}
diff --git a/rivet/packages/dio/tdbc.tcl b/rivet/packages/dio/tdbc.tcl
index 85e4ff3..0abc531 100644
--- a/rivet/packages/dio/tdbc.tcl
+++ b/rivet/packages/dio/tdbc.tcl
@@ -1,4 +1,6 @@
-# Copyright 2024 Massimo Manghi <mxman...@apache.org>
+# tdbc.tcl -- connector for tdbc, the Tcl database abstraction layer
+#
+# Copyright 2024 The Apache Software Foundation
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -15,7 +17,8 @@
package require DIO
-package provide dio::tdbc 0.1
+package require tdbc
+package provide dio_Tdbc 0.2
namespace eval DIO {
::itcl::class Tdbc {
@@ -28,7 +31,7 @@ namespace eval DIO {
-readonly \
-timeout]
- constructor {interface_name args} {eval configure $args} {
+ constructor {interface_name args} {eval configure {*}$args} {
set connector_n 0
set connector ""
@@ -81,7 +84,7 @@ namespace eval DIO {
# tdbc doesn't like ';' at the end of a SQL statement
- if {[::string index end $sql] == ";"} {set sql [::string range 0
end-1 $sql]}
+ if {[::string index $sql end] == ";"} {set sql [::string range 0
end-1 $sql]}
set is_select [regexp -nocase {^\(*\s*select\s+} $sql]
set sql_st [$connector prepare $sql]
@@ -93,7 +96,16 @@ namespace eval DIO {
if {[catch {set tdbc_result [$sql_st execute]} errorinfo]} {
return [$this result TDBC -error 1 -errorinfo $errorinfo
-isselect false]
} else {
- set result_obj [$this result -resultid $tdbc_result -isselect
$is_select -fields [$tdbc_result columns]]
+
+ # 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 $sql_st \
+ -isselect $is_select \
+ -fields [::list
[$tdbc_result columns]]]
}
}
@@ -103,26 +115,41 @@ namespace eval DIO {
::itcl::class TDBCResult {
inherit Result
public variable isselect false
+ public variable statement
private variable rowid
private variable cached_rows
private variable columns
constructor {args} {
- eval configure $args
+ eval configure $args
set cached_rows {}
set columns {}
set rowid 0
+ set statement ""
}
destructor {}
+ public method destroy {} {
+ if {$statement != ""} { $statement close }
+
+ Result::destroy
+ }
+
+ public method current_row {} {return $rowid}
+ public method cached_results {} {return $cached_rows}
+
public method nextrow {} {
if {[llength $cached_rows] == 0} {
- set row [$resultid nextrow]
+ if {[$resultid nextrow -as lists row]} {
+ incr rowid
+ } else {
+ set row ""
+ }
} else {
set row [lindex $cached_rows $rowid]
+ incr rowid
}
- incr rowid
return $row
}
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscr...@tcl.apache.org
For additional commands, e-mail: commits-h...@tcl.apache.org
