diff options
Diffstat (limited to 'Master/tlpkg/tltcl/lib/tdbc1.1.2')
| -rw-r--r-- | Master/tlpkg/tltcl/lib/tdbc1.1.2/libtdbcstub112.a | bin | 1690 -> 0 bytes | |||
| -rw-r--r-- | Master/tlpkg/tltcl/lib/tdbc1.1.2/pkgIndex.tcl | 18 | ||||
| -rw-r--r-- | Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc.tcl | 922 | ||||
| -rwxr-xr-x | Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc112.dll | bin | 18446 -> 0 bytes | |||
| -rw-r--r-- | Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbcConfig.sh | 81 |
5 files changed, 0 insertions, 1021 deletions
diff --git a/Master/tlpkg/tltcl/lib/tdbc1.1.2/libtdbcstub112.a b/Master/tlpkg/tltcl/lib/tdbc1.1.2/libtdbcstub112.a Binary files differdeleted file mode 100644 index 33182696816..00000000000 --- a/Master/tlpkg/tltcl/lib/tdbc1.1.2/libtdbcstub112.a +++ /dev/null diff --git a/Master/tlpkg/tltcl/lib/tdbc1.1.2/pkgIndex.tcl b/Master/tlpkg/tltcl/lib/tdbc1.1.2/pkgIndex.tcl deleted file mode 100644 index 6b0204ae868..00000000000 --- a/Master/tlpkg/tltcl/lib/tdbc1.1.2/pkgIndex.tcl +++ /dev/null @@ -1,18 +0,0 @@ -# Index file to load the TDBC package. - -# Make sure that TDBC is running in a compatible version of Tcl, and -# that TclOO is available. - -if {[catch {package present Tcl 8.5-}]} { - return -} -apply {{dir} { - set libraryfile [file join $dir tdbc.tcl] - if {![file exists $libraryfile] && [info exists ::env(TDBC_LIBRARY)]} { - set libraryfile [file join $::env(TDBC_LIBRARY) tdbc.tcl] - } - package ifneeded tdbc 1.1.2 \ - "package require TclOO 1.0-;\ - [list load [file join $dir tdbc112.dll] tdbc]\;\ - [list source $libraryfile]" -}} $dir diff --git a/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc.tcl b/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc.tcl deleted file mode 100644 index 2a167cbefe4..00000000000 --- a/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc.tcl +++ /dev/null @@ -1,922 +0,0 @@ -# tdbc.tcl -- -# -# Definitions of base classes from which TDBC drivers' connections, -# statements and result sets may inherit. -# -# Copyright (c) 2008 by Kevin B. Kenny -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id$ -# -#------------------------------------------------------------------------------ - -package require TclOO - -namespace eval ::tdbc { - namespace export connection statement resultset - variable generalError [list TDBC GENERAL_ERROR HY000 {}] -} - -#------------------------------------------------------------------------------ -# -# tdbc::ParseConvenienceArgs -- -# -# Parse the convenience arguments to a TDBC 'execute', -# 'executewithdictionary', or 'foreach' call. -# -# Parameters: -# argv - Arguments to the call -# optsVar -- Name of a variable in caller's scope that will receive -# a dictionary of the supplied options -# -# Results: -# Returns any args remaining after parsing the options. -# -# Side effects: -# Sets the 'opts' dictionary to the options. -# -#------------------------------------------------------------------------------ - -proc tdbc::ParseConvenienceArgs {argv optsVar} { - - variable generalError - upvar 1 $optsVar opts - - set opts [dict create -as dicts] - set i 0 - - # Munch keyword options off the front of the command arguments - - foreach {key value} $argv { - if {[string index $key 0] eq {-}} { - switch -regexp -- $key { - -as? { - if {$value ne {dicts} && $value ne {lists}} { - set errorcode $generalError - lappend errorcode badVarType $value - return -code error \ - -errorcode $errorcode \ - "bad variable type \"$value\":\ - must be lists or dicts" - } - dict set opts -as $value - } - -c(?:o(?:l(?:u(?:m(?:n(?:s(?:v(?:a(?:r(?:i(?:a(?:b(?:le?)?)?)?)?)?)?)?)?)?)?)?)?) { - dict set opts -columnsvariable $value - } - -- { - incr i - break - } - default { - set errorcode $generalError - lappend errorcode badOption $key - return -code error \ - -errorcode $errorcode \ - "bad option \"$key\":\ - must be -as or -columnsvariable" - } - } - } else { - break - } - incr i 2 - } - - return [lrange $argv[set argv {}] $i end] - -} - - - -#------------------------------------------------------------------------------ -# -# tdbc::connection -- -# -# Class that represents a generic connection to a database. -# -#----------------------------------------------------------------------------- - -oo::class create ::tdbc::connection { - - # statementSeq is the sequence number of the last statement created. - # statementClass is the name of the class that implements the - # 'statement' API. - # primaryKeysStatement is the statement that queries primary keys - # foreignKeysStatement is the statement that queries foreign keys - - variable statementSeq primaryKeysStatement foreignKeysStatement - - # The base class constructor accepts no arguments. It sets up the - # machinery to do the bookkeeping to keep track of what statements - # are associated with the connection. The derived class constructor - # is expected to set the variable, 'statementClass' to the name - # of the class that represents statements, so that the 'prepare' - # method can invoke it. - - constructor {} { - set statementSeq 0 - namespace eval Stmt {} - } - - # The 'close' method is simply an alternative syntax for destroying - # the connection. - - method close {} { - my destroy - } - - # The 'prepare' method creates a new statement against the connection, - # giving its constructor the current statement and the SQL code to - # prepare. It uses the 'statementClass' variable set by the constructor - # to get the class to instantiate. - - method prepare {sqlcode} { - return [my statementCreate Stmt::[incr statementSeq] [self] $sqlcode] - } - - # The 'statementCreate' method delegates to the constructor - # of the class specified by the 'statementClass' variable. It's - # intended for drivers designed before tdbc 1.0b10. Current ones - # should forward this method to the constructor directly. - - method statementCreate {name instance sqlcode} { - my variable statementClass - return [$statementClass create $name $instance $sqlcode] - } - - # Derived classes are expected to implement the 'prepareCall' method, - # and have it call 'prepare' as needed (or do something else and - # install the resulting statement) - - # The 'statements' method lists the statements active against this - # connection. - - method statements {} { - info commands Stmt::* - } - - # The 'resultsets' method lists the result sets active against this - # connection. - - method resultsets {} { - set retval {} - foreach statement [my statements] { - foreach resultset [$statement resultsets] { - lappend retval $resultset - } - } - return $retval - } - - # The 'transaction' method executes a block of Tcl code as an - # ACID transaction against the database. - - method transaction {script} { - my begintransaction - set status [catch {uplevel 1 $script} result options] - if {$status in {0 2 3 4}} { - set status2 [catch {my commit} result2 options2] - if {$status2 == 1} { - set status 1 - set result $result2 - set options $options2 - } - } - switch -exact -- $status { - 0 { - # do nothing - } - 2 - 3 - 4 { - set options [dict merge {-level 1} $options[set options {}]] - dict incr options -level - } - default { - my rollback - } - } - return -options $options $result - } - - # The 'allrows' method prepares a statement, then executes it with - # a given set of substituents, returning a list of all the rows - # that the statement returns. Optionally, it stores the names of - # the columns in '-columnsvariable'. - # Usage: - # $db allrows ?-as lists|dicts? ?-columnsvariable varName? ?--? - # sql ?dictionary? - - method allrows args { - - variable ::tdbc::generalError - - # Grab keyword-value parameters - - set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] - - # Check postitional parameters - - set cmd [list [self] prepare] - if {[llength $args] == 1} { - set sqlcode [lindex $args 0] - } elseif {[llength $args] == 2} { - lassign $args sqlcode dict - } else { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?... ?--? sqlcode ?dictionary?" - } - lappend cmd $sqlcode - - # Prepare the statement - - set stmt [uplevel 1 $cmd] - - # Delegate to the statement to accumulate the results - - set cmd [list $stmt allrows {*}$opts --] - if {[info exists dict]} { - lappend cmd $dict - } - set status [catch { - uplevel 1 $cmd - } result options] - - # Destroy the statement - - catch { - $stmt close - } - - return -options $options $result - } - - # The 'foreach' method prepares a statement, then executes it with - # a supplied set of substituents. For each row of the result, - # it sets a variable to the row and invokes a script in the caller's - # scope. - # - # Usage: - # $db foreach ?-as lists|dicts? ?-columnsVariable varName? ?--? - # varName sql ?dictionary? script - - method foreach args { - - variable ::tdbc::generalError - - # Grab keyword-value parameters - - set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] - - # Check postitional parameters - - set cmd [list [self] prepare] - if {[llength $args] == 3} { - lassign $args varname sqlcode script - } elseif {[llength $args] == 4} { - lassign $args varname sqlcode dict script - } else { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?... ?--? varname sqlcode ?dictionary? script" - } - lappend cmd $sqlcode - - # Prepare the statement - - set stmt [uplevel 1 $cmd] - - # Delegate to the statement to iterate over the results - - set cmd [list $stmt foreach {*}$opts -- $varname] - if {[info exists dict]} { - lappend cmd $dict - } - lappend cmd $script - set status [catch { - uplevel 1 $cmd - } result options] - - # Destroy the statement - - catch { - $stmt close - } - - # Adjust return level in the case that the script [return]s - - if {$status == 2} { - set options [dict merge {-level 1} $options[set options {}]] - dict incr options -level - } - return -options $options $result - } - - # The 'BuildPrimaryKeysStatement' method builds a SQL statement to - # retrieve the primary keys from a database. (It executes once the - # first time the 'primaryKeys' method is executed, and retains the - # prepared statement for reuse.) - - method BuildPrimaryKeysStatement {} { - - # On some databases, CONSTRAINT_CATALOG is always NULL and - # JOINing to it fails. Check for this case and include that - # JOIN only if catalog names are supplied. - - set catalogClause {} - if {[lindex [set count [my allrows -as lists { - SELECT COUNT(*) - FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS - WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} { - set catalogClause \ - {AND xtable.CONSTRAINT_CATALOG = xcolumn.CONSTRAINT_CATALOG} - } - set primaryKeysStatement [my prepare " - SELECT xtable.TABLE_SCHEMA AS \"tableSchema\", - xtable.TABLE_NAME AS \"tableName\", - xtable.CONSTRAINT_CATALOG AS \"constraintCatalog\", - xtable.CONSTRAINT_SCHEMA AS \"constraintSchema\", - xtable.CONSTRAINT_NAME AS \"constraintName\", - xcolumn.COLUMN_NAME AS \"columnName\", - xcolumn.ORDINAL_POSITION AS \"ordinalPosition\" - FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS xtable - INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE xcolumn - ON xtable.CONSTRAINT_SCHEMA = xcolumn.CONSTRAINT_SCHEMA - AND xtable.TABLE_NAME = xcolumn.TABLE_NAME - AND xtable.CONSTRAINT_NAME = xcolumn.CONSTRAINT_NAME - $catalogClause - WHERE xtable.TABLE_NAME = :tableName - AND xtable.CONSTRAINT_TYPE = 'PRIMARY KEY' - "] - } - - # The default implementation of the 'primarykeys' method uses the - # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases - # that might not have INFORMATION_SCHEMA must overload this method. - - method primarykeys {tableName} { - if {![info exists primaryKeysStatement]} { - my BuildPrimaryKeysStatement - } - tailcall $primaryKeysStatement allrows [list tableName $tableName] - } - - # The 'BuildForeignKeysStatements' method builds a SQL statement to - # retrieve the foreign keys from a database. (It executes once the - # first time the 'foreignKeys' method is executed, and retains the - # prepared statements for reuse.) - - method BuildForeignKeysStatement {} { - - # On some databases, CONSTRAINT_CATALOG is always NULL and - # JOINing to it fails. Check for this case and include that - # JOIN only if catalog names are supplied. - - set catalogClause1 {} - set catalogClause2 {} - if {[lindex [set count [my allrows -as lists { - SELECT COUNT(*) - FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS - WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} { - set catalogClause1 \ - {AND fkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG} - set catalogClause2 \ - {AND pkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG} - } - - foreach {exists1 clause1} { - 0 {} - 1 { AND pkc.TABLE_NAME = :primary} - } { - foreach {exists2 clause2} { - 0 {} - 1 { AND fkc.TABLE_NAME = :foreign} - } { - set stmt [my prepare " - SELECT rc.CONSTRAINT_CATALOG AS \"foreignConstraintCatalog\", - rc.CONSTRAINT_SCHEMA AS \"foreignConstraintSchema\", - rc.CONSTRAINT_NAME AS \"foreignConstraintName\", - rc.UNIQUE_CONSTRAINT_CATALOG - AS \"primaryConstraintCatalog\", - rc.UNIQUE_CONSTRAINT_SCHEMA AS \"primaryConstraintSchema\", - rc.UNIQUE_CONSTRAINT_NAME AS \"primaryConstraintName\", - rc.UPDATE_RULE AS \"updateAction\", - rc.DELETE_RULE AS \"deleteAction\", - pkc.TABLE_CATALOG AS \"primaryCatalog\", - pkc.TABLE_SCHEMA AS \"primarySchema\", - pkc.TABLE_NAME AS \"primaryTable\", - pkc.COLUMN_NAME AS \"primaryColumn\", - fkc.TABLE_CATALOG AS \"foreignCatalog\", - fkc.TABLE_SCHEMA AS \"foreignSchema\", - fkc.TABLE_NAME AS \"foreignTable\", - fkc.COLUMN_NAME AS \"foreignColumn\", - pkc.ORDINAL_POSITION AS \"ordinalPosition\" - FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc - INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE fkc - ON fkc.CONSTRAINT_NAME = rc.CONSTRAINT_NAME - AND fkc.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA - $catalogClause1 - INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE pkc - ON pkc.CONSTRAINT_NAME = rc.UNIQUE_CONSTRAINT_NAME - AND pkc.CONSTRAINT_SCHEMA = rc.UNIQUE_CONSTRAINT_SCHEMA - $catalogClause2 - AND pkc.ORDINAL_POSITION = fkc.ORDINAL_POSITION - WHERE 1=1 - $clause1 - $clause2 - ORDER BY \"foreignConstraintCatalog\", \"foreignConstraintSchema\", \"foreignConstraintName\", \"ordinalPosition\" -"] - dict set foreignKeysStatement $exists1 $exists2 $stmt - } - } - } - - # The default implementation of the 'foreignkeys' method uses the - # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases - # that might not have INFORMATION_SCHEMA must overload this method. - - method foreignkeys {args} { - - variable ::tdbc::generalError - - # Check arguments - - set argdict {} - if {[llength $args] % 2 != 0} { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?..." - } - foreach {key value} $args { - if {$key ni {-primary -foreign}} { - set errorcode $generalError - lappend errorcode badOption - return -code error -errorcode $errorcode \ - "bad option \"$key\", must be -primary or -foreign" - } - set key [string range $key 1 end] - if {[dict exists $argdict $key]} { - set errorcode $generalError - lappend errorcode dupOption - return -code error -errorcode $errorcode \ - "duplicate option \"$key\" supplied" - } - dict set argdict $key $value - } - - # Build the statements that query foreign keys. There are four - # of them, one for each combination of whether -primary - # and -foreign is specified. - - if {![info exists foreignKeysStatement]} { - my BuildForeignKeysStatement - } - set stmt [dict get $foreignKeysStatement \ - [dict exists $argdict primary] \ - [dict exists $argdict foreign]] - tailcall $stmt allrows $argdict - } - - # Derived classes are expected to implement the 'begintransaction', - # 'commit', and 'rollback' methods. - - # Derived classes are expected to implement 'tables' and 'columns' method. - -} - -#------------------------------------------------------------------------------ -# -# Class: tdbc::statement -# -# Class that represents a SQL statement in a generic database -# -#------------------------------------------------------------------------------ - -oo::class create tdbc::statement { - - # resultSetSeq is the sequence number of the last result set created. - # resultSetClass is the name of the class that implements the 'resultset' - # API. - - variable resultSetClass resultSetSeq - - # The base class constructor accepts no arguments. It initializes - # the machinery for tracking the ownership of result sets. The derived - # constructor is expected to invoke the base constructor, and to - # set a variable 'resultSetClass' to the fully-qualified name of the - # class that represents result sets. - - constructor {} { - set resultSetSeq 0 - namespace eval ResultSet {} - } - - # The 'execute' method on a statement runs the statement with - # a particular set of substituted variables. It actually works - # by creating the result set object and letting that objects - # constructor do the work of running the statement. The creation - # is wrapped in an [uplevel] call because the substitution proces - # may need to access variables in the caller's scope. - - # WORKAROUND: Take out the '0 &&' from the next line when - # Bug 2649975 is fixed - if {0 && [package vsatisfies [package provide Tcl] 8.6]} { - method execute args { - tailcall my resultSetCreate \ - [namespace current]::ResultSet::[incr resultSetSeq] \ - [self] {*}$args - } - } else { - method execute args { - return \ - [uplevel 1 \ - [list \ - [self] resultSetCreate \ - [namespace current]::ResultSet::[incr resultSetSeq] \ - [self] {*}$args]] - } - } - - # The 'ResultSetCreate' method is expected to be a forward to the - # appropriate result set constructor. If it's missing, the driver must - # have been designed for tdbc 1.0b9 and earlier, and the 'resultSetClass' - # variable holds the class name. - - method resultSetCreate {name instance args} { - return [uplevel 1 [list $resultSetClass create \ - $name $instance {*}$args]] - } - - # The 'resultsets' method returns a list of result sets produced by - # the current statement - - method resultsets {} { - info commands ResultSet::* - } - - # The 'allrows' method executes a statement with a given set of - # substituents, and returns a list of all the rows that the statement - # returns. Optionally, it stores the names of columns in - # '-columnsvariable'. - # - # Usage: - # $statement allrows ?-as lists|dicts? ?-columnsvariable varName? ?--? - # ?dictionary? - - - method allrows args { - - variable ::tdbc::generalError - - # Grab keyword-value parameters - - set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] - - # Check postitional parameters - - set cmd [list [self] execute] - if {[llength $args] == 0} { - # do nothing - } elseif {[llength $args] == 1} { - lappend cmd [lindex $args 0] - } else { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?... ?--? ?dictionary?" - } - - # Get the result set - - set resultSet [uplevel 1 $cmd] - - # Delegate to the result set's [allrows] method to accumulate - # the rows of the result. - - set cmd [list $resultSet allrows {*}$opts] - set status [catch { - uplevel 1 $cmd - } result options] - - # Destroy the result set - - catch { - rename $resultSet {} - } - - # Adjust return level in the case that the script [return]s - - if {$status == 2} { - set options [dict merge {-level 1} $options[set options {}]] - dict incr options -level - } - return -options $options $result - } - - # The 'foreach' method executes a statement with a given set of - # substituents. It runs the supplied script, substituting the supplied - # named variable. Optionally, it stores the names of columns in - # '-columnsvariable'. - # - # Usage: - # $statement foreach ?-as lists|dicts? ?-columnsvariable varName? ?--? - # variableName ?dictionary? script - - method foreach args { - - variable ::tdbc::generalError - - # Grab keyword-value parameters - - set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] - - # Check positional parameters - - set cmd [list [self] execute] - if {[llength $args] == 2} { - lassign $args varname script - } elseif {[llength $args] == 3} { - lassign $args varname dict script - lappend cmd $dict - } else { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?... ?--? varName ?dictionary? script" - } - - # Get the result set - - set resultSet [uplevel 1 $cmd] - - # Delegate to the result set's [foreach] method to evaluate - # the script for each row of the result. - - set cmd [list $resultSet foreach {*}$opts -- $varname $script] - set status [catch { - uplevel 1 $cmd - } result options] - - # Destroy the result set - - catch { - rename $resultSet {} - } - - # Adjust return level in the case that the script [return]s - - if {$status == 2} { - set options [dict merge {-level 1} $options[set options {}]] - dict incr options -level - } - return -options $options $result - } - - # The 'close' method is syntactic sugar for invoking the destructor - - method close {} { - my destroy - } - - # Derived classes are expected to implement their own constructors, - # plus the following methods: - - # paramtype paramName ?direction? type ?scale ?precision?? - # Declares the type of a parameter in the statement - -} - -#------------------------------------------------------------------------------ -# -# Class: tdbc::resultset -# -# Class that represents a result set in a generic database. -# -#------------------------------------------------------------------------------ - -oo::class create tdbc::resultset { - - constructor {} { } - - # The 'allrows' method returns a list of all rows that a given - # result set returns. - - method allrows args { - - variable ::tdbc::generalError - - # Parse args - - set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] - if {[llength $args] != 0} { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?... ?--? varName script" - } - - # Do -columnsvariable if requested - - if {[dict exists $opts -columnsvariable]} { - upvar 1 [dict get $opts -columnsvariable] columns - } - - # Assemble the results - - if {[dict get $opts -as] eq {lists}} { - set delegate nextlist - } else { - set delegate nextdict - } - set results [list] - while {1} { - set columns [my columns] - while {[my $delegate row]} { - lappend results $row - } - if {![my nextresults]} break - } - return $results - - } - - # The 'foreach' method runs a script on each row from a result set. - - method foreach args { - - variable ::tdbc::generalError - - # Grab keyword-value parameters - - set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] - - # Check positional parameters - - if {[llength $args] != 2} { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?... ?--? varName script" - } - - # Do -columnsvariable if requested - - if {[dict exists $opts -columnsvariable]} { - upvar 1 [dict get $opts -columnsvariable] columns - } - - # Iterate over the groups of results - while {1} { - - # Export column names to caller - - set columns [my columns] - - # Iterate over the rows of one group of results - - upvar 1 [lindex $args 0] row - if {[dict get $opts -as] eq {lists}} { - set delegate nextlist - } else { - set delegate nextdict - } - while {[my $delegate row]} { - set status [catch { - uplevel 1 [lindex $args 1] - } result options] - switch -exact -- $status { - 0 - 4 { # OK or CONTINUE - } - 2 { # RETURN - set options \ - [dict merge {-level 1} $options[set options {}]] - dict incr options -level - return -options $options $result - } - 3 { # BREAK - set broken 1 - break - } - default { # ERROR or unknown status - return -options $options $result - } - } - } - - # Advance to the next group of results if there is one - - if {[info exists broken] || ![my nextresults]} { - break - } - } - - return - } - - - # The 'nextrow' method retrieves a row in the form of either - # a list or a dictionary. - - method nextrow {args} { - - variable ::tdbc::generalError - - set opts [dict create -as dicts] - set i 0 - - # Munch keyword options off the front of the command arguments - - foreach {key value} $args { - if {[string index $key 0] eq {-}} { - switch -regexp -- $key { - -as? { - dict set opts -as $value - } - -- { - incr i - break - } - default { - set errorcode $generalError - lappend errorcode badOption $key - return -code error -errorcode $errorcode \ - "bad option \"$key\":\ - must be -as or -columnsvariable" - } - } - } else { - break - } - incr i 2 - } - - set args [lrange $args $i end] - if {[llength $args] != 1} { - set errorcode $generalError - lappend errorcode wrongNumArgs - return -code error -errorcode $errorcode \ - "wrong # args: should be [lrange [info level 0] 0 1]\ - ?-option value?... ?--? varName" - } - upvar 1 [lindex $args 0] row - if {[dict get $opts -as] eq {lists}} { - set delegate nextlist - } else { - set delegate nextdict - } - return [my $delegate row] - } - - # Derived classes must override 'nextresults' if a single - # statement execution can yield multiple sets of results - - method nextresults {} { - return 0 - } - - # Derived classes must override 'outputparams' if statements can - # have output parameters. - - method outputparams {} { - return {} - } - - # The 'close' method is syntactic sugar for destroying the result set. - - method close {} { - my destroy - } - - # Derived classes are expected to implement the following methods: - - # constructor and destructor. - # Constructor accepts a statement and an optional - # a dictionary of substituted parameters and - # executes the statement against the database. If - # the dictionary is not supplied, then the default - # is to get params from variables in the caller's scope). - # columns - # -- Returns a list of the names of the columns in the result. - # nextdict variableName - # -- Stores the next row of the result set in the given variable - # in caller's scope, in the form of a dictionary that maps - # column names to values. - # nextlist variableName - # -- Stores the next row of the result set in the given variable - # in caller's scope, in the form of a list of cells. - # rowcount - # -- Returns a count of rows affected by the statement, or -1 - # if the count of rows has not been determined. - -}
\ No newline at end of file diff --git a/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc112.dll b/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc112.dll Binary files differdeleted file mode 100755 index c2ec9eacf21..00000000000 --- a/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbc112.dll +++ /dev/null diff --git a/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbcConfig.sh b/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbcConfig.sh deleted file mode 100644 index 86e50015c54..00000000000 --- a/Master/tlpkg/tltcl/lib/tdbc1.1.2/tdbcConfig.sh +++ /dev/null @@ -1,81 +0,0 @@ -# tdbcConfig.sh -- -# -# This shell script (for sh) is generated automatically by TDBC's configure -# script. It will create shell variables for most of the configuration options -# discovered by the configure script. This script is intended to be included -# by the configure scripts for TDBC extensions so that they don't have to -# figure this all out for themselves. -# -# The information in this file is specific to a single platform. -# -# RCS: @(#) $Id$ - -# TDBC's version number -tdbc_VERSION=1.1.2 -TDBC_VERSION=1.1.2 - -# Name of the TDBC library - may be either a static or shared library -tdbc_LIB_FILE=tdbc112.dll -TDBC_LIB_FILE=tdbc112.dll - -# String to pass to the linker to pick up the TDBC library from its build dir -tdbc_BUILD_LIB_SPEC="-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/tdbc1.1.2 -ltdbc112" -TDBC_BUILD_LIB_SPEC="-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/tdbc1.1.2 -ltdbc112" - -# String to pass to the linker to pick up the TDBC library from its installed -# dir. -tdbc_LIB_SPEC="-L/home/siepo/tltcl/lib/tdbc1.1.2 -ltdbc112" -TDBC_LIB_SPEC="-L/home/siepo/tltcl/lib/tdbc1.1.2 -ltdbc112" - -# Name of the TBDC stub library -tdbc_STUB_LIB_FILE="libtdbcstub112.a" -TDBC_STUB_LIB_FILE="libtdbcstub112.a" - -# String to pass to the linker to pick up the TDBC stub library from its -# build directory -tdbc_BUILD_STUB_LIB_SPEC="-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/tdbc1.1.2 -ltdbcstub112" -TDBC_BUILD_STUB_LIB_SPEC="-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/tdbc1.1.2 -ltdbcstub112" - -# String to pass to the linker to pick up the TDBC stub library from its -# installed directory -tdbc_STUB_LIB_SPEC="-L/home/siepo/tltcl/lib/tdbc1.1.2 -ltdbcstub112" -TDBC_STUB_LIB_SPEC="-L/home/siepo/tltcl/lib/tdbc1.1.2 -ltdbcstub112" - -# Path name of the TDBC stub library in its build directory -tdbc_BUILD_STUB_LIB_PATH="/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/tdbc1.1.2/libtdbcstub112.a" -TDBC_BUILD_STUB_LIB_PATH="/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/tdbc1.1.2/libtdbcstub112.a" - -# Path name of the TDBC stub library in its installed directory -tdbc_STUB_LIB_PATH="/home/siepo/tltcl/lib/tdbc1.1.2/libtdbcstub112.a" -TDBC_STUB_LIB_PATH="/home/siepo/tltcl/lib/tdbc1.1.2/libtdbcstub112.a" - -# Location of the top-level source directories from which TDBC was built. -# This is the directory that contains doc/, generic/ and so on. If TDBC -# was compiled in a directory other than the source directory, this still -# points to the location of the sources, not the location where TDBC was -# compiled. -tdbc_SRC_DIR="/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/tdbc1.1.2" -TDBC_SRC_DIR="/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/tdbc1.1.2" - -# String to pass to the compiler so that an extension can find installed TDBC -# headers -tdbc_INCLUDE_SPEC="-I/home/siepo/tltcl/include" -TDBC_INCLUDE_SPEC="-I/home/siepo/tltcl/include" - -# String to pass to the compiler so that an extension can find TDBC headers -# in the source directory -tdbc_BUILD_INCLUDE_SPEC="-I/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/tdbc1.1.2/generic" -TDBC_BUILD_INCLUDE_SPEC="-I/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/tdbc1.1.2/generic" - -# Path name where .tcl files in the tdbc package appear at run time. -tdbc_LIBRARY_PATH="/home/siepo/tltcl/lib/tdbc1.1.2" -TDBC_LIBRARY_PATH="/home/siepo/tltcl/lib/tdbc1.1.2" - -# Path name where .tcl files in the tdbc package appear at build time. -tdbc_BUILD_LIBRARY_PATH="/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/tdbc1.1.2/library" -TDBC_BUILD_LIBRARY_PATH="/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/tdbc1.1.2/library" - -# Additional flags that must be passed to the C compiler to use tdbc -tdbc_CFLAGS= -TDBC_CFLAGS= - |