This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a commit to branch master
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
commit 24cec01cee0b7f47a87befc1b859f74ee02539df
Author: Massimo Manghi <mxman...@apache.org>
AuthorDate: Mon Sep 9 18:15:11 2024 +0200
merging branch tdbc with new dbms connectors
---
ChangeLog | 5 +
rivet/packages/dio/dio11.tcl | 875 +++++++++++++++++++++
rivet/packages/dio/dio_Mysql.tcl | 6 +-
.../dio/{dio_Mysql.tcl => dio_Mysql04.tcl} | 91 ++-
rivet/packages/dio/dio_Oracle.tcl | 3 +-
rivet/packages/dio/dio_Oracle01.tcl | 242 ++++++
rivet/packages/dio/dio_Postgresql.tcl | 3 +-
.../{dio_Postgresql.tcl => dio_Postgresql01.tcl} | 99 +--
rivet/packages/dio/dio_Sqlite.tcl | 3 +-
.../dio/{dio_Sqlite.tcl => dio_Sqlite01.tcl} | 72 +-
rivet/packages/dio/dio_Tdbc.tcl | 2 +-
rivet/packages/dio/pkgIndex.tcl | 18 +-
12 files changed, 1335 insertions(+), 84 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 2b816d6..8d241c3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2024-09-09 Massimo Manghi <mxman...@apache.org>
+ * rivet/packages/dio: merging branch tdbc with DIO 1.2 and new dio
connectors
+ using class Formatter descendands to print special fields and
introducing new dio_Tdbc.tcl
+ connector, a portmanteau class switching among tdbc connectors
+
2024-08-23 Massimo Manghi <mxman...@apache.org>
* rivet/packages/dio/dio_Mysql.c,dio_Tdbc.c: fixed wrong argument list
construction
and wrong argument to legacy mysqltcl connector
diff --git a/rivet/packages/dio/dio11.tcl b/rivet/packages/dio/dio11.tcl
new file mode 100644
index 0000000..c6a27f2
--- /dev/null
+++ b/rivet/packages/dio/dio11.tcl
@@ -0,0 +1,875 @@
+# 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.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+catch {package require Tclx}
+package require Itcl
+##set auto_path [linsert $auto_path 0 [file dirname [info script]]]
+
+namespace eval ::DIO {
+
+proc handle {interface args} {
+ set obj \#auto
+ set first [lindex $args 0]
+ if {![::rivet::lempty $first] && [string index $first 0] != "-"} {
+ set obj [lindex $args 0]
+ set args [lreplace $args 0 0]
+ }
+ uplevel \#0 package require dio_$interface
+ return [uplevel \#0 ::DIO::$interface $obj $args]
+}
+
+##
+# DATABASE CLASS
+##
+::itcl::class Database {
+ constructor {args} {
+ eval configure $args
+ }
+
+ destructor {
+ close
+ }
+
+ #
+ # result - generate a new DIO result object for the specified database
+ # interface, with key-value pairs that get configured into the new
+ # result object.
+ #
+ protected method result {interface args} {
+ return [eval uplevel \#0 ::DIO::${interface}Result \#auto $args]
+ }
+
+ #
+ # quote - given a string, return the same string with any single
+ # quote characters preceded by a backslash
+ #
+ method quote {string} {
+ regsub -all {'} $string {\'} string
+ return $string
+ }
+
+ #
+ # build_select_query - build a select query based on given arguments,
+ # which can include a table name, a select statement, switches to
+ # turn on boolean AND or OR processing, and possibly
+ # some key-value pairs that cause the where clause to be
+ # generated accordingly
+ #
+ protected method build_select_query {args} {
+
+ set bool AND
+ set first 1
+ set req ""
+ set myTable $table
+ set what "*"
+
+ # for each argument passed us...
+ # (we go by integers because we mess with the index based on
+ # what we find)
+ for {set i 0} {$i < [llength $args]} {incr i} {
+ # fetch the argument we're currently processing
+ set elem [lindex $args $i]
+
+ switch -- [::string tolower $elem] {
+ "-and" {
+ # -and -- switch to AND-style processing
+ set bool AND
+ }
+
+ "-or" {
+ # -or -- switch to OR-style processing
+ set bool OR
+ }
+
+ "-table" {
+ # -table -- identify which table the query is about
+ set myTable [lindex $args [incr i]]
+ }
+
+ "-select" {
+ # -select -
+ set what [lindex $args [incr i]]
+ }
+
+ default {
+ # it wasn't -and, -or, -table, or -select...
+
+ # if the first character of the element is a dash,
+ # it's a field name and a value
+
+ if {[::string index $elem 0] == "-"} {
+ set field [::string range $elem 1 end]
+ set elem [lindex $args [incr i]]
+
+ # if it's the first field being processed, append
+ # WHERE to the SQL request we're generating
+ if {$first} {
+ append req " WHERE"
+ set first 0
+ } else {
+ # it's not the first variable in the comparison
+ # expression, so append the boolean state, either
+ # AND or OR
+ append req " $bool"
+ }
+
+ # convert any asterisks to percent signs in the
+ # value field
+ regsub -all {\*} $elem {%} elem
+
+ # if there is a percent sign in the value
+ # field now (having been there originally or
+ # mapped in there a moment ago), the SQL aspect
+ # is appended with a "field LIKE value"
+
+ if {[::string first {%} $elem] != -1} {
+ append req " $field LIKE [makeDBFieldValue
$myTable $field $elem]"
+ } elseif {[regexp {^([<>]) *([0-9.]*)$} $elem _ fn
val]} {
+ # value starts with <, or >, then space,
+ # and a something
+ append req " $field$fn$val"
+ } elseif {[regexp {^([<>]=) *([0-9.]*)$} $elem _ fn
val]} {
+ # value starts with <= or >=, space, and something.
+ append req " $field$fn$val"
+ } else {
+ # otherwise it's a straight key=value comparison
+ append req " $field=[makeDBFieldValue $myTable
$field $elem]"
+ }
+
+ continue
+ }
+ append req " $elem"
+ }
+ }
+ }
+ return "select $what from $myTable $req"
+ }
+
+ #
+ # build_insert_query -- given an array name, a list of fields, and
+ # possibly a table name, return a SQL insert statement inserting
+ # into the named table (or the object's table variable, if none
+ # is specified) for all of the fields specified, with their values
+ # coming from the array
+ #
+ protected method build_insert_query {arrayName fields {myTable ""}} {
+ upvar 1 $arrayName array
+
+ if {[::rivet::lempty $myTable]} { set myTable $table }
+ set vals [::list]
+ set vars [::list]
+ foreach field $fields {
+ if {![info exists array($field)]} { continue }
+ lappend vars "$field"
+ lappend vals "[makeDBFieldValue $myTable $field $array($field)]"
+ }
+ return "insert into $myTable ([join $vars {,}]) VALUES ([join $vals
{,}])"
+ }
+
+ #
+ # build_update_query -- given an array name, a list of fields, and
+ # possibly a table name, return a SQL update statement updating
+ # the named table (or using object's table variable, if none
+ # is named) for all of the fields specified, with their values
+ # coming from the array
+ #
+ # note that after use a where clause still neds to be added or
+ # you might update a lot more than you bargained for
+ #
+ protected method build_update_query {arrayName fields {myTable ""}} {
+ upvar 1 $arrayName array
+ if {[::rivet::lempty $myTable]} { set myTable $table }
+ set string [::list]
+ foreach field $fields {
+ if {![info exists array($field)]} { continue }
+ lappend string "$field=[makeDBFieldValue $myTable $field
$array($field)]"
+ }
+
+ return "UPDATE $myTable SET [join $string {,}]"
+ }
+
+ #
+ # lassign_array - given a list, an array name, and a variable number
+ # of arguments consisting of variable names, assign each element in
+ # the list, in turn, to elements corresponding to the variable
+ # arguments, into the named array. From TclX.
+ #
+ protected method lassign_array {list arrayName args} {
+ upvar 1 $arrayName array
+ foreach elem $list field $args {
+ set array($field) $elem
+ }
+ }
+
+ #
+ # configure_variable - given a variable name and a string, if the
+ # string is empty return the variable name, otherwise set the
+ # variable to the string.
+ #
+ protected method configure_variable {varName string} {
+ if {[::rivet::lempty $string]} { return [cget -$varName] }
+ configure -$varName $string
+ }
+
+ #
+ # build_where_key_clause - given a list of one or more key fields and
+ # a corresponding list of one or more key values, construct a
+ # SQL where clause that boolean ANDs all of the key-value pairs
+ # together.
+ #
+ protected method build_key_where_clause {myKeyfield myKey} {
+ ## If we're not using multiple keyfields, just return a simple
+ ## where clause.
+ if {[llength $myKeyfield] < 2} {
+ return " WHERE $myKeyfield = [makeDBFieldValue $table $myKeyfield
$myKey]"
+ }
+
+ # multiple fields, construct it as a where-and
+ set req " WHERE 1 = 1"
+ foreach field $myKeyfield key $myKey {
+ append req " AND $field = [makeDBFieldValue $table $field $key]"
+ }
+ return $req
+ }
+
+ ##
+ ## makekey -- Given an array containing a key-value pairs and
+ # an optional list of key fields (we use the object's keyfield
+ # if none is specified)...
+ #
+ # if we're doing auto keys, create and return a new key,
+ # otherwise if it's a single key, just return its value
+ # from the array, else if it's multiple keys, return all their
+ # values as a list
+ ##
+ method makekey {arrayName {myKeyfield ""}} {
+ if {[::rivet::lempty $myKeyfield]} { set myKeyfield $keyfield }
+ if {[::rivet::lempty $myKeyfield]} {
+ return -code error "No -keyfield specified in object"
+ }
+ upvar 1 $arrayName array
+
+ ## If we're not using multiple keyfields, we want to check and see
+ ## if we're using auto keys. If we are, create a new key and
+ ## return it. If not, just return the value of the single keyfield
+ ## in the array.
+ if {[llength $myKeyfield] < 2} {
+ if {$autokey} {
+ set array($myKeyfield) [$this nextkey]
+ } else {
+ if {![info exists array($myKeyfield)]} {
+ return -code error \
+ "${arrayName}($myKeyfield) does not exist"
+ }
+ }
+ return $array($myKeyfield)
+ }
+
+ ## We're using multiple keys. Return a list of all the keyfield
+ ## values.
+ foreach field $myKeyfield {
+ if {![info exists array($field)]} {
+ return -code error "$field does not exist in $arrayName"
+ }
+ lappend key $array($field)
+ }
+ return $key
+ }
+
+ method destroy {} {
+ ::itcl::delete object $this
+ }
+
+ #
+ # string - execute a SQL request and only return a string of one row.
+ #
+ method string {req} {
+ set res [exec $req]
+ $res next -list val
+ $res destroy
+ return $val
+ }
+
+ #
+ # list - execute a request and return a list of the first element of each
+ # row returned.
+ #
+ method list {req} {
+ set res [exec $req]
+ set list ""
+ $res forall -list line {
+ lappend list [lindex $line 0]
+ }
+ $res destroy
+ return $list
+ }
+
+ #
+ # array - execute a request and setup an array containing elements
+ # with the field names as the keys and the first row results as
+ # the values
+ #
+ method array {req arrayName} {
+ upvar 1 $arrayName $arrayName
+ set res [exec $req]
+ set ret [$res next -array $arrayName]
+ $res destroy
+ return $ret
+ }
+
+ #
+ # forall - execute a SQL select and iteratively fill the named array
+ # with elements named with the matching field names, containing the
+ # matching values, executing the specified code body for each, in turn.
+ #
+ method forall {req arrayName body} {
+ upvar 1 $arrayName $arrayName
+
+ set res [exec $req]
+
+ $res forall -array $arrayName {
+ uplevel 1 $body
+ }
+
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+
+ set ret [$res numrows]
+ $res destroy
+ return $ret
+ }
+
+ #
+ # table_check - internal method to populate the data array with
+ # a -table element containing the table name, a -keyfield element
+ # containing the key field or list of key fields, and a list of
+ # key-value pairs to get set into the data table.
+ #
+ # afterwards, it's an error if -table or -keyfield hasn't somehow been
+ # determined.
+ #
+ protected method table_check {list {tableVar myTable} {keyVar myKeyfield}}
{
+ upvar 1 $tableVar $tableVar $keyVar $keyVar
+ set data(-table) $table
+ set data(-keyfield) $keyfield
+ ::array set data $list
+
+ if {[::rivet::lempty $data(-table)]} {
+ return -code error -errorcode missing_table "-table not specified
in DIO object"
+ }
+ set $tableVar $data(-table)
+
+ if {[::rivet::lempty $data(-keyfield)]} {
+ return -code error -errorcode missing_keyfield "-keyfield not
specified in DIO object"
+ }
+
+ set $keyVar $data(-keyfield)
+ }
+
+ #
+ # key_check - given a list of key fields and a list of keys, it's
+ # an error if there aren't the same number of each, and if it's
+ # autokey, there can't be more than one key.
+ #
+ protected method key_check {myKeyfield myKey} {
+ if {[llength $myKeyfield] < 2} { return }
+ if {$autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
+ if {[llength $myKeyfield] != [llength $myKey]} {
+ return -code error "Bad key length."
+ }
+ }
+
+ #
+ # fetch - given a key (or list of keys) an array name, and some
+ # extra key-value arguments like -table and -keyfield, fetch
+ # the key into the array
+ #
+ method fetch {key arrayName args} {
+ table_check $args
+ key_check $myKeyfield $key
+ upvar 1 $arrayName $arrayName
+ set req "select * from $myTable"
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [$this exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+ set rows_found [expr [$res numrows] > 0]
+ $res next -array $arrayName
+ $res destroy
+
+ return $rows_found
+ }
+
+ #
+ # store - given an array containing key-value pairs and optional
+ # arguments like -table and -keyfield, insert or update the
+ # corresponding table entry.
+ #
+ method store {arrayName args} {
+ table_check $args
+ upvar 1 $arrayName $arrayName $arrayName array
+ if {[llength $myKeyfield] > 1 && $autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
+
+ set key [makekey $arrayName $myKeyfield]
+ set req "select * from $myTable"
+ append req [build_key_where_clause $myKeyfield $key]
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+ set numrows [$res numrows]
+ $res destroy
+
+ if {$numrows} {
+ $this update $arrayName {*}$args
+ } else {
+ $this insert $myTable $arrayName
+ }
+ return 1
+ }
+
+ #
+ # update - a pure update, without store's somewhat clumsy
+ # efforts to see if it needs to be an update rather than
+ # an insert
+ #
+ method update {arrayName args} {
+ table_check $args
+ upvar 1 $arrayName $arrayName $arrayName array
+
+ set key [makekey $arrayName $myKeyfield]
+
+ set fields [::array names array]
+ set req [build_update_query array $fields $myTable]
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+
+ # this doesn't work on postgres, you've got to use cmdRows,
+ # we need to figure out what to do with this
+ set numrows [$res numrows]
+ $res destroy
+ return $numrows
+ }
+
+ #
+ # update_with_explicit_key - an update where the key is specified
+ # as an argument to the proc rather than being dug out of the array
+ #
+ # this is a kludge until we come up with a better way to
+ # solve the problem of updating a row where we actually
+ # want to change the value of a key field
+ #
+ method update_with_explicit_key {key arrayName args} {
+ table_check $args
+ key_check $myKeyfield $key
+ upvar 1 $arrayName $arrayName $arrayName array
+
+ set fields [::array names array]
+ set req [build_update_query array $fields $myTable]
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+
+ # this doesn't work on postgres, you've got to use cmdRows,
+ # we need to figure out what to do with this
+ set numrows [$res numrows]
+ $res destroy
+ return $numrows
+ }
+
+ #
+ # insert - a pure insert, without store's somewhat clumsy
+ # efforts to see if it needs to be an update rather than
+ # an insert -- this shouldn't require fields, it's broken
+ #
+ method insert {table arrayName} {
+ upvar 1 $arrayName $arrayName $arrayName array
+ set req [build_insert_query array [::array names array] $table]
+
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+ $res destroy
+ return 1
+ }
+
+ #
+ # delete - delete matching record from the specified table
+ #
+ method delete {key args} {
+ table_check $args
+ set req "DELETE FROM $myTable"
+ append req [build_key_where_clause $myKeyfield $key]
+
+ set res [exec $req]
+ if {[$res error]} {
+ set errinf [$res errorinfo]
+ $res destroy
+ return -code error "Got '$errinf' executing '$req'"
+ }
+
+ set n_deleted_rows [$res numrows]
+ $res destroy
+ return $n_deleted_rows
+ }
+
+ #
+ # keys - return all keys in a table
+ #
+ method keys {args} {
+ table_check $args
+ set req "select * from $myTable"
+ set obj [$this exec $req]
+
+ set keys ""
+ $obj forall -array a {
+ lappend keys [makekey a $myKeyfield]
+ }
+ $obj destroy
+
+ return $keys
+ }
+
+ #
+ # search - construct and execute a SQL select statement using
+ # build_select_query style and return the result handle.
+ #
+ method search {args} {
+ set req [eval build_select_query $args]
+ return [exec $req]
+ }
+
+ #
+ # count - return a count of the specified (or current) table.
+ #
+ method count {args} {
+
+ # table_check returns an error if either a keyfield or a table were
not set.
+ # In order to count the rows in a table we don't need a keyfield, so
we check
+ # if table_check is returning missing_table and in case we rethrow the
error,
+ # otherwise we continue
+
+ if {[catch {table_check $args} e]} {
+ if {$e != "missing_keyfield"} {
+ return -code error -errorcode $e "error in table_check ($e)"
+ }
+ }
+
+ return [string "select count(*) from $myTable"]
+ }
+
+ method makeDBFieldValue {table_name field_name val} {
+ return "'[quote $val]'"
+ }
+
+ method registerSpecialField {table_name field_name type} {
+ set specialFields(${table_name}@${field_name}) $type
+ }
+
+ ##
+ ## These are methods which should be defined by each individual database
+ ## interface class.
+ ##
+ method open {args} {}
+ method close {args} {}
+ method exec {args} {}
+ method nextkey {args} {}
+ method lastkey {args} {}
+ method now {} {}
+ method last_inserted_rec {} {}
+ ##
+ ## Functions to get and set public variables.
+ ##
+ method interface {{string ""}} { return [configure_variable interface
$string] }
+ method errorinfo {{string ""}} { return [configure_variable errorinfo
$string] }
+ method db {{string ""}} { return [configure_variable db $string] }
+ method table {{string ""}} { return [configure_variable table $string] }
+ method keyfield {{string ""}} { return [configure_variable keyfield
$string] }
+ method autokey {{string ""}} { return [configure_variable autokey $string]
}
+ method sequence {{string ""}} { return [configure_variable sequence
$string] }
+ method user {{string ""}} { return [configure_variable user $string] }
+ method pass {{string ""}} { return [configure_variable pass $string] }
+ method host {{string ""}} { return [configure_variable host $string] }
+ method port {{string ""}} { return [configure_variable port $string] }
+
+ protected variable specialFields
+
+ public variable interface ""
+ public variable errorinfo ""
+
+ public variable db ""
+ public variable table ""
+ public variable sequence ""
+
+ public variable user ""
+ public variable pass ""
+ public variable host ""
+ public variable port ""
+
+ protected method handle_client_arguments {cargs} { }
+
+ public variable clientargs "" {
+ handle_client_arguments $clientargs
+ }
+
+ public variable keyfield "" {
+ if {[llength $keyfield] > 1 && $autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
+ }
+
+ public variable autokey 0 {
+ if {[llength $keyfield] > 1 && $autokey} {
+ return -code error "Cannot have autokey and multiple keyfields"
+ }
+ }
+
+} ; ## ::itcl::class Database
+
+#
+# DIO Result object
+#
+::itcl::class Result {
+ constructor {args} {
+ eval configure $args
+ }
+
+ destructor { }
+
+ method destroy {} {
+ ::itcl::delete object $this
+ }
+
+ #
+ # configure_variable - given a variable name and a string, if the
+ # string is empty return the variable name, otherwise set the
+ # variable to the string.
+ #
+ protected method configure_variable {varName string} {
+ if {[::rivet::lempty $string]} { return [cget -$varName] }
+ configure -$varName $string
+ }
+
+ #
+ # lassign_array - given a list, an array name, and a variable number
+ # of arguments consisting of variable names, assign each element in
+ # the list, in turn, to elements corresponding to the variable
+ # arguments, into the named array. From TclX.
+ #
+ protected method lassign_array {list arrayName args} {
+ upvar 1 $arrayName array
+ foreach elem $list field $args {
+ set array($field) $elem
+ }
+ }
+
+ #
+ # seek - set the current row ID (our internal row cursor, if you will)
+ # to the specified row ID
+ #
+ method seek {newrowid} {
+ set rowid $newrowid
+ }
+
+ method cache {{size "all"}} {
+ set cacheSize $size
+ if {$size == "all"} { set cacheSize $numrows }
+
+ ## Delete the previous cache array.
+ catch {unset cacheArray}
+
+ set autostatus $autocache
+ set currrow $rowid
+ set autocache 1
+ seek 0
+ set i 0
+ while {[next -list list]} {
+ if {[incr i] >= $cacheSize} { break }
+ }
+ set autocache $autostatus
+ seek $currrow
+ set cached 1
+ }
+
+ #
+ # forall -- walk the result object, executing the code body over it
+ #
+ method forall {type varName body} {
+ upvar 1 $varName $varName
+ set currrow $rowid
+ seek 0
+ while {[next $type $varName]} {
+ uplevel 1 $body
+ }
+ set rowid $currrow
+ return
+ }
+
+ method next {type {varName ""}} {
+ set return 1
+ if {![::rivet::lempty $varName]} {
+ upvar 1 $varName var
+ set return 0
+ }
+
+ catch {unset var}
+
+ set list ""
+ ## If we have a cached result for this row, use it.
+ if {[info exists cacheArray($rowid)]} {
+ set list $cacheArray($rowid)
+ } else {
+ set list [$this nextrow]
+ if {[::rivet::lempty $list]} {
+ if {$return} { return }
+ set var ""
+ return 0
+ }
+ if {$autocache} { set cacheArray($rowid) $list }
+ }
+
+ incr rowid
+
+ switch -- $type {
+ "-list" {
+ if {$return} {
+ return $list
+ } else {
+ set var $list
+ }
+ }
+ "-array" {
+ if {$return} {
+ foreach field $fields elem $list {
+ lappend var $field $elem
+ }
+ return $var
+ } else {
+ eval lassign_array [list $list] var $fields
+ }
+ }
+ "-keyvalue" {
+ foreach field $fields elem $list {
+ lappend var -$field $elem
+ }
+ if {$return} { return $var }
+ }
+ "-dict" {
+ foreach field $fields elem $list {
+ lappend var $field $elem
+ }
+ if {$return} { return [dict create {*}$var] }
+ }
+ default {
+ incr rowid -1
+ return -code error \
+ "In-valid type: must be -list, -array, -dict or -keyvalue"
+ }
+ }
+ return [expr [::rivet::lempty $list] == 0]
+ }
+
+ public method mkdict {key} {
+
+ set query_res_d [dict create]
+
+ # we check on the first row a value
+ # for the corresponding key exists
+
+ if {[$this next -dict d] > 0} {
+ if {[dict exists $d $key]} {
+
+ set keyvalue [dict get $d $key]
+ dict unset d $key
+
+ dict set query_res_d $keyvalue $d
+ } else {
+
+ return -code error \
+ "Value for key '$key' not existing in the query results"
+
+ }
+ }
+
+ # then we proceed with the remaining rows to
+ # be processed
+
+ while {[$this next -dict d]} {
+
+ set keyvalue [dict get $d $key]
+ dict unset d $key
+
+ dict set query_res_d $keyvalue $d
+ }
+
+ return $query_res_d
+ }
+
+
+ method resultid {{string ""}} { return [configure_variable resultid
$string] }
+ method fields {{string ""}} { return [configure_variable fields $string] }
+ method rowid {{string ""}} { return [configure_variable rowid $string] }
+ method numrows {{string ""}} { return [configure_variable numrows $string]
}
+ method error {{string ""}} { return [configure_variable error $string] }
+ method errorcode {{string ""}} { return [configure_variable errorcode
$string] }
+ method errorinfo {{string ""}} { return [configure_variable errorinfo
$string] }
+ method autocache {{string ""}} { return [configure_variable autocache
$string] }
+
+ public variable resultid ""
+ public variable fields ""
+ public variable rowid 0
+ public variable numrows 0
+ public variable error 0
+ public variable errorcode 0
+ public variable errorinfo ""
+ public variable autocache 1
+
+ protected variable cached 0
+ protected variable cacheSize 0
+ protected variable cacheArray
+
+} ; ## ::itcl::class Result
+
+} ; ## namespace eval DIO
+
+package provide DIO 1.1
diff --git a/rivet/packages/dio/dio_Mysql.tcl b/rivet/packages/dio/dio_Mysql.tcl
index 550a0f2..3805036 100644
--- a/rivet/packages/dio/dio_Mysql.tcl
+++ b/rivet/packages/dio/dio_Mysql.tcl
@@ -17,8 +17,8 @@
# specific language governing permissions and limitations
# under the License.
-package require DIO
-package provide dio_Mysql 0.4
+package require DIO 1.2
+package provide dio_Mysql 0.5
namespace eval DIO {
::itcl::class Mysql {
@@ -40,8 +40,6 @@ namespace eval DIO {
set db $user
}
- #$this set_field_formatter ::DIO::formatters::Mysql
-
}
destructor {
diff --git a/rivet/packages/dio/dio_Mysql.tcl
b/rivet/packages/dio/dio_Mysql04.tcl
similarity index 60%
copy from rivet/packages/dio/dio_Mysql.tcl
copy to rivet/packages/dio/dio_Mysql04.tcl
index 550a0f2..710faad 100644
--- a/rivet/packages/dio/dio_Mysql.tcl
+++ b/rivet/packages/dio/dio_Mysql04.tcl
@@ -17,14 +17,14 @@
# specific language governing permissions and limitations
# under the License.
-package require DIO
+package require -exact DIO 1.1
package provide dio_Mysql 0.4
namespace eval DIO {
::itcl::class Mysql {
inherit Database
- constructor {args} {eval configure -interface Mysql $args} {
+ constructor {args} {eval configure $args} {
if { [catch {package require Mysqltcl}] \
&& [catch {package require mysqltcl}] \
&& [catch {package require mysql}]} {
@@ -39,9 +39,6 @@ namespace eval DIO {
}
set db $user
}
-
- #$this set_field_formatter ::DIO::formatters::Mysql
-
}
destructor {
@@ -99,9 +96,9 @@ namespace eval DIO {
return $obj
}
if {[catch {mysqlcol $conn -current name} fields]} { set fields ""
}
- set obj [result Mysql -resultid $conn \
- -numrows [::list $error] \
- -fields [::list $fields]]
+ set obj [result Mysql -resultid $conn \
+ -numrows [::list $error] \
+ -fields [::list $fields]]
return $obj
}
@@ -128,13 +125,87 @@ 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 "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.
+ # 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)
+
+ 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
+
+ return [clock seconds]
+
+ } else {
+ return "UNIX_TIMESTAMP($field_name)"
+ }
+ }
+ 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,
+
+ #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]'"
+ }
+ }
+ default {
+ # no special code for that type!!
+ return "'[quote $val]'"
+ }
+ }
+
+ } else {
+ return "'[quote $val]'"
+ }
+
+ }
+
public variable db "" {
if {[info exists conn] && [mysqlping $conn]} {
mysqluse $conn $db
}
}
- protected method handle_client_arguments {cargs} {
+ protected method handle_client_arguments {cargs} {
# we assign only the accepted options
@@ -157,7 +228,7 @@ namespace eval DIO {
}
}
- #public variable interface "Mysql"
+ public variable interface "Mysql"
private variable conn
} ; ## ::itcl::class Mysql
diff --git a/rivet/packages/dio/dio_Oracle.tcl
b/rivet/packages/dio/dio_Oracle.tcl
index e3b2fef..0f36419 100644
--- a/rivet/packages/dio/dio_Oracle.tcl
+++ b/rivet/packages/dio/dio_Oracle.tcl
@@ -14,6 +14,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
+package require DIO 1.2
package provide dio_Oracle 0.3
namespace eval DIO {
@@ -33,8 +34,6 @@ namespace eval DIO {
}
set db $user
}
-
- #$this set_field_formatter ::DIO::formatters::Oracle
}
destructor {
diff --git a/rivet/packages/dio/dio_Oracle01.tcl
b/rivet/packages/dio/dio_Oracle01.tcl
new file mode 100644
index 0000000..db51355
--- /dev/null
+++ b/rivet/packages/dio/dio_Oracle01.tcl
@@ -0,0 +1,242 @@
+# dio_Mysql.tcl -- Mysql backend.
+
+# Copyright 2006 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.
+
+# $Id: dio_Oracle.tcl 265421 2004-10-29 20:17:54Z karl $
+
+package require -exact DIO 1.1
+package provide dio_Oracle 0.1
+
+namespace eval DIO {
+ ::itcl::class Oracle {
+ inherit Database
+
+ constructor {args} {eval configure $args} {
+ if {[catch {package require Oratcl}]} {
+ 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
+ }
+ }
+
+ destructor {
+ close
+ }
+
+ method open {} {
+ set command "::oralogon"
+
+ if {![::rivet::lempty $user]} { append command " $user" }
+ if {![::rivet::lempty $pass]} { append command "/$pass" }
+ if {![::rivet::lempty $host]} { append command "@$host" }
+ if {![::rivet::lempty $port]} { append command -port $port }
+
+ if {[catch $command error]} { return -code error $error }
+
+ set conn $error
+
+ if {![::rivet::lempty $db]} {
+ # ??? mysqluse $conn $db
+ }
+ }
+
+ method close {} {
+ if {![info exists conn]} { return }
+ catch {::oraclose $conn}
+ unset conn
+ }
+
+ method exec {req} {
+ if {![info exists conn]} { open }
+
+ set _cur [::oraopen $conn]
+ set cmd ::orasql
+ set is_select 0
+ if {[::string tolower [lindex $req 0]] == "select"} {
+ 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
+ }
+ 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 error [::oramsg $_cur rows]
+ set res_cmd "result"
+ lappend res_cmd $interface -resultid $_cur
+ lappend res_cmd -numrows [::list $error] -fields [::list $fields]
+ lappend res_cmd -fetch_first_row $is_select
+ set obj [eval $res_cmd]
+ if {!$is_select} {
+ ::oraclose $_cur
+ }
+ return $obj
+ }
+
+ method lastkey {} {
+ if {![info exists conn]} { return }
+ return [mysqlinsertid $conn]
+ }
+
+ method quote {string} {
+ regsub -all {'} $string {\'} string
+ return $string
+ }
+
+ method sql_limit_syntax {limit {offset ""}} {
+ # temporary
+ return ""
+ if {[::rivet::lempty $offset]} {
+ return " LIMIT $limit"
+ }
+ return " LIMIT [expr $offset - 1],$limit"
+ }
+
+ method handle {} {
+ if {![info exists conn]} { open }
+ 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]'"
+ }
+ }
+
+ public variable db "" {
+ if {[info exists conn]} {
+ mysqluse $conn $db
+ }
+ }
+
+ public variable interface "Oracle"
+ private variable conn
+ private variable _cur
+
+ } ; ## ::itcl::class Mysql
+
+ ::itcl::class OracleResult {
+ inherit Result
+
+ public variable fetch_first_row 0
+ private variable _data ""
+ private variable _have_first_row 0
+
+ constructor {args} {
+ eval configure $args
+ if {$fetch_first_row} {
+ if {[llength [nextrow]] == 0} {
+ set _have_first_row 0
+ numrows 0
+ } else {
+ set _have_first_row 1
+ numrows 1
+ }
+ }
+ set fetch_first_row 0
+ }
+
+ destructor {
+ if {[string length $resultid] > 0} {
+ catch {::oraclose $resultid}
+ }
+ }
+
+ method nextrow {} {
+ if {[string length $resultid] == 0} {
+ return [::list]
+ }
+ if {$_have_first_row} {
+ set _have_first_row 0
+ return $_data
+ }
+ set ret [::orafetch $resultid -datavariable _data]
+ switch $ret {
+ 0 {
+ return $_data
+ }
+ 1403 {
+ ::oraclose $resultid
+ set resultid ""
+ return [::list]
+ }
+ default {
+ # FIXME!! have to handle error here !!
+ return [::list]
+ }
+ }
+ }
+ } ; ## ::itcl::class OracleResult
+
+}
diff --git a/rivet/packages/dio/dio_Postgresql.tcl
b/rivet/packages/dio/dio_Postgresql.tcl
index 3233b90..1c71bb7 100644
--- a/rivet/packages/dio/dio_Postgresql.tcl
+++ b/rivet/packages/dio/dio_Postgresql.tcl
@@ -14,7 +14,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-package require DIO
+package require DIO 1.2
package provide dio_Postgresql 0.2
namespace eval DIO {
@@ -25,7 +25,6 @@ namespace eval DIO {
package require Pgtcl
set_conn_defaults
eval configure $args
- #$this set_field_formatter ::DIO::formatters::Postgresql
}
destructor {
diff --git a/rivet/packages/dio/dio_Postgresql.tcl
b/rivet/packages/dio/dio_Postgresql01.tcl
similarity index 66%
copy from rivet/packages/dio/dio_Postgresql.tcl
copy to rivet/packages/dio/dio_Postgresql01.tcl
index 3233b90..434a363 100644
--- a/rivet/packages/dio/dio_Postgresql.tcl
+++ b/rivet/packages/dio/dio_Postgresql01.tcl
@@ -14,18 +14,17 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-package require DIO
-package provide dio_Postgresql 0.2
+package require -exact DIO 1.1
+package provide dio_Postgresql 0.1
namespace eval DIO {
::itcl::class Postgresql {
inherit Database
- constructor {args} {eval configure -interface Postgresql $args} {
+ constructor {args} {eval configure $args} {
package require Pgtcl
set_conn_defaults
eval configure $args
- #$this set_field_formatter ::DIO::formatters::Postgresql
}
destructor {
@@ -102,56 +101,60 @@ namespace eval DIO {
return $conn
}
- 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]
+ 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)"
+ }
}
+ 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]
+ }
}
- default {
- # no special code for that type!!
+ } else {
return [pg_quote $val]
- }
}
}
@@ -164,7 +167,7 @@ namespace eval DIO {
}
}
- #public variable interface "Postgresql"
+ public variable interface "Postgresql"
private variable conn
} ; ## ::itcl::class Postgresql
diff --git a/rivet/packages/dio/dio_Sqlite.tcl
b/rivet/packages/dio/dio_Sqlite.tcl
index f875f96..e90b4ec 100644
--- a/rivet/packages/dio/dio_Sqlite.tcl
+++ b/rivet/packages/dio/dio_Sqlite.tcl
@@ -14,7 +14,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-package require DIO
+package require DIO 1.2
package provide dio_Sqlite 0.2
namespace eval DIO {
@@ -35,7 +35,6 @@ namespace eval DIO {
return -code error "No Sqlite Tcl package available"
}
eval configure $args
- #$this set_field_formatter ::DIO::formatters::Sqlite
}
destructor {
diff --git a/rivet/packages/dio/dio_Sqlite.tcl
b/rivet/packages/dio/dio_Sqlite01.tcl
similarity index 76%
copy from rivet/packages/dio/dio_Sqlite.tcl
copy to rivet/packages/dio/dio_Sqlite01.tcl
index f875f96..0783131 100644
--- a/rivet/packages/dio/dio_Sqlite.tcl
+++ b/rivet/packages/dio/dio_Sqlite01.tcl
@@ -14,8 +14,8 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-package require DIO
-package provide dio_Sqlite 0.2
+package require -exact DIO 1.1
+package provide dio_Sqlite 0.1
namespace eval DIO {
variable sqlite_seq -1
@@ -26,16 +26,15 @@ namespace eval DIO {
inherit Database
private variable dbcmd ""
- #public variable interface "Sqlite"
+ public variable interface "Sqlite"
- constructor {args} {eval configure -interface Sqlite $args} {
+ constructor {args} {eval configure $args} {
if {[catch {package require sqlite}] && \
[catch {package require sqlite3}]} {
return -code error "No Sqlite Tcl package available"
}
eval configure $args
- #$this set_field_formatter ::DIO::formatters::Sqlite
}
destructor {
@@ -105,9 +104,66 @@ namespace eval DIO {
# quote - given a string, return the same string with any single
# quote characters preceded by a backslash
#
- method quote {a_string} {
- regsub -all {'} $a_string {''} a_string
- return $a_string
+ method quote {string} {
+ regsub -all {'} $string {''} string
+ 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} {
+# set secs [clock seconds]
+# set my_val [clock format $secs -format
"%Y%m%d%H%M%S"]
+ return [clock seconds]
+ } else {
+
+ # the numbers of seconds must be returned
as 'utc' to
+ # be compared with values returned by
[clock seconds]
+
+ 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 {
+ # no special code for that type!!
+ return "'[quote $val]'"
+ }
+ }
+ } else {
+ return "'[quote $val]'"
+ }
}
}
diff --git a/rivet/packages/dio/dio_Tdbc.tcl b/rivet/packages/dio/dio_Tdbc.tcl
index 3736be0..dd082bf 100644
--- a/rivet/packages/dio/dio_Tdbc.tcl
+++ b/rivet/packages/dio/dio_Tdbc.tcl
@@ -15,8 +15,8 @@
# limitations under the License.
#
-package require DIO
package require tdbc
+package require DIO 1.2
package provide dio_Tdbc 0.2
namespace eval DIO {
diff --git a/rivet/packages/dio/pkgIndex.tcl b/rivet/packages/dio/pkgIndex.tcl
index e66fed1..283131c 100644
--- a/rivet/packages/dio/pkgIndex.tcl
+++ b/rivet/packages/dio/pkgIndex.tcl
@@ -8,11 +8,15 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-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.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]]
+package ifneeded DIO 1.1 [list source [file join $dir dio11.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::formatters 1.0 [list source [file join $dir
formatters.tcl]]
+package ifneeded dio_Mysql 0.4 [list source [file join $dir
dio_Mysql.tcl]]\n[list source [file join $dir dio_Mysql04.tcl]]
+package ifneeded dio_Oracle 0.1 [list source [file join $dir dio_Oracle01.tcl]]
+package ifneeded dio_Oracle 0.3 [list source [file join $dir dio_Oracle.tcl]]
+package ifneeded dio_Postgresql 0.1 [list source [file join $dir
dio_Postgresql01.tcl]]
+package ifneeded dio_Postgresql 0.2 [list source [file join $dir
dio_Postgresql.tcl]]
+package ifneeded dio_Sqlite 0.1 [list source [file join $dir dio_Sqlite01.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]]
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscr...@tcl.apache.org
For additional commands, e-mail: commits-h...@tcl.apache.org
