You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@tcl.apache.org by mx...@apache.org on 2024/05/18 09:45:00 UTC
(tcl-rivet) branch tdbc updated: moving towards an Object Oriented management of special fields formatting
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 59cf444 moving towards an Object Oriented management of special fields formatting
59cf444 is described below
commit 59cf4440f4be84c779f1bed3002520ecc6002b2a
Author: Massimo Manghi <mx...@apache.org>
AuthorDate: Sat May 18 11:44:54 2024 +0200
moving towards an Object Oriented management of special fields formatting
---
rivet/packages/dio/dio.tcl | 59 ++++++++++--
rivet/packages/dio/dio_Mysql.tcl | 90 +++++++++---------
rivet/packages/dio/dio_Oracle.tcl | 118 +++++++++++------------
rivet/packages/dio/dio_Postgresql.tcl | 92 +++++++++---------
rivet/packages/dio/dio_Sqlite.tcl | 89 +++++++++---------
rivet/packages/dio/dio_Tdbc.tcl | 3 +-
rivet/packages/dio/pkgIndex.tcl | 12 +--
rivet/packages/dio/tdbc.tcl | 170 ----------------------------------
8 files changed, 243 insertions(+), 390 deletions(-)
diff --git a/rivet/packages/dio/dio.tcl b/rivet/packages/dio/dio.tcl
index 9de78d1..69b7c50 100644
--- a/rivet/packages/dio/dio.tcl
+++ b/rivet/packages/dio/dio.tcl
@@ -29,7 +29,7 @@ proc handle {interface args} {
}
uplevel \#0 package require dio_$interface
- puts "obj: $obj args: $args"
+ #puts "obj: $obj args: $args"
return [uplevel \#0 ::DIO::$interface $obj $args]
}
@@ -601,12 +601,32 @@ proc handle {interface args} {
return [string "select count(*) from $myTable"]
}
- method makeDBFieldValue {table_name field_name val} {
- return "'[quote $val]'"
+ #
+
+ public method select_special_field {table_name field_name} {
+ if {[dict exists $special_fields $table_name $field_name]} {
+ return [dict get $special_fields $table_name $field_name]
+ } else {
+ return ""
+ }
+ }
+
+ public method build_special_field {table_name field_name val} {
+ return [$special_field_formatter build $table_name $field_name $val]
}
- method registerSpecialField {table_name field_name type} {
- set specialFields(${table_name}@${field_name}) $type
+ public method register_special_field {table_name field_name type} {
+ $special_fields_formatter register $table_name $field_name $type
+ }
+
+ # method kept for compatibility
+
+ public method registerSpecialField {table_name field_name type} {
+ $this register_special_field $table_name $field_name $type
+ }
+
+ public method makeDBFieldValue {table_name field_name val} {
+ return [$this build_special_field $table_name $field_name $val]
}
##
@@ -635,7 +655,7 @@ proc handle {interface args} {
method host {{string ""}} { return [configure_variable host $string] }
method port {{string ""}} { return [configure_variable port $string] }
- protected variable specialFields
+ private variable special_fields_formatter [FieldFormatter #auto]
public variable interface ""
public variable errorinfo ""
@@ -873,6 +893,31 @@ proc handle {interface args} {
} ; ## ::itcl::class Result
+# FieldFormatter
+#
+# we devolve the role of special field formatter to this
+# class. By design this is more sensible with respect to
+# the current approach of having such method in subclasses
+# because it allows to reuse the functionality of this
+# class in other DBMS connector.
+
+# this class must be subclassed for each database type
+
+::itcl::class FieldFormatter {
+
+ private variable special_fields [dict create]
+
+ public method register {table_name field_name ftype} {
+ dict set special_fields $table_name $field_name $ftype
+ }
+
+ public method build {table_name field_name val} {
+ return "'[quote $val]'"
+ }
+
+} ; ## ::itcl::class FieldFormatter
+
+
} ; ## namespace eval DIO
-package provide DIO 1.1
+package provide DIO 1.2
diff --git a/rivet/packages/dio/dio_Mysql.tcl b/rivet/packages/dio/dio_Mysql.tcl
index b88ee8e..e75c264 100644
--- a/rivet/packages/dio/dio_Mysql.tcl
+++ b/rivet/packages/dio/dio_Mysql.tcl
@@ -125,22 +125,20 @@ namespace eval DIO {
return $conn
}
- method makeDBFieldValue {table_name field_name val {convert_to {}}} {
+ method build_special_field {table_name field_name val {convert_to {}}} {
- if {[info exists specialFields(${table_name}@${field_name})]} {
- switch $specialFields(${table_name}@${field_name}) {
-
- DATE {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d}]
- return "DATE_FORMAT('$my_val','%Y-%m-%d')"
- }
- DATETIME {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "DATE_FORMAT('$my_val','%Y-%m-%d %T')"
- }
- NOW {
+ switch [$this select_special_field $table_name $field_name] {
+ DATE {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d}]
+ return "DATE_FORMAT('$my_val','%Y-%m-%d')"
+ }
+ DATETIME {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "DATE_FORMAT('$my_val','%Y-%m-%d %T')"
+ }
+ NOW {
# we try to be coherent with the original purpose of this method whose
# goal is endow the class with a uniform way to handle timestamps.
@@ -149,52 +147,48 @@ namespace eval DIO {
# can be done and session expirations are computed consistently.
# (Bug #53703)
- switch $convert_to {
+ switch $convert_to {
- SECS {
- if {[::string compare $val "now"] == 0} {
+ SECS {
+ if {[::string compare $val "now"] == 0} {
-# set secs [clock seconds]
-# set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
-# return $my_val
+# set secs [clock seconds]
+# set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
+# return $my_val
- return [clock seconds]
+ return [clock seconds]
- } else {
- return "UNIX_TIMESTAMP($field_name)"
- }
+ } else {
+ return "UNIX_TIMESTAMP($field_name)"
}
- default {
+ }
+ default {
- if {[::string compare $val, "now"] == 0} {
- set secs [clock seconds]
- } else {
- set secs [clock scan $val]
- }
+ if {[::string compare $val, "now"] == 0} {
+ set secs [clock seconds]
+ } else {
+ set secs [clock scan $val]
+ }
- # this is kind of going back and forth from the same
- # format,
+ # this is kind of going back and forth from the same
+ # format,
- #set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "FROM_UNIXTIME('$secs')"
- }
- }
- }
- NULL {
- if {[::string toupper $val] == "NULL"} {
- return $val
- } else {
- return "'[quote $val]'"
+ #set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "FROM_UNIXTIME('$secs')"
}
}
- default {
- # no special code for that type!!
+ }
+ NULL {
+ if {[::string toupper $val] == "NULL"} {
+ return $val
+ } else {
return "'[quote $val]'"
}
}
-
- } else {
- return "'[quote $val]'"
+ default {
+ # no special code for that type!!
+ return "'[quote $val]'"
+ }
}
}
diff --git a/rivet/packages/dio/dio_Oracle.tcl b/rivet/packages/dio/dio_Oracle.tcl
index 1348468..8f65b54 100644
--- a/rivet/packages/dio/dio_Oracle.tcl
+++ b/rivet/packages/dio/dio_Oracle.tcl
@@ -14,9 +14,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-# $Id: dio_Oracle.tcl 265421 2004-10-29 20:17:54Z karl $
-
-package provide dio_Oracle 0.1
+package provide dio_Oracle 0.3
namespace eval DIO {
::itcl::class Oracle {
@@ -24,16 +22,16 @@ namespace eval DIO {
constructor {args} {eval configure $args} {
if {[catch {package require Oratcl}]} {
- return -code error "No Oracle Tcl package available"
+ return -code error "No Oracle Tcl package available"
}
eval configure $args
if {[::rivet::lempty $db]} {
- if {[::rivet::lempty $user]} {
- set user $::env(USER)
- }
- set db $user
+ if {[::rivet::lempty $user]} {
+ set user $::env(USER)
+ }
+ set db $user
}
}
@@ -71,25 +69,25 @@ namespace eval DIO {
set cmd ::orasql
set is_select 0
if {[::string tolower [lindex $req 0]] == "select"} {
- set cmd ::orasql
- set is_select 1
+ set cmd ::orasql
+ set is_select 1
}
set errorinfo ""
#puts "ORA:$is_select:$req:<br>"
if {[catch {$cmd $_cur $req} error]} {
#puts "ORA:error:$error:<br>"
- set errorinfo $error
- catch {::oraclose $_cur}
- set obj [result $interface -error 1 -errorinfo [::list $error]]
- return $obj
+ set errorinfo $error
+ catch {::oraclose $_cur}
+ set obj [result $interface -error 1 -errorinfo [::list $error]]
+ return $obj
}
if {[catch {::oracols $_cur name} fields]} { set fields "" }
::oracommit $conn
set my_fields $fields
set fields [::list]
foreach field $my_fields {
- set field [::string tolower $field]
- lappend fields $field
+ set field [::string tolower $field]
+ lappend fields $field
}
set error [::oramsg $_cur rows]
set res_cmd "result"
@@ -98,7 +96,7 @@ namespace eval DIO {
lappend res_cmd -fetch_first_row $is_select
set obj [eval $res_cmd]
if {!$is_select} {
- ::oraclose $_cur
+ ::oraclose $_cur
}
return $obj
}
@@ -127,55 +125,51 @@ namespace eval DIO {
return $conn
}
- method makeDBFieldValue {table_name field_name val {convert_to {}}} {
- if {[info exists specialFields(${table_name}@${field_name})]} {
- switch $specialFields(${table_name}@${field_name}) {
- DATE {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d}]
- return "to_date('$my_val', 'YYYY-MM-DD')"
- }
- DATETIME {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "to_date('$my_val', 'YYYY-MM-DD HH24:MI:SS')"
- }
- NOW {
- switch $convert_to {
- SECS {
- if {[::string compare $val "now"] == 0} {
- set secs [clock seconds]
- set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
- return $my_val
- } else {
- return "($field_name - to_date('1970-01-01')) * 86400"
- #return "to_char($field_name, 'YYYYMMDDHH24MISS')"
- }
- }
- default {
- if {[::string compare $val "now"] == 0} {
- set secs [clock seconds]
- } else {
- set secs [clock scan $val]
- }
- set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "to_date('$my_val', 'YYYY-MM-DD HH24:MI:SS')"
- }
- }
- }
- default {
- # no special cod for that type!!
- return "'[quote $val]'"
- }
- }
- } else {
- return "'[quote $val]'"
- }
+ method build_special_field {table_name field_name val {convert_to {}}} {
+ switch [$this select_special_field $table_name $field_name] {
+ DATE {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d}]
+ return "to_date('$my_val', 'YYYY-MM-DD')"
+ }
+ DATETIME {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "to_date('$my_val', 'YYYY-MM-DD HH24:MI:SS')"
+ }
+ NOW {
+ switch $convert_to {
+ SECS {
+ if {[::string compare $val "now"] == 0} {
+ set secs [clock seconds]
+ set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
+ return $my_val
+ } else {
+ return "($field_name - to_date('1970-01-01')) * 86400"
+ #return "to_char($field_name, 'YYYYMMDDHH24MISS')"
+ }
+ }
+ default {
+ if {[::string compare $val "now"] == 0} {
+ set secs [clock seconds]
+ } else {
+ set secs [clock scan $val]
+ }
+ set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "to_date('$my_val', 'YYYY-MM-DD HH24:MI:SS')"
+ }
+ }
+ }
+ default {
+ # no special cod for that type!!
+ return "'[quote $val]'"
+ }
+ }
}
public variable db "" {
if {[info exists conn]} {
- mysqluse $conn $db
+ mysqluse $conn $db
}
}
diff --git a/rivet/packages/dio/dio_Postgresql.tcl b/rivet/packages/dio/dio_Postgresql.tcl
index 3dafcbf..35cbfd3 100644
--- a/rivet/packages/dio/dio_Postgresql.tcl
+++ b/rivet/packages/dio/dio_Postgresql.tcl
@@ -15,7 +15,7 @@
# limitations under the License.
package require DIO
-package provide dio_Postgresql 0.1
+package provide dio_Postgresql 0.2
namespace eval DIO {
::itcl::class Postgresql {
@@ -101,60 +101,56 @@ namespace eval DIO {
return $conn
}
- method makeDBFieldValue {table_name field_name val {convert_to {}}} {
- if {[info exists specialFields(${table_name}@${field_name})]} {
- switch $specialFields(${table_name}@${field_name}) {
- DATE {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d}]
- return "'$my_val'"
- }
- DATETIME {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "'$my_val'"
- }
- NOW {
- switch $convert_to {
-
- # we try to be coherent with the original purpose of this method whose
- # goal is to provide to the programmer a uniform way to handle timestamps.
- # E.g.: Package session expects this case to return a timestamp in seconds
- # so that differences with timestamps returned by [clock seconds]
- # can be done and session expirations are computed consistently.
- # (Bug #53703)
-
- SECS {
- if {[::string compare $val "now"] == 0} {
-# set secs [clock seconds]
-# set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
-# return $my_val
- return [clock seconds]
- } else {
- return "extract(epoch from $field_name)"
- }
+ method build_special_field {table_name field_name val {convert_to {}}} {
+ switch [$this select_special_field $table_name $field_name] {
+ DATE {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d}]
+ return "'$my_val'"
+ }
+ DATETIME {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "'$my_val'"
+ }
+ NOW {
+ switch $convert_to {
+
+ # we try to be coherent with the original purpose of this method whose
+ # goal is to provide to the programmer a uniform way to handle timestamps.
+ # E.g.: Package session expects this case to return a timestamp in seconds
+ # so that differences with timestamps returned by [clock seconds]
+ # can be done and session expirations are computed consistently.
+ # (Bug #53703)
+
+ SECS {
+ if {[::string compare $val "now"] == 0} {
+# set secs [clock seconds]
+# set my_val [clock format $secs -format {%Y%m%d%H%M%S}]
+# return $my_val
+ return [clock seconds]
+ } else {
+ return "extract(epoch from $field_name)"
+ }
+ }
+ default {
+ if {[::string compare $val, "now"] == 0} {
+ set secs [clock seconds]
+ } else {
+ set secs [clock scan $val]
}
- default {
- if {[::string compare $val, "now"] == 0} {
- set secs [clock seconds]
- } else {
- set secs [clock scan $val]
- }
- # this is kind of going back and forth from the same
- # format,
+ # this is kind of going back and forth from the same
+ # format,
- return "'[clock format $secs -format {%Y-%m-%d %T}]'"
- }
+ return "'[clock format $secs -format {%Y-%m-%d %T}]'"
}
}
- default {
- # no special code for that type!!
- return [pg_quote $val]
- }
}
- } else {
+ default {
+ # no special code for that type!!
return [pg_quote $val]
+ }
}
}
diff --git a/rivet/packages/dio/dio_Sqlite.tcl b/rivet/packages/dio/dio_Sqlite.tcl
index 9379e90..7404a0b 100644
--- a/rivet/packages/dio/dio_Sqlite.tcl
+++ b/rivet/packages/dio/dio_Sqlite.tcl
@@ -15,7 +15,7 @@
# limitations under the License.
package require DIO
-package provide dio_Sqlite 0.1
+package provide dio_Sqlite 0.2
namespace eval DIO {
variable sqlite_seq -1
@@ -109,63 +109,58 @@ namespace eval DIO {
return $string
}
- method makeDBFieldValue {table_name field_name val {convert_to {}}} {
- if {[info exists specialFields(${table_name}@${field_name})]} {
- switch $specialFields(${table_name}@${field_name}) {
- DATE {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d}]
- return "date('$my_val')"
- }
- DATETIME {
- set secs [clock scan $val]
- set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "datetime('$my_val')"
- }
- NOW {
- switch $convert_to {
-
- # we try to be coherent with the original purpose of this method whose
- # goal is to provide to the programmer a uniform way to handle timestamps.
- # E.g.: Package session expects this case to return a timestamp in seconds
- # so that differences with timestamps returned by [clock seconds]
- # can be done and session expirations are computed consistently.
- # (Bug #53703)
-
- SECS {
- if {[::string compare $val "now"] == 0} {
+ method buil_special_field {table_name field_name val {convert_to {}}} {
+ switch [$this select_special_field $table_name $field_name] {
+ DATE {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d}]
+ return "date('$my_val')"
+ }
+ DATETIME {
+ set secs [clock scan $val]
+ set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "datetime('$my_val')"
+ }
+ NOW {
+ switch $convert_to {
+
+ # we try to be coherent with the original purpose of this method whose
+ # goal is to provide to the programmer a uniform way to handle timestamps.
+ # E.g.: Package session expects this case to return a timestamp in seconds
+ # so that differences with timestamps returned by [clock seconds]
+ # can be done and session expirations are computed consistently.
+ # (Bug #53703)
+
+ SECS {
+ if {[::string compare $val "now"] == 0} {
# set secs [clock seconds]
# set my_val [clock format $secs -format "%Y%m%d%H%M%S"]
- return [clock seconds]
- } else {
+ return [clock seconds]
+ } else {
- # the numbers of seconds must be returned as 'utc' to
- # be compared with values returned by [clock seconds]
+ # the numbers of seconds must be returned as 'utc' to
+ # be compared with values returned by [clock seconds]
- return "strftime('%s',$field_name,'utc')"
- }
+ return "strftime('%s',$field_name,'utc')"
}
- default {
- if {[::string compare $val, "now"] == 0} {
- set secs [clock seconds]
- } else {
- set secs [clock scan $val]
- }
- set my_val [clock format $secs -format {%Y-%m-%d %T}]
- return "datetime('$my_val')"
+ }
+ default {
+ if {[::string compare $val, "now"] == 0} {
+ set secs [clock seconds]
+ } else {
+ set secs [clock scan $val]
}
+ set my_val [clock format $secs -format {%Y-%m-%d %T}]
+ return "datetime('$my_val')"
}
}
- default {
- # no special code for that type!!
- return "'[quote $val]'"
- }
}
- } else {
- return "'[quote $val]'"
+ default {
+ # no special code for that type!!
+ return "'[quote $val]'"
+ }
}
}
-
}
catch { ::itcl::delete class SqliteResult }
diff --git a/rivet/packages/dio/dio_Tdbc.tcl b/rivet/packages/dio/dio_Tdbc.tcl
index 4156d2f..3a318bd 100644
--- a/rivet/packages/dio/dio_Tdbc.tcl
+++ b/rivet/packages/dio/dio_Tdbc.tcl
@@ -15,7 +15,6 @@
# limitations under the License.
#
-
package require DIO
package require tdbc
package provide dio_Tdbc 0.2
@@ -58,7 +57,7 @@ namespace eval DIO {
if {$clientargs != ""} { lappend connector_cmd {*}$clientargs }
- puts "evaluating $connector_cmd"
+ #puts "evaluating $connector_cmd"
set connector [eval $connector_cmd]
incr connector_n
diff --git a/rivet/packages/dio/pkgIndex.tcl b/rivet/packages/dio/pkgIndex.tcl
index 4140cbf..29a98a1 100644
--- a/rivet/packages/dio/pkgIndex.tcl
+++ b/rivet/packages/dio/pkgIndex.tcl
@@ -8,10 +8,10 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-package ifneeded DIO 1.0 [list source [file join $dir dio.tcl]]
+package ifneeded DIO 1.2 [list source [file join $dir dio.tcl]]
package ifneeded DIODisplay 1.0 [list source [file join $dir diodisplay.tcl]]
-package ifneeded dio_Mysql 0.2 [list source [file join $dir dio_Mysql.tcl]]
-package ifneeded dio_Oracle 0.1 [list source [file join $dir dio_Oracle.tcl]]
-package ifneeded dio_Postgresql 0.1 [list source [file join $dir dio_Postgresql.tcl]]
-package ifneeded dio_Sqlite 0.1 [list source [file join $dir dio_Sqlite.tcl]]
-package ifneeded dio_Tdbc 0.1 [list source [file join $dir dio_Tdbc.tcl]]
+package ifneeded dio_Mysql 0.4 [list source [file join $dir dio_Mysql.tcl]]
+package ifneeded dio_Oracle 0.3 [list source [file join $dir dio_Oracle.tcl]]
+package ifneeded dio_Postgresql 0.2 [list source [file join $dir dio_Postgresql.tcl]]
+package ifneeded dio_Sqlite 0.2 [list source [file join $dir dio_Sqlite.tcl]]
+package ifneeded dio_Tdbc 0.2 [list source [file join $dir dio_Tdbc.tcl]]
diff --git a/rivet/packages/dio/tdbc.tcl b/rivet/packages/dio/tdbc.tcl
deleted file mode 100644
index 4156d2f..0000000
--- a/rivet/packages/dio/tdbc.tcl
+++ /dev/null
@@ -1,170 +0,0 @@
-# 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.
-# 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.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-
-
-package require DIO
-package require tdbc
-package provide dio_Tdbc 0.2
-
-namespace eval DIO {
- ::itcl::class Tdbc {
- inherit Database
-
- private variable connector_n
- private variable connector
- private variable tdbc_arguments [list -encoding \
- -isolation \
- -readonly \
- -timeout]
-
- constructor {interface_name args} {eval configure {*}$args} {
- set connector_n 0
- set connector ""
-
- # I should check this one: we only accept connector
- # interfaces that map into tdbc's
- set interface "tdbc::[::string tolower $interface_name]"
-
- package require ${interface}
- }
-
- destructor { }
-
- private method check_connector {} {
- if {$connector == ""} { open }
- }
-
- public method open {} {
- set connector_cmd "${interface}::connection create $interface#$connector_n"
- if {$user != ""} { lappend connector_cmd -user $user }
- if {$db != ""} { lappend connector_cmd -db $db }
- if {$pass != ""} { lappend connector_cmd -password $pass }
- if {$port != ""} { lappend connector_cmd -port $port }
- if {$host != ""} { lappend connector_cmd -host $host }
-
- if {$clientargs != ""} { lappend connector_cmd {*}$clientargs }
-
- puts "evaluating $connector_cmd"
-
- set connector [eval $connector_cmd]
- incr connector_n
- }
-
- public method close {} {
- if {$connector == ""} { return }
- $connector close
- set connector ""
- }
-
- protected method handle_client_arguments {cargs} {
- set clientargs {}
- lmap {k v} $cargs {
- if {[lsearch $k $tdbcarguments] >= 0} {
- lappend clientargs $k $v
- }
- }
- }
-
- public method exec {sql} {
- $this check_connector
-
- # tdbc doesn't like ';' at the end of a SQL statement
-
- if {[::string index $sql end] == ";"} {set sql [::string range $sql 0 end-1]}
- set is_select [regexp -nocase {^\(*\s*select\s+} $sql]
-
- set sql_st [$connector prepare $sql]
-
- # errorinfo is a public variable of the
- # parent class Database. Not a good
- # object design practice
-
- if {[catch {set tdbc_result [$sql_st execute]} errorinfo]} {
- return [$this result TDBC -error 1 -errorinfo $errorinfo -isselect false]
- } 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 $sql_st \
- -isselect $is_select \
- -fields [::list [$tdbc_result columns]]]
- }
- }
- }
-
- ::itcl::class TDBCResult {
- inherit Result
- public variable isselect false
- public variable statement
-
- public variable rowid
- public variable cached_rows
- public variable columns
-
- constructor {args} {
- eval configure $args
- set cached_rows {}
- set columns {}
- set rowid 0
- set rownum 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} {
- if {![$resultid nextrow -as lists row]} {
- return ""
- }
- } else {
- set cached_rows [lassign $cached_rows row]
- }
- incr rowid
- return $row
- }
-
- public method numrows {} {
- if {$isselect} {
-
- # this is not scaling well at all but tdbc is not telling
- # the number of columns for a select so must determine it
- # from the whole set of results
-
- if {[llength $cached_rows] == 0} {
- set cached_rows [$resultid allrows -as lists -columnsvariable columns]
- }
- return [expr [llength $cached_rows] + $rowid]
- } else {
- return [$resultid rowcount]
- }
- }
-
- }
-}
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@tcl.apache.org
For additional commands, e-mail: commits-help@tcl.apache.org