jpayne@69: # tdbc.tcl -- jpayne@69: # jpayne@69: # Definitions of base classes from which TDBC drivers' connections, jpayne@69: # statements and result sets may inherit. jpayne@69: # jpayne@69: # Copyright (c) 2008 by Kevin B. Kenny jpayne@69: # See the file "license.terms" for information on usage and redistribution jpayne@69: # of this file, and for a DISCLAIMER OF ALL WARRANTIES. jpayne@69: # jpayne@69: # RCS: @(#) $Id$ jpayne@69: # jpayne@69: #------------------------------------------------------------------------------ jpayne@69: jpayne@69: package require TclOO jpayne@69: jpayne@69: namespace eval ::tdbc { jpayne@69: namespace export connection statement resultset jpayne@69: variable generalError [list TDBC GENERAL_ERROR HY000 {}] jpayne@69: } jpayne@69: jpayne@69: #------------------------------------------------------------------------------ jpayne@69: # jpayne@69: # tdbc::ParseConvenienceArgs -- jpayne@69: # jpayne@69: # Parse the convenience arguments to a TDBC 'execute', jpayne@69: # 'executewithdictionary', or 'foreach' call. jpayne@69: # jpayne@69: # Parameters: jpayne@69: # argv - Arguments to the call jpayne@69: # optsVar -- Name of a variable in caller's scope that will receive jpayne@69: # a dictionary of the supplied options jpayne@69: # jpayne@69: # Results: jpayne@69: # Returns any args remaining after parsing the options. jpayne@69: # jpayne@69: # Side effects: jpayne@69: # Sets the 'opts' dictionary to the options. jpayne@69: # jpayne@69: #------------------------------------------------------------------------------ jpayne@69: jpayne@69: proc tdbc::ParseConvenienceArgs {argv optsVar} { jpayne@69: jpayne@69: variable generalError jpayne@69: upvar 1 $optsVar opts jpayne@69: jpayne@69: set opts [dict create -as dicts] jpayne@69: set i 0 jpayne@69: jpayne@69: # Munch keyword options off the front of the command arguments jpayne@69: jpayne@69: foreach {key value} $argv { jpayne@69: if {[string index $key 0] eq {-}} { jpayne@69: switch -regexp -- $key { jpayne@69: -as? { jpayne@69: if {$value ne {dicts} && $value ne {lists}} { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode badVarType $value jpayne@69: return -code error \ jpayne@69: -errorcode $errorcode \ jpayne@69: "bad variable type \"$value\":\ jpayne@69: must be lists or dicts" jpayne@69: } jpayne@69: dict set opts -as $value jpayne@69: } jpayne@69: -c(?:o(?:l(?:u(?:m(?:n(?:s(?:v(?:a(?:r(?:i(?:a(?:b(?:le?)?)?)?)?)?)?)?)?)?)?)?)?) { jpayne@69: dict set opts -columnsvariable $value jpayne@69: } jpayne@69: -- { jpayne@69: incr i jpayne@69: break jpayne@69: } jpayne@69: default { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode badOption $key jpayne@69: return -code error \ jpayne@69: -errorcode $errorcode \ jpayne@69: "bad option \"$key\":\ jpayne@69: must be -as or -columnsvariable" jpayne@69: } jpayne@69: } jpayne@69: } else { jpayne@69: break jpayne@69: } jpayne@69: incr i 2 jpayne@69: } jpayne@69: jpayne@69: return [lrange $argv[set argv {}] $i end] jpayne@69: jpayne@69: } jpayne@69: jpayne@69: jpayne@69: jpayne@69: #------------------------------------------------------------------------------ jpayne@69: # jpayne@69: # tdbc::connection -- jpayne@69: # jpayne@69: # Class that represents a generic connection to a database. jpayne@69: # jpayne@69: #----------------------------------------------------------------------------- jpayne@69: jpayne@69: oo::class create ::tdbc::connection { jpayne@69: jpayne@69: # statementSeq is the sequence number of the last statement created. jpayne@69: # statementClass is the name of the class that implements the jpayne@69: # 'statement' API. jpayne@69: # primaryKeysStatement is the statement that queries primary keys jpayne@69: # foreignKeysStatement is the statement that queries foreign keys jpayne@69: jpayne@69: variable statementSeq primaryKeysStatement foreignKeysStatement jpayne@69: jpayne@69: # The base class constructor accepts no arguments. It sets up the jpayne@69: # machinery to do the bookkeeping to keep track of what statements jpayne@69: # are associated with the connection. The derived class constructor jpayne@69: # is expected to set the variable, 'statementClass' to the name jpayne@69: # of the class that represents statements, so that the 'prepare' jpayne@69: # method can invoke it. jpayne@69: jpayne@69: constructor {} { jpayne@69: set statementSeq 0 jpayne@69: namespace eval Stmt {} jpayne@69: } jpayne@69: jpayne@69: # The 'close' method is simply an alternative syntax for destroying jpayne@69: # the connection. jpayne@69: jpayne@69: method close {} { jpayne@69: my destroy jpayne@69: } jpayne@69: jpayne@69: # The 'prepare' method creates a new statement against the connection, jpayne@69: # giving its constructor the current statement and the SQL code to jpayne@69: # prepare. It uses the 'statementClass' variable set by the constructor jpayne@69: # to get the class to instantiate. jpayne@69: jpayne@69: method prepare {sqlcode} { jpayne@69: return [my statementCreate Stmt::[incr statementSeq] [self] $sqlcode] jpayne@69: } jpayne@69: jpayne@69: # The 'statementCreate' method delegates to the constructor jpayne@69: # of the class specified by the 'statementClass' variable. It's jpayne@69: # intended for drivers designed before tdbc 1.0b10. Current ones jpayne@69: # should forward this method to the constructor directly. jpayne@69: jpayne@69: method statementCreate {name instance sqlcode} { jpayne@69: my variable statementClass jpayne@69: return [$statementClass create $name $instance $sqlcode] jpayne@69: } jpayne@69: jpayne@69: # Derived classes are expected to implement the 'prepareCall' method, jpayne@69: # and have it call 'prepare' as needed (or do something else and jpayne@69: # install the resulting statement) jpayne@69: jpayne@69: # The 'statements' method lists the statements active against this jpayne@69: # connection. jpayne@69: jpayne@69: method statements {} { jpayne@69: info commands Stmt::* jpayne@69: } jpayne@69: jpayne@69: # The 'resultsets' method lists the result sets active against this jpayne@69: # connection. jpayne@69: jpayne@69: method resultsets {} { jpayne@69: set retval {} jpayne@69: foreach statement [my statements] { jpayne@69: foreach resultset [$statement resultsets] { jpayne@69: lappend retval $resultset jpayne@69: } jpayne@69: } jpayne@69: return $retval jpayne@69: } jpayne@69: jpayne@69: # The 'transaction' method executes a block of Tcl code as an jpayne@69: # ACID transaction against the database. jpayne@69: jpayne@69: method transaction {script} { jpayne@69: my begintransaction jpayne@69: set status [catch {uplevel 1 $script} result options] jpayne@69: if {$status in {0 2 3 4}} { jpayne@69: set status2 [catch {my commit} result2 options2] jpayne@69: if {$status2 == 1} { jpayne@69: set status 1 jpayne@69: set result $result2 jpayne@69: set options $options2 jpayne@69: } jpayne@69: } jpayne@69: switch -exact -- $status { jpayne@69: 0 { jpayne@69: # do nothing jpayne@69: } jpayne@69: 2 - 3 - 4 { jpayne@69: set options [dict merge {-level 1} $options[set options {}]] jpayne@69: dict incr options -level jpayne@69: } jpayne@69: default { jpayne@69: my rollback jpayne@69: } jpayne@69: } jpayne@69: return -options $options $result jpayne@69: } jpayne@69: jpayne@69: # The 'allrows' method prepares a statement, then executes it with jpayne@69: # a given set of substituents, returning a list of all the rows jpayne@69: # that the statement returns. Optionally, it stores the names of jpayne@69: # the columns in '-columnsvariable'. jpayne@69: # Usage: jpayne@69: # $db allrows ?-as lists|dicts? ?-columnsvariable varName? ?--? jpayne@69: # sql ?dictionary? jpayne@69: jpayne@69: method allrows args { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: # Grab keyword-value parameters jpayne@69: jpayne@69: set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] jpayne@69: jpayne@69: # Check postitional parameters jpayne@69: jpayne@69: set cmd [list [self] prepare] jpayne@69: if {[llength $args] == 1} { jpayne@69: set sqlcode [lindex $args 0] jpayne@69: } elseif {[llength $args] == 2} { jpayne@69: lassign $args sqlcode dict jpayne@69: } else { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?... ?--? sqlcode ?dictionary?" jpayne@69: } jpayne@69: lappend cmd $sqlcode jpayne@69: jpayne@69: # Prepare the statement jpayne@69: jpayne@69: set stmt [uplevel 1 $cmd] jpayne@69: jpayne@69: # Delegate to the statement to accumulate the results jpayne@69: jpayne@69: set cmd [list $stmt allrows {*}$opts --] jpayne@69: if {[info exists dict]} { jpayne@69: lappend cmd $dict jpayne@69: } jpayne@69: set status [catch { jpayne@69: uplevel 1 $cmd jpayne@69: } result options] jpayne@69: jpayne@69: # Destroy the statement jpayne@69: jpayne@69: catch { jpayne@69: $stmt close jpayne@69: } jpayne@69: jpayne@69: return -options $options $result jpayne@69: } jpayne@69: jpayne@69: # The 'foreach' method prepares a statement, then executes it with jpayne@69: # a supplied set of substituents. For each row of the result, jpayne@69: # it sets a variable to the row and invokes a script in the caller's jpayne@69: # scope. jpayne@69: # jpayne@69: # Usage: jpayne@69: # $db foreach ?-as lists|dicts? ?-columnsVariable varName? ?--? jpayne@69: # varName sql ?dictionary? script jpayne@69: jpayne@69: method foreach args { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: # Grab keyword-value parameters jpayne@69: jpayne@69: set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] jpayne@69: jpayne@69: # Check postitional parameters jpayne@69: jpayne@69: set cmd [list [self] prepare] jpayne@69: if {[llength $args] == 3} { jpayne@69: lassign $args varname sqlcode script jpayne@69: } elseif {[llength $args] == 4} { jpayne@69: lassign $args varname sqlcode dict script jpayne@69: } else { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?... ?--? varname sqlcode ?dictionary? script" jpayne@69: } jpayne@69: lappend cmd $sqlcode jpayne@69: jpayne@69: # Prepare the statement jpayne@69: jpayne@69: set stmt [uplevel 1 $cmd] jpayne@69: jpayne@69: # Delegate to the statement to iterate over the results jpayne@69: jpayne@69: set cmd [list $stmt foreach {*}$opts -- $varname] jpayne@69: if {[info exists dict]} { jpayne@69: lappend cmd $dict jpayne@69: } jpayne@69: lappend cmd $script jpayne@69: set status [catch { jpayne@69: uplevel 1 $cmd jpayne@69: } result options] jpayne@69: jpayne@69: # Destroy the statement jpayne@69: jpayne@69: catch { jpayne@69: $stmt close jpayne@69: } jpayne@69: jpayne@69: # Adjust return level in the case that the script [return]s jpayne@69: jpayne@69: if {$status == 2} { jpayne@69: set options [dict merge {-level 1} $options[set options {}]] jpayne@69: dict incr options -level jpayne@69: } jpayne@69: return -options $options $result jpayne@69: } jpayne@69: jpayne@69: # The 'BuildPrimaryKeysStatement' method builds a SQL statement to jpayne@69: # retrieve the primary keys from a database. (It executes once the jpayne@69: # first time the 'primaryKeys' method is executed, and retains the jpayne@69: # prepared statement for reuse.) jpayne@69: jpayne@69: method BuildPrimaryKeysStatement {} { jpayne@69: jpayne@69: # On some databases, CONSTRAINT_CATALOG is always NULL and jpayne@69: # JOINing to it fails. Check for this case and include that jpayne@69: # JOIN only if catalog names are supplied. jpayne@69: jpayne@69: set catalogClause {} jpayne@69: if {[lindex [set count [my allrows -as lists { jpayne@69: SELECT COUNT(*) jpayne@69: FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS jpayne@69: WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} { jpayne@69: set catalogClause \ jpayne@69: {AND xtable.CONSTRAINT_CATALOG = xcolumn.CONSTRAINT_CATALOG} jpayne@69: } jpayne@69: set primaryKeysStatement [my prepare " jpayne@69: SELECT xtable.TABLE_SCHEMA AS \"tableSchema\", jpayne@69: xtable.TABLE_NAME AS \"tableName\", jpayne@69: xtable.CONSTRAINT_CATALOG AS \"constraintCatalog\", jpayne@69: xtable.CONSTRAINT_SCHEMA AS \"constraintSchema\", jpayne@69: xtable.CONSTRAINT_NAME AS \"constraintName\", jpayne@69: xcolumn.COLUMN_NAME AS \"columnName\", jpayne@69: xcolumn.ORDINAL_POSITION AS \"ordinalPosition\" jpayne@69: FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS xtable jpayne@69: INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE xcolumn jpayne@69: ON xtable.CONSTRAINT_SCHEMA = xcolumn.CONSTRAINT_SCHEMA jpayne@69: AND xtable.TABLE_NAME = xcolumn.TABLE_NAME jpayne@69: AND xtable.CONSTRAINT_NAME = xcolumn.CONSTRAINT_NAME jpayne@69: $catalogClause jpayne@69: WHERE xtable.TABLE_NAME = :tableName jpayne@69: AND xtable.CONSTRAINT_TYPE = 'PRIMARY KEY' jpayne@69: "] jpayne@69: } jpayne@69: jpayne@69: # The default implementation of the 'primarykeys' method uses the jpayne@69: # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases jpayne@69: # that might not have INFORMATION_SCHEMA must overload this method. jpayne@69: jpayne@69: method primarykeys {tableName} { jpayne@69: if {![info exists primaryKeysStatement]} { jpayne@69: my BuildPrimaryKeysStatement jpayne@69: } jpayne@69: tailcall $primaryKeysStatement allrows [list tableName $tableName] jpayne@69: } jpayne@69: jpayne@69: # The 'BuildForeignKeysStatements' method builds a SQL statement to jpayne@69: # retrieve the foreign keys from a database. (It executes once the jpayne@69: # first time the 'foreignKeys' method is executed, and retains the jpayne@69: # prepared statements for reuse.) jpayne@69: jpayne@69: method BuildForeignKeysStatement {} { jpayne@69: jpayne@69: # On some databases, CONSTRAINT_CATALOG is always NULL and jpayne@69: # JOINing to it fails. Check for this case and include that jpayne@69: # JOIN only if catalog names are supplied. jpayne@69: jpayne@69: set catalogClause1 {} jpayne@69: set catalogClause2 {} jpayne@69: if {[lindex [set count [my allrows -as lists { jpayne@69: SELECT COUNT(*) jpayne@69: FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS jpayne@69: WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} { jpayne@69: set catalogClause1 \ jpayne@69: {AND fkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG} jpayne@69: set catalogClause2 \ jpayne@69: {AND pkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG} jpayne@69: } jpayne@69: jpayne@69: foreach {exists1 clause1} { jpayne@69: 0 {} jpayne@69: 1 { AND pkc.TABLE_NAME = :primary} jpayne@69: } { jpayne@69: foreach {exists2 clause2} { jpayne@69: 0 {} jpayne@69: 1 { AND fkc.TABLE_NAME = :foreign} jpayne@69: } { jpayne@69: set stmt [my prepare " jpayne@69: SELECT rc.CONSTRAINT_CATALOG AS \"foreignConstraintCatalog\", jpayne@69: rc.CONSTRAINT_SCHEMA AS \"foreignConstraintSchema\", jpayne@69: rc.CONSTRAINT_NAME AS \"foreignConstraintName\", jpayne@69: rc.UNIQUE_CONSTRAINT_CATALOG jpayne@69: AS \"primaryConstraintCatalog\", jpayne@69: rc.UNIQUE_CONSTRAINT_SCHEMA AS \"primaryConstraintSchema\", jpayne@69: rc.UNIQUE_CONSTRAINT_NAME AS \"primaryConstraintName\", jpayne@69: rc.UPDATE_RULE AS \"updateAction\", jpayne@69: rc.DELETE_RULE AS \"deleteAction\", jpayne@69: pkc.TABLE_CATALOG AS \"primaryCatalog\", jpayne@69: pkc.TABLE_SCHEMA AS \"primarySchema\", jpayne@69: pkc.TABLE_NAME AS \"primaryTable\", jpayne@69: pkc.COLUMN_NAME AS \"primaryColumn\", jpayne@69: fkc.TABLE_CATALOG AS \"foreignCatalog\", jpayne@69: fkc.TABLE_SCHEMA AS \"foreignSchema\", jpayne@69: fkc.TABLE_NAME AS \"foreignTable\", jpayne@69: fkc.COLUMN_NAME AS \"foreignColumn\", jpayne@69: pkc.ORDINAL_POSITION AS \"ordinalPosition\" jpayne@69: FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc jpayne@69: INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE fkc jpayne@69: ON fkc.CONSTRAINT_NAME = rc.CONSTRAINT_NAME jpayne@69: AND fkc.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA jpayne@69: $catalogClause1 jpayne@69: INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE pkc jpayne@69: ON pkc.CONSTRAINT_NAME = rc.UNIQUE_CONSTRAINT_NAME jpayne@69: AND pkc.CONSTRAINT_SCHEMA = rc.UNIQUE_CONSTRAINT_SCHEMA jpayne@69: $catalogClause2 jpayne@69: AND pkc.ORDINAL_POSITION = fkc.ORDINAL_POSITION jpayne@69: WHERE 1=1 jpayne@69: $clause1 jpayne@69: $clause2 jpayne@69: ORDER BY \"foreignConstraintCatalog\", \"foreignConstraintSchema\", \"foreignConstraintName\", \"ordinalPosition\" jpayne@69: "] jpayne@69: dict set foreignKeysStatement $exists1 $exists2 $stmt jpayne@69: } jpayne@69: } jpayne@69: } jpayne@69: jpayne@69: # The default implementation of the 'foreignkeys' method uses the jpayne@69: # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases jpayne@69: # that might not have INFORMATION_SCHEMA must overload this method. jpayne@69: jpayne@69: method foreignkeys {args} { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: # Check arguments jpayne@69: jpayne@69: set argdict {} jpayne@69: if {[llength $args] % 2 != 0} { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?..." jpayne@69: } jpayne@69: foreach {key value} $args { jpayne@69: if {$key ni {-primary -foreign}} { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode badOption jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "bad option \"$key\", must be -primary or -foreign" jpayne@69: } jpayne@69: set key [string range $key 1 end] jpayne@69: if {[dict exists $argdict $key]} { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode dupOption jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "duplicate option \"$key\" supplied" jpayne@69: } jpayne@69: dict set argdict $key $value jpayne@69: } jpayne@69: jpayne@69: # Build the statements that query foreign keys. There are four jpayne@69: # of them, one for each combination of whether -primary jpayne@69: # and -foreign is specified. jpayne@69: jpayne@69: if {![info exists foreignKeysStatement]} { jpayne@69: my BuildForeignKeysStatement jpayne@69: } jpayne@69: set stmt [dict get $foreignKeysStatement \ jpayne@69: [dict exists $argdict primary] \ jpayne@69: [dict exists $argdict foreign]] jpayne@69: tailcall $stmt allrows $argdict jpayne@69: } jpayne@69: jpayne@69: # Derived classes are expected to implement the 'begintransaction', jpayne@69: # 'commit', and 'rollback' methods. jpayne@69: jpayne@69: # Derived classes are expected to implement 'tables' and 'columns' method. jpayne@69: jpayne@69: } jpayne@69: jpayne@69: #------------------------------------------------------------------------------ jpayne@69: # jpayne@69: # Class: tdbc::statement jpayne@69: # jpayne@69: # Class that represents a SQL statement in a generic database jpayne@69: # jpayne@69: #------------------------------------------------------------------------------ jpayne@69: jpayne@69: oo::class create tdbc::statement { jpayne@69: jpayne@69: # resultSetSeq is the sequence number of the last result set created. jpayne@69: # resultSetClass is the name of the class that implements the 'resultset' jpayne@69: # API. jpayne@69: jpayne@69: variable resultSetClass resultSetSeq jpayne@69: jpayne@69: # The base class constructor accepts no arguments. It initializes jpayne@69: # the machinery for tracking the ownership of result sets. The derived jpayne@69: # constructor is expected to invoke the base constructor, and to jpayne@69: # set a variable 'resultSetClass' to the fully-qualified name of the jpayne@69: # class that represents result sets. jpayne@69: jpayne@69: constructor {} { jpayne@69: set resultSetSeq 0 jpayne@69: namespace eval ResultSet {} jpayne@69: } jpayne@69: jpayne@69: # The 'execute' method on a statement runs the statement with jpayne@69: # a particular set of substituted variables. It actually works jpayne@69: # by creating the result set object and letting that objects jpayne@69: # constructor do the work of running the statement. The creation jpayne@69: # is wrapped in an [uplevel] call because the substitution proces jpayne@69: # may need to access variables in the caller's scope. jpayne@69: jpayne@69: # WORKAROUND: Take out the '0 &&' from the next line when jpayne@69: # Bug 2649975 is fixed jpayne@69: if {0 && [package vsatisfies [package provide Tcl] 8.6]} { jpayne@69: method execute args { jpayne@69: tailcall my resultSetCreate \ jpayne@69: [namespace current]::ResultSet::[incr resultSetSeq] \ jpayne@69: [self] {*}$args jpayne@69: } jpayne@69: } else { jpayne@69: method execute args { jpayne@69: return \ jpayne@69: [uplevel 1 \ jpayne@69: [list \ jpayne@69: [self] resultSetCreate \ jpayne@69: [namespace current]::ResultSet::[incr resultSetSeq] \ jpayne@69: [self] {*}$args]] jpayne@69: } jpayne@69: } jpayne@69: jpayne@69: # The 'ResultSetCreate' method is expected to be a forward to the jpayne@69: # appropriate result set constructor. If it's missing, the driver must jpayne@69: # have been designed for tdbc 1.0b9 and earlier, and the 'resultSetClass' jpayne@69: # variable holds the class name. jpayne@69: jpayne@69: method resultSetCreate {name instance args} { jpayne@69: return [uplevel 1 [list $resultSetClass create \ jpayne@69: $name $instance {*}$args]] jpayne@69: } jpayne@69: jpayne@69: # The 'resultsets' method returns a list of result sets produced by jpayne@69: # the current statement jpayne@69: jpayne@69: method resultsets {} { jpayne@69: info commands ResultSet::* jpayne@69: } jpayne@69: jpayne@69: # The 'allrows' method executes a statement with a given set of jpayne@69: # substituents, and returns a list of all the rows that the statement jpayne@69: # returns. Optionally, it stores the names of columns in jpayne@69: # '-columnsvariable'. jpayne@69: # jpayne@69: # Usage: jpayne@69: # $statement allrows ?-as lists|dicts? ?-columnsvariable varName? ?--? jpayne@69: # ?dictionary? jpayne@69: jpayne@69: jpayne@69: method allrows args { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: # Grab keyword-value parameters jpayne@69: jpayne@69: set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] jpayne@69: jpayne@69: # Check postitional parameters jpayne@69: jpayne@69: set cmd [list [self] execute] jpayne@69: if {[llength $args] == 0} { jpayne@69: # do nothing jpayne@69: } elseif {[llength $args] == 1} { jpayne@69: lappend cmd [lindex $args 0] jpayne@69: } else { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?... ?--? ?dictionary?" jpayne@69: } jpayne@69: jpayne@69: # Get the result set jpayne@69: jpayne@69: set resultSet [uplevel 1 $cmd] jpayne@69: jpayne@69: # Delegate to the result set's [allrows] method to accumulate jpayne@69: # the rows of the result. jpayne@69: jpayne@69: set cmd [list $resultSet allrows {*}$opts] jpayne@69: set status [catch { jpayne@69: uplevel 1 $cmd jpayne@69: } result options] jpayne@69: jpayne@69: # Destroy the result set jpayne@69: jpayne@69: catch { jpayne@69: rename $resultSet {} jpayne@69: } jpayne@69: jpayne@69: # Adjust return level in the case that the script [return]s jpayne@69: jpayne@69: if {$status == 2} { jpayne@69: set options [dict merge {-level 1} $options[set options {}]] jpayne@69: dict incr options -level jpayne@69: } jpayne@69: return -options $options $result jpayne@69: } jpayne@69: jpayne@69: # The 'foreach' method executes a statement with a given set of jpayne@69: # substituents. It runs the supplied script, substituting the supplied jpayne@69: # named variable. Optionally, it stores the names of columns in jpayne@69: # '-columnsvariable'. jpayne@69: # jpayne@69: # Usage: jpayne@69: # $statement foreach ?-as lists|dicts? ?-columnsvariable varName? ?--? jpayne@69: # variableName ?dictionary? script jpayne@69: jpayne@69: method foreach args { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: # Grab keyword-value parameters jpayne@69: jpayne@69: set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] jpayne@69: jpayne@69: # Check positional parameters jpayne@69: jpayne@69: set cmd [list [self] execute] jpayne@69: if {[llength $args] == 2} { jpayne@69: lassign $args varname script jpayne@69: } elseif {[llength $args] == 3} { jpayne@69: lassign $args varname dict script jpayne@69: lappend cmd $dict jpayne@69: } else { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?... ?--? varName ?dictionary? script" jpayne@69: } jpayne@69: jpayne@69: # Get the result set jpayne@69: jpayne@69: set resultSet [uplevel 1 $cmd] jpayne@69: jpayne@69: # Delegate to the result set's [foreach] method to evaluate jpayne@69: # the script for each row of the result. jpayne@69: jpayne@69: set cmd [list $resultSet foreach {*}$opts -- $varname $script] jpayne@69: set status [catch { jpayne@69: uplevel 1 $cmd jpayne@69: } result options] jpayne@69: jpayne@69: # Destroy the result set jpayne@69: jpayne@69: catch { jpayne@69: rename $resultSet {} jpayne@69: } jpayne@69: jpayne@69: # Adjust return level in the case that the script [return]s jpayne@69: jpayne@69: if {$status == 2} { jpayne@69: set options [dict merge {-level 1} $options[set options {}]] jpayne@69: dict incr options -level jpayne@69: } jpayne@69: return -options $options $result jpayne@69: } jpayne@69: jpayne@69: # The 'close' method is syntactic sugar for invoking the destructor jpayne@69: jpayne@69: method close {} { jpayne@69: my destroy jpayne@69: } jpayne@69: jpayne@69: # Derived classes are expected to implement their own constructors, jpayne@69: # plus the following methods: jpayne@69: jpayne@69: # paramtype paramName ?direction? type ?scale ?precision?? jpayne@69: # Declares the type of a parameter in the statement jpayne@69: jpayne@69: } jpayne@69: jpayne@69: #------------------------------------------------------------------------------ jpayne@69: # jpayne@69: # Class: tdbc::resultset jpayne@69: # jpayne@69: # Class that represents a result set in a generic database. jpayne@69: # jpayne@69: #------------------------------------------------------------------------------ jpayne@69: jpayne@69: oo::class create tdbc::resultset { jpayne@69: jpayne@69: constructor {} { } jpayne@69: jpayne@69: # The 'allrows' method returns a list of all rows that a given jpayne@69: # result set returns. jpayne@69: jpayne@69: method allrows args { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: # Parse args jpayne@69: jpayne@69: set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] jpayne@69: if {[llength $args] != 0} { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?... ?--? varName script" jpayne@69: } jpayne@69: jpayne@69: # Do -columnsvariable if requested jpayne@69: jpayne@69: if {[dict exists $opts -columnsvariable]} { jpayne@69: upvar 1 [dict get $opts -columnsvariable] columns jpayne@69: } jpayne@69: jpayne@69: # Assemble the results jpayne@69: jpayne@69: if {[dict get $opts -as] eq {lists}} { jpayne@69: set delegate nextlist jpayne@69: } else { jpayne@69: set delegate nextdict jpayne@69: } jpayne@69: set results [list] jpayne@69: while {1} { jpayne@69: set columns [my columns] jpayne@69: while {[my $delegate row]} { jpayne@69: lappend results $row jpayne@69: } jpayne@69: if {![my nextresults]} break jpayne@69: } jpayne@69: return $results jpayne@69: jpayne@69: } jpayne@69: jpayne@69: # The 'foreach' method runs a script on each row from a result set. jpayne@69: jpayne@69: method foreach args { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: # Grab keyword-value parameters jpayne@69: jpayne@69: set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts] jpayne@69: jpayne@69: # Check positional parameters jpayne@69: jpayne@69: if {[llength $args] != 2} { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?... ?--? varName script" jpayne@69: } jpayne@69: jpayne@69: # Do -columnsvariable if requested jpayne@69: jpayne@69: if {[dict exists $opts -columnsvariable]} { jpayne@69: upvar 1 [dict get $opts -columnsvariable] columns jpayne@69: } jpayne@69: jpayne@69: # Iterate over the groups of results jpayne@69: while {1} { jpayne@69: jpayne@69: # Export column names to caller jpayne@69: jpayne@69: set columns [my columns] jpayne@69: jpayne@69: # Iterate over the rows of one group of results jpayne@69: jpayne@69: upvar 1 [lindex $args 0] row jpayne@69: if {[dict get $opts -as] eq {lists}} { jpayne@69: set delegate nextlist jpayne@69: } else { jpayne@69: set delegate nextdict jpayne@69: } jpayne@69: while {[my $delegate row]} { jpayne@69: set status [catch { jpayne@69: uplevel 1 [lindex $args 1] jpayne@69: } result options] jpayne@69: switch -exact -- $status { jpayne@69: 0 - 4 { # OK or CONTINUE jpayne@69: } jpayne@69: 2 { # RETURN jpayne@69: set options \ jpayne@69: [dict merge {-level 1} $options[set options {}]] jpayne@69: dict incr options -level jpayne@69: return -options $options $result jpayne@69: } jpayne@69: 3 { # BREAK jpayne@69: set broken 1 jpayne@69: break jpayne@69: } jpayne@69: default { # ERROR or unknown status jpayne@69: return -options $options $result jpayne@69: } jpayne@69: } jpayne@69: } jpayne@69: jpayne@69: # Advance to the next group of results if there is one jpayne@69: jpayne@69: if {[info exists broken] || ![my nextresults]} { jpayne@69: break jpayne@69: } jpayne@69: } jpayne@69: jpayne@69: return jpayne@69: } jpayne@69: jpayne@69: jpayne@69: # The 'nextrow' method retrieves a row in the form of either jpayne@69: # a list or a dictionary. jpayne@69: jpayne@69: method nextrow {args} { jpayne@69: jpayne@69: variable ::tdbc::generalError jpayne@69: jpayne@69: set opts [dict create -as dicts] jpayne@69: set i 0 jpayne@69: jpayne@69: # Munch keyword options off the front of the command arguments jpayne@69: jpayne@69: foreach {key value} $args { jpayne@69: if {[string index $key 0] eq {-}} { jpayne@69: switch -regexp -- $key { jpayne@69: -as? { jpayne@69: dict set opts -as $value jpayne@69: } jpayne@69: -- { jpayne@69: incr i jpayne@69: break jpayne@69: } jpayne@69: default { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode badOption $key jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "bad option \"$key\":\ jpayne@69: must be -as or -columnsvariable" jpayne@69: } jpayne@69: } jpayne@69: } else { jpayne@69: break jpayne@69: } jpayne@69: incr i 2 jpayne@69: } jpayne@69: jpayne@69: set args [lrange $args $i end] jpayne@69: if {[llength $args] != 1} { jpayne@69: set errorcode $generalError jpayne@69: lappend errorcode wrongNumArgs jpayne@69: return -code error -errorcode $errorcode \ jpayne@69: "wrong # args: should be [lrange [info level 0] 0 1]\ jpayne@69: ?-option value?... ?--? varName" jpayne@69: } jpayne@69: upvar 1 [lindex $args 0] row jpayne@69: if {[dict get $opts -as] eq {lists}} { jpayne@69: set delegate nextlist jpayne@69: } else { jpayne@69: set delegate nextdict jpayne@69: } jpayne@69: return [my $delegate row] jpayne@69: } jpayne@69: jpayne@69: # Derived classes must override 'nextresults' if a single jpayne@69: # statement execution can yield multiple sets of results jpayne@69: jpayne@69: method nextresults {} { jpayne@69: return 0 jpayne@69: } jpayne@69: jpayne@69: # Derived classes must override 'outputparams' if statements can jpayne@69: # have output parameters. jpayne@69: jpayne@69: method outputparams {} { jpayne@69: return {} jpayne@69: } jpayne@69: jpayne@69: # The 'close' method is syntactic sugar for destroying the result set. jpayne@69: jpayne@69: method close {} { jpayne@69: my destroy jpayne@69: } jpayne@69: jpayne@69: # Derived classes are expected to implement the following methods: jpayne@69: jpayne@69: # constructor and destructor. jpayne@69: # Constructor accepts a statement and an optional jpayne@69: # a dictionary of substituted parameters and jpayne@69: # executes the statement against the database. If jpayne@69: # the dictionary is not supplied, then the default jpayne@69: # is to get params from variables in the caller's scope). jpayne@69: # columns jpayne@69: # -- Returns a list of the names of the columns in the result. jpayne@69: # nextdict variableName jpayne@69: # -- Stores the next row of the result set in the given variable jpayne@69: # in caller's scope, in the form of a dictionary that maps jpayne@69: # column names to values. jpayne@69: # nextlist variableName jpayne@69: # -- Stores the next row of the result set in the given variable jpayne@69: # in caller's scope, in the form of a list of cells. jpayne@69: # rowcount jpayne@69: # -- Returns a count of rows affected by the statement, or -1 jpayne@69: # if the count of rows has not been determined. jpayne@69: jpayne@69: }