1# tdbc.tcl --
2#
3#	Definitions of base classes from which TDBC drivers' connections,
4#	statements and result sets may inherit.
5#
6# Copyright (c) 2008 by Kevin B. Kenny
7# See the file "license.terms" for information on usage and redistribution
8# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9#
10# RCS: @(#) $Id$
11#
12#------------------------------------------------------------------------------
13
14package require TclOO
15
16namespace eval ::tdbc {
17    namespace export connection statement resultset
18    variable generalError [list TDBC GENERAL_ERROR HY000 {}]
19}
20
21#------------------------------------------------------------------------------
22#
23# tdbc::ParseConvenienceArgs --
24#
25#	Parse the convenience arguments to a TDBC 'execute',
26#	'executewithdictionary', or 'foreach' call.
27#
28# Parameters:
29#	argv - Arguments to the call
30#	optsVar -- Name of a variable in caller's scope that will receive
31#		   a dictionary of the supplied options
32#
33# Results:
34#	Returns any args remaining after parsing the options.
35#
36# Side effects:
37#	Sets the 'opts' dictionary to the options.
38#
39#------------------------------------------------------------------------------
40
41proc tdbc::ParseConvenienceArgs {argv optsVar} {
42
43    variable generalError
44    upvar 1 $optsVar opts
45
46    set opts [dict create -as dicts]
47    set i 0
48
49    # Munch keyword options off the front of the command arguments
50
51    foreach {key value} $argv {
52	if {[string index $key 0] eq {-}} {
53	    switch -regexp -- $key {
54		-as? {
55		    if {$value ne {dicts} && $value ne {lists}} {
56			set errorcode $generalError
57			lappend errorcode badVarType $value
58			return -code error \
59			    -errorcode $errorcode \
60			    "bad variable type \"$value\":\
61                             must be lists or dicts"
62		    }
63		    dict set opts -as $value
64		}
65		-c(?:o(?:l(?:u(?:m(?:n(?:s(?:v(?:a(?:r(?:i(?:a(?:b(?:le?)?)?)?)?)?)?)?)?)?)?)?)?) {
66		    dict set opts -columnsvariable $value
67		}
68		-- {
69		    incr i
70		    break
71		}
72		default {
73		    set errorcode $generalError
74		    lappend errorcode badOption $key
75		    return -code error \
76			-errorcode $errorcode \
77			"bad option \"$key\":\
78                             must be -as or -columnsvariable"
79		}
80	    }
81	} else {
82	    break
83	}
84	incr i 2
85    }
86
87    return [lrange $argv[set argv {}] $i end]
88
89}
90
91
92
93#------------------------------------------------------------------------------
94#
95# tdbc::connection --
96#
97#	Class that represents a generic connection to a database.
98#
99#-----------------------------------------------------------------------------
100
101oo::class create ::tdbc::connection {
102
103    # statementSeq is the sequence number of the last statement created.
104    # statementClass is the name of the class that implements the
105    #	'statement' API.
106    # primaryKeysStatement is the statement that queries primary keys
107    # foreignKeysStatement is the statement that queries foreign keys
108
109    variable statementSeq primaryKeysStatement foreignKeysStatement
110
111    # The base class constructor accepts no arguments.  It sets up the
112    # machinery to do the bookkeeping to keep track of what statements
113    # are associated with the connection.  The derived class constructor
114    # is expected to set the variable, 'statementClass' to the name
115    # of the class that represents statements, so that the 'prepare'
116    # method can invoke it.
117
118    constructor {} {
119	set statementSeq 0
120	namespace eval Stmt {}
121    }
122
123    # The 'close' method is simply an alternative syntax for destroying
124    # the connection.
125
126    method close {} {
127	my destroy
128    }
129
130    # The 'prepare' method creates a new statement against the connection,
131    # giving its constructor the current statement and the SQL code to
132    # prepare.  It uses the 'statementClass' variable set by the constructor
133    # to get the class to instantiate.
134
135    method prepare {sqlcode} {
136	return [my statementCreate Stmt::[incr statementSeq] [self] $sqlcode]
137    }
138
139    # The 'statementCreate' method delegates to the constructor
140    # of the class specified by the 'statementClass' variable. It's
141    # intended for drivers designed before tdbc 1.0b10. Current ones
142    # should forward this method to the constructor directly.
143
144    method statementCreate {name instance sqlcode} {
145	my variable statementClass
146	return [$statementClass create $name $instance $sqlcode]
147    }
148
149    # Derived classes are expected to implement the 'prepareCall' method,
150    # and have it call 'prepare' as needed (or do something else and
151    # install the resulting statement)
152
153    # The 'statements' method lists the statements active against this
154    # connection.
155
156    method statements {} {
157	info commands Stmt::*
158    }
159
160    # The 'resultsets' method lists the result sets active against this
161    # connection.
162
163    method resultsets {} {
164	set retval {}
165	foreach statement [my statements] {
166	    foreach resultset [$statement resultsets] {
167		lappend retval $resultset
168	    }
169	}
170	return $retval
171    }
172
173    # The 'transaction' method executes a block of Tcl code as an
174    # ACID transaction against the database.
175
176    method transaction {script} {
177	my begintransaction
178	set status [catch {uplevel 1 $script} result options]
179	if {$status in {0 2 3 4}} {
180	    set status2 [catch {my commit} result2 options2]
181	    if {$status2 == 1} {
182		set status 1
183		set result $result2
184		set options $options2
185	    }
186	}
187	switch -exact -- $status {
188	    0 {
189		# do nothing
190	    }
191	    2 - 3 - 4 {
192		set options [dict merge {-level 1} $options[set options {}]]
193		dict incr options -level
194	    }
195	    default {
196		my rollback
197	    }
198	}
199	return -options $options $result
200    }
201
202    # The 'allrows' method prepares a statement, then executes it with
203    # a given set of substituents, returning a list of all the rows
204    # that the statement returns. Optionally, it stores the names of
205    # the columns in '-columnsvariable'.
206    # Usage:
207    #     $db allrows ?-as lists|dicts? ?-columnsvariable varName? ?--?
208    #	      sql ?dictionary?
209
210    method allrows args {
211
212	variable ::tdbc::generalError
213
214	# Grab keyword-value parameters
215
216	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
217
218	# Check postitional parameters
219
220	set cmd [list [self] prepare]
221	if {[llength $args] == 1} {
222	    set sqlcode [lindex $args 0]
223	} elseif {[llength $args] == 2} {
224	    lassign $args sqlcode dict
225	} else {
226	    set errorcode $generalError
227	    lappend errorcode wrongNumArgs
228	    return -code error -errorcode $errorcode \
229		"wrong # args: should be [lrange [info level 0] 0 1]\
230                 ?-option value?... ?--? sqlcode ?dictionary?"
231	}
232	lappend cmd $sqlcode
233
234	# Prepare the statement
235
236	set stmt [uplevel 1 $cmd]
237
238	# Delegate to the statement to accumulate the results
239
240	set cmd [list $stmt allrows {*}$opts --]
241	if {[info exists dict]} {
242	    lappend cmd $dict
243	}
244	set status [catch {
245	    uplevel 1 $cmd
246	} result options]
247
248	# Destroy the statement
249
250	catch {
251	    $stmt close
252	}
253
254	return -options $options $result
255    }
256
257    # The 'foreach' method prepares a statement, then executes it with
258    # a supplied set of substituents.  For each row of the result,
259    # it sets a variable to the row and invokes a script in the caller's
260    # scope.
261    #
262    # Usage:
263    #     $db foreach ?-as lists|dicts? ?-columnsVariable varName? ?--?
264    #         varName sql ?dictionary? script
265
266    method foreach args {
267
268	variable ::tdbc::generalError
269
270	# Grab keyword-value parameters
271
272	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
273
274	# Check postitional parameters
275
276	set cmd [list [self] prepare]
277	if {[llength $args] == 3} {
278	    lassign $args varname sqlcode script
279	} elseif {[llength $args] == 4} {
280	    lassign $args varname sqlcode dict script
281	} else {
282	    set errorcode $generalError
283	    lappend errorcode wrongNumArgs
284	    return -code error -errorcode $errorcode \
285		"wrong # args: should be [lrange [info level 0] 0 1]\
286                 ?-option value?... ?--? varname sqlcode ?dictionary? script"
287	}
288	lappend cmd $sqlcode
289
290	# Prepare the statement
291
292	set stmt [uplevel 1 $cmd]
293
294	# Delegate to the statement to iterate over the results
295
296	set cmd [list $stmt foreach {*}$opts -- $varname]
297	if {[info exists dict]} {
298	    lappend cmd $dict
299	}
300	lappend cmd $script
301	set status [catch {
302	    uplevel 1 $cmd
303	} result options]
304
305	# Destroy the statement
306
307	catch {
308	    $stmt close
309	}
310
311	# Adjust return level in the case that the script [return]s
312
313	if {$status == 2} {
314	    set options [dict merge {-level 1} $options[set options {}]]
315	    dict incr options -level
316	}
317	return -options $options $result
318    }
319
320    # The 'BuildPrimaryKeysStatement' method builds a SQL statement to
321    # retrieve the primary keys from a database. (It executes once the
322    # first time the 'primaryKeys' method is executed, and retains the
323    # prepared statement for reuse.)
324
325    method BuildPrimaryKeysStatement {} {
326
327	# On some databases, CONSTRAINT_CATALOG is always NULL and
328	# JOINing to it fails. Check for this case and include that
329	# JOIN only if catalog names are supplied.
330
331	set catalogClause {}
332	if {[lindex [set count [my allrows -as lists {
333	    SELECT COUNT(*)
334            FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS
335            WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} {
336	    set catalogClause \
337		{AND xtable.CONSTRAINT_CATALOG = xcolumn.CONSTRAINT_CATALOG}
338	}
339	set primaryKeysStatement [my prepare "
340	     SELECT xtable.TABLE_SCHEMA AS \"tableSchema\",
341                 xtable.TABLE_NAME AS \"tableName\",
342                 xtable.CONSTRAINT_CATALOG AS \"constraintCatalog\",
343                 xtable.CONSTRAINT_SCHEMA AS \"constraintSchema\",
344                 xtable.CONSTRAINT_NAME AS \"constraintName\",
345                 xcolumn.COLUMN_NAME AS \"columnName\",
346                 xcolumn.ORDINAL_POSITION AS \"ordinalPosition\"
347             FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS xtable
348             INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE xcolumn
349                     ON xtable.CONSTRAINT_SCHEMA = xcolumn.CONSTRAINT_SCHEMA
350                    AND xtable.TABLE_NAME = xcolumn.TABLE_NAME
351                    AND xtable.CONSTRAINT_NAME = xcolumn.CONSTRAINT_NAME
352	            $catalogClause
353             WHERE xtable.TABLE_NAME = :tableName
354               AND xtable.CONSTRAINT_TYPE = 'PRIMARY KEY'
355  	"]
356    }
357
358    # The default implementation of the 'primarykeys' method uses the
359    # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases
360    # that might not have INFORMATION_SCHEMA must overload this method.
361
362    method primarykeys {tableName} {
363	if {![info exists primaryKeysStatement]} {
364	    my BuildPrimaryKeysStatement
365	}
366	tailcall $primaryKeysStatement allrows [list tableName $tableName]
367    }
368
369    # The 'BuildForeignKeysStatements' method builds a SQL statement to
370    # retrieve the foreign keys from a database. (It executes once the
371    # first time the 'foreignKeys' method is executed, and retains the
372    # prepared statements for reuse.)
373
374    method BuildForeignKeysStatement {} {
375
376	# On some databases, CONSTRAINT_CATALOG is always NULL and
377	# JOINing to it fails. Check for this case and include that
378	# JOIN only if catalog names are supplied.
379
380	set catalogClause1 {}
381	set catalogClause2 {}
382	if {[lindex [set count [my allrows -as lists {
383	    SELECT COUNT(*)
384            FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS
385            WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} {
386	    set catalogClause1 \
387		{AND fkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG}
388	    set catalogClause2 \
389		{AND pkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG}
390	}
391
392	foreach {exists1 clause1} {
393	    0 {}
394	    1 { AND pkc.TABLE_NAME = :primary}
395	} {
396	    foreach {exists2 clause2} {
397		0 {}
398		1 { AND fkc.TABLE_NAME = :foreign}
399	    } {
400		set stmt [my prepare "
401	     SELECT rc.CONSTRAINT_CATALOG AS \"foreignConstraintCatalog\",
402                    rc.CONSTRAINT_SCHEMA AS \"foreignConstraintSchema\",
403                    rc.CONSTRAINT_NAME AS \"foreignConstraintName\",
404                    rc.UNIQUE_CONSTRAINT_CATALOG
405                        AS \"primaryConstraintCatalog\",
406                    rc.UNIQUE_CONSTRAINT_SCHEMA AS \"primaryConstraintSchema\",
407                    rc.UNIQUE_CONSTRAINT_NAME AS \"primaryConstraintName\",
408                    rc.UPDATE_RULE AS \"updateAction\",
409		    rc.DELETE_RULE AS \"deleteAction\",
410                    pkc.TABLE_CATALOG AS \"primaryCatalog\",
411                    pkc.TABLE_SCHEMA AS \"primarySchema\",
412                    pkc.TABLE_NAME AS \"primaryTable\",
413                    pkc.COLUMN_NAME AS \"primaryColumn\",
414                    fkc.TABLE_CATALOG AS \"foreignCatalog\",
415                    fkc.TABLE_SCHEMA AS \"foreignSchema\",
416                    fkc.TABLE_NAME AS \"foreignTable\",
417                    fkc.COLUMN_NAME AS \"foreignColumn\",
418                    pkc.ORDINAL_POSITION AS \"ordinalPosition\"
419             FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
420             INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE fkc
421                     ON fkc.CONSTRAINT_NAME = rc.CONSTRAINT_NAME
422                    AND fkc.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA
423                    $catalogClause1
424             INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE pkc
425                     ON pkc.CONSTRAINT_NAME = rc.UNIQUE_CONSTRAINT_NAME
426                     AND pkc.CONSTRAINT_SCHEMA = rc.UNIQUE_CONSTRAINT_SCHEMA
427                     $catalogClause2
428                     AND pkc.ORDINAL_POSITION = fkc.ORDINAL_POSITION
429             WHERE 1=1
430                 $clause1
431                 $clause2
432             ORDER BY \"foreignConstraintCatalog\", \"foreignConstraintSchema\", \"foreignConstraintName\", \"ordinalPosition\"
433"]
434		dict set foreignKeysStatement $exists1 $exists2 $stmt
435	    }
436	}
437    }
438
439    # The default implementation of the 'foreignkeys' method uses the
440    # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases
441    # that might not have INFORMATION_SCHEMA must overload this method.
442
443    method foreignkeys {args} {
444
445	variable ::tdbc::generalError
446
447	# Check arguments
448
449	set argdict {}
450	if {[llength $args] % 2 != 0} {
451	    set errorcode $generalError
452	    lappend errorcode wrongNumArgs
453	    return -code error -errorcode $errorcode \
454		"wrong # args: should be [lrange [info level 0] 0 1]\
455                 ?-option value?..."
456	}
457	foreach {key value} $args {
458	    if {$key ni {-primary -foreign}} {
459		set errorcode $generalError
460		lappend errorcode badOption
461		return -code error -errorcode $errorcode \
462		    "bad option \"$key\", must be -primary or -foreign"
463	    }
464	    set key [string range $key 1 end]
465	    if {[dict exists $argdict $key]} {
466		set errorcode $generalError
467		lappend errorcode dupOption
468		return -code error -errorcode $errorcode \
469		    "duplicate option \"$key\" supplied"
470	    }
471	    dict set argdict $key $value
472	}
473
474	# Build the statements that query foreign keys. There are four
475	# of them, one for each combination of whether -primary
476	# and -foreign is specified.
477
478	if {![info exists foreignKeysStatement]} {
479	    my BuildForeignKeysStatement
480	}
481	set stmt [dict get $foreignKeysStatement \
482		      [dict exists $argdict primary] \
483		      [dict exists $argdict foreign]]
484	tailcall $stmt allrows $argdict
485    }
486
487    # Derived classes are expected to implement the 'begintransaction',
488    # 'commit', and 'rollback' methods.
489
490    # Derived classes are expected to implement 'tables' and 'columns' method.
491
492}
493
494#------------------------------------------------------------------------------
495#
496# Class: tdbc::statement
497#
498#	Class that represents a SQL statement in a generic database
499#
500#------------------------------------------------------------------------------
501
502oo::class create tdbc::statement {
503
504    # resultSetSeq is the sequence number of the last result set created.
505    # resultSetClass is the name of the class that implements the 'resultset'
506    #	API.
507
508    variable resultSetClass resultSetSeq
509
510    # The base class constructor accepts no arguments.  It initializes
511    # the machinery for tracking the ownership of result sets. The derived
512    # constructor is expected to invoke the base constructor, and to
513    # set a variable 'resultSetClass' to the fully-qualified name of the
514    # class that represents result sets.
515
516    constructor {} {
517	set resultSetSeq 0
518	namespace eval ResultSet {}
519    }
520
521    # The 'execute' method on a statement runs the statement with
522    # a particular set of substituted variables.  It actually works
523    # by creating the result set object and letting that objects
524    # constructor do the work of running the statement.  The creation
525    # is wrapped in an [uplevel] call because the substitution proces
526    # may need to access variables in the caller's scope.
527
528    # WORKAROUND: Take out the '0 &&' from the next line when
529    # Bug 2649975 is fixed
530    if {0 && [package vsatisfies [package provide Tcl] 8.6]} {
531	method execute args {
532	    tailcall my resultSetCreate \
533		[namespace current]::ResultSet::[incr resultSetSeq]  \
534		[self] {*}$args
535	}
536    } else {
537	method execute args {
538	    return \
539		[uplevel 1 \
540		     [list \
541			  [self] resultSetCreate \
542			  [namespace current]::ResultSet::[incr resultSetSeq] \
543			  [self] {*}$args]]
544	}
545    }
546
547    # The 'ResultSetCreate' method is expected to be a forward to the
548    # appropriate result set constructor. If it's missing, the driver must
549    # have been designed for tdbc 1.0b9 and earlier, and the 'resultSetClass'
550    # variable holds the class name.
551
552    method resultSetCreate {name instance args} {
553	return [uplevel 1 [list $resultSetClass create \
554			       $name $instance {*}$args]]
555    }
556
557    # The 'resultsets' method returns a list of result sets produced by
558    # the current statement
559
560    method resultsets {} {
561	info commands ResultSet::*
562    }
563
564    # The 'allrows' method executes a statement with a given set of
565    # substituents, and returns a list of all the rows that the statement
566    # returns.  Optionally, it stores the names of columns in
567    # '-columnsvariable'.
568    #
569    # Usage:
570    #	$statement allrows ?-as lists|dicts? ?-columnsvariable varName? ?--?
571    #		?dictionary?
572
573
574    method allrows args {
575
576	variable ::tdbc::generalError
577
578	# Grab keyword-value parameters
579
580	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
581
582	# Check postitional parameters
583
584	set cmd [list [self] execute]
585	if {[llength $args] == 0} {
586	    # do nothing
587	} elseif {[llength $args] == 1} {
588	    lappend cmd [lindex $args 0]
589	} else {
590	    set errorcode $generalError
591	    lappend errorcode wrongNumArgs
592	    return -code error -errorcode $errorcode \
593		"wrong # args: should be [lrange [info level 0] 0 1]\
594                 ?-option value?... ?--? ?dictionary?"
595	}
596
597	# Get the result set
598
599	set resultSet [uplevel 1 $cmd]
600
601	# Delegate to the result set's [allrows] method to accumulate
602	# the rows of the result.
603
604	set cmd [list $resultSet allrows {*}$opts]
605	set status [catch {
606	    uplevel 1 $cmd
607	} result options]
608
609	# Destroy the result set
610
611	catch {
612	    rename $resultSet {}
613	}
614
615	# Adjust return level in the case that the script [return]s
616
617	if {$status == 2} {
618	    set options [dict merge {-level 1} $options[set options {}]]
619	    dict incr options -level
620	}
621	return -options $options $result
622    }
623
624    # The 'foreach' method executes a statement with a given set of
625    # substituents.  It runs the supplied script, substituting the supplied
626    # named variable. Optionally, it stores the names of columns in
627    # '-columnsvariable'.
628    #
629    # Usage:
630    #	$statement foreach ?-as lists|dicts? ?-columnsvariable varName? ?--?
631    #		variableName ?dictionary? script
632
633    method foreach args {
634
635	variable ::tdbc::generalError
636
637	# Grab keyword-value parameters
638
639	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
640
641	# Check positional parameters
642
643	set cmd [list [self] execute]
644	if {[llength $args] == 2} {
645	    lassign $args varname script
646	} elseif {[llength $args] == 3} {
647	    lassign $args varname dict script
648	    lappend cmd $dict
649	} else {
650	    set errorcode $generalError
651	    lappend errorcode wrongNumArgs
652	    return -code error -errorcode $errorcode \
653		"wrong # args: should be [lrange [info level 0] 0 1]\
654                 ?-option value?... ?--? varName ?dictionary? script"
655	}
656
657	# Get the result set
658
659	set resultSet [uplevel 1 $cmd]
660
661	# Delegate to the result set's [foreach] method to evaluate
662	# the script for each row of the result.
663
664	set cmd [list $resultSet foreach {*}$opts -- $varname $script]
665	set status [catch {
666	    uplevel 1 $cmd
667	} result options]
668
669	# Destroy the result set
670
671	catch {
672	    rename $resultSet {}
673	}
674
675	# Adjust return level in the case that the script [return]s
676
677	if {$status == 2} {
678	    set options [dict merge {-level 1} $options[set options {}]]
679	    dict incr options -level
680	}
681	return -options $options $result
682    }
683
684    # The 'close' method is syntactic sugar for invoking the destructor
685
686    method close {} {
687	my destroy
688    }
689
690    # Derived classes are expected to implement their own constructors,
691    # plus the following methods:
692
693    # paramtype paramName ?direction? type ?scale ?precision??
694    #     Declares the type of a parameter in the statement
695
696}
697
698#------------------------------------------------------------------------------
699#
700# Class: tdbc::resultset
701#
702#	Class that represents a result set in a generic database.
703#
704#------------------------------------------------------------------------------
705
706oo::class create tdbc::resultset {
707
708    constructor {} { }
709
710    # The 'allrows' method returns a list of all rows that a given
711    # result set returns.
712
713    method allrows args {
714
715	variable ::tdbc::generalError
716
717	# Parse args
718
719	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
720	if {[llength $args] != 0} {
721	    set errorcode $generalError
722	    lappend errorcode wrongNumArgs
723	    return -code error -errorcode $errorcode \
724		"wrong # args: should be [lrange [info level 0] 0 1]\
725                 ?-option value?... ?--? varName script"
726	}
727
728	# Do -columnsvariable if requested
729
730	if {[dict exists $opts -columnsvariable]} {
731	    upvar 1 [dict get $opts -columnsvariable] columns
732	}
733
734	# Assemble the results
735
736	if {[dict get $opts -as] eq {lists}} {
737	    set delegate nextlist
738	} else {
739	    set delegate nextdict
740	}
741	set results [list]
742	while {1} {
743	    set columns [my columns]
744	    while {[my $delegate row]} {
745		lappend results $row
746	    }
747	    if {![my nextresults]} break
748	}
749	return $results
750
751    }
752
753    # The 'foreach' method runs a script on each row from a result set.
754
755    method foreach args {
756
757	variable ::tdbc::generalError
758
759	# Grab keyword-value parameters
760
761	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
762
763	# Check positional parameters
764
765	if {[llength $args] != 2} {
766	    set errorcode $generalError
767	    lappend errorcode wrongNumArgs
768	    return -code error -errorcode $errorcode \
769		"wrong # args: should be [lrange [info level 0] 0 1]\
770                 ?-option value?... ?--? varName script"
771	}
772
773	# Do -columnsvariable if requested
774
775	if {[dict exists $opts -columnsvariable]} {
776	    upvar 1 [dict get $opts -columnsvariable] columns
777	}
778
779	# Iterate over the groups of results
780	while {1} {
781
782	    # Export column names to caller
783
784	    set columns [my columns]
785
786	    # Iterate over the rows of one group of results
787
788	    upvar 1 [lindex $args 0] row
789	    if {[dict get $opts -as] eq {lists}} {
790		set delegate nextlist
791	    } else {
792		set delegate nextdict
793	    }
794	    while {[my $delegate row]} {
795		set status [catch {
796		    uplevel 1 [lindex $args 1]
797		} result options]
798		switch -exact -- $status {
799		    0 - 4 {	# OK or CONTINUE
800		    }
801		    2 {		# RETURN
802			set options \
803			    [dict merge {-level 1} $options[set options {}]]
804			dict incr options -level
805			return -options $options $result
806		    }
807		    3 {		# BREAK
808			set broken 1
809			break
810		    }
811		    default {	# ERROR or unknown status
812			return -options $options $result
813		    }
814		}
815	    }
816
817	    # Advance to the next group of results if there is one
818
819	    if {[info exists broken] || ![my nextresults]} {
820		break
821	    }
822	}
823
824	return
825    }
826
827
828    # The 'nextrow' method retrieves a row in the form of either
829    # a list or a dictionary.
830
831    method nextrow {args} {
832
833	variable ::tdbc::generalError
834
835	set opts [dict create -as dicts]
836	set i 0
837
838	# Munch keyword options off the front of the command arguments
839
840	foreach {key value} $args {
841	    if {[string index $key 0] eq {-}} {
842		switch -regexp -- $key {
843		    -as? {
844			dict set opts -as $value
845		    }
846		    -- {
847			incr i
848			break
849		    }
850		    default {
851			set errorcode $generalError
852			lappend errorcode badOption $key
853			return -code error -errorcode $errorcode \
854			    "bad option \"$key\":\
855                             must be -as or -columnsvariable"
856		    }
857		}
858	    } else {
859		break
860	    }
861	    incr i 2
862	}
863
864	set args [lrange $args $i end]
865	if {[llength $args] != 1} {
866	    set errorcode $generalError
867	    lappend errorcode wrongNumArgs
868	    return -code error -errorcode $errorcode \
869		"wrong # args: should be [lrange [info level 0] 0 1]\
870                 ?-option value?... ?--? varName"
871	}
872	upvar 1 [lindex $args 0] row
873	if {[dict get $opts -as] eq {lists}} {
874	    set delegate nextlist
875	} else {
876	    set delegate nextdict
877	}
878	return [my $delegate row]
879    }
880
881    # Derived classes must override 'nextresults' if a single
882    # statement execution can yield multiple sets of results
883
884    method nextresults {} {
885	return 0
886    }
887
888    # Derived classes must override 'outputparams' if statements can
889    # have output parameters.
890
891    method outputparams {} {
892	return {}
893    }
894
895    # The 'close' method is syntactic sugar for destroying the result set.
896
897    method close {} {
898	my destroy
899    }
900
901    # Derived classes are expected to implement the following methods:
902
903    # constructor and destructor.
904    #        Constructor accepts a statement and an optional
905    #        a dictionary of substituted parameters  and
906    #        executes the statement against the database. If
907    #	     the dictionary is not supplied, then the default
908    #	     is to get params from variables in the caller's scope).
909    # columns
910    #     -- Returns a list of the names of the columns in the result.
911    # nextdict variableName
912    #     -- Stores the next row of the result set in the given variable
913    #        in caller's scope, in the form of a dictionary that maps
914    #	     column names to values.
915    # nextlist variableName
916    #     -- Stores the next row of the result set in the given variable
917    #        in caller's scope, in the form of a list of cells.
918    # rowcount
919    #     -- Returns a count of rows affected by the statement, or -1
920    #        if the count of rows has not been determined.
921
922}