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