针对pulse-transit的工具

dist/client/tcl8/8.4/platform-1.0.19.tm

@@ -0,0 +1,450 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Overview
+
+# Heuristics to assemble a platform identifier from publicly available
+# information. The identifier describes the platform of the currently
+# running tcl shell. This is a mixture of the runtime environment and
+# of build-time properties of the executable itself.
+#
+# Examples:
+# <1> A tcl shell executing on a x86_64 processor, but having a
+#   wordsize of 4 was compiled for the x86 environment, i.e. 32
+#   bit, and loaded packages have to match that, and not the
+#   actual cpu.
+#
+# <2> The hp/solaris 32/64 bit builds of the core cannot be
+#   distinguished by looking at tcl_platform. As packages have to
+#   match the 32/64 information we have to look in more places. In
+#   this case we inspect the executable itself (magic numbers,
+#   i.e. fileutil::magic::filetype).
+#
+# The basic information used comes out of the 'os' and 'machine'
+# entries of the 'tcl_platform' array. A number of general and
+# os/machine specific transformation are applied to get a canonical
+# result.
+#
+# General
+# Only the first element of 'os' is used - we don't care whether we
+# are on "Windows NT" or "Windows XP" or whatever.
+#
+# Machine specific
+# % amd64  -> x86_64
+# % arm*   -> arm
+# % sun4*  -> sparc
+# % ia32*  -> ix86
+# % intel  -> ix86
+# % i*86*  -> ix86
+# % Power* -> powerpc
+# % x86_64 + wordSize 4 => x86 code
+#
+# OS specific
+# % AIX are always powerpc machines
+# % HP-UX 9000/800 etc means parisc
+# % linux has to take glibc version into account
+# % sunos -> solaris, and keep version number
+#
+# NOTE: A platform like linux glibc 2.3, which can use glibc 2.2 stuff
+# has to provide all possible allowed platform identifiers when
+# searching search. Ditto a solaris 2.8 platform can use solaris 2.6
+# packages. Etc. This is handled by the other procedure, see below.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+namespace eval ::platform {}
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+# -- platform::generic
+#
+# Assembles an identifier for the generic platform. It leaves out
+# details like kernel version, libc version, etc.
+
+proc ::platform::generic {} {
+    global tcl_platform
+
+    set plat [string tolower [lindex $tcl_platform(os) 0]]
+    set cpu  $tcl_platform(machine)
+
+    switch -glob -- $cpu {
+	sun4* {
+	    set cpu sparc
+	}
+	intel -
+	ia32* -
+	i*86* {
+	    set cpu ix86
+	}
+	x86_64 {
+	    if {$tcl_platform(wordSize) == 4} {
+		# See Example <1> at the top of this file.
+		set cpu ix86
+	    }
+	}
+	ppc -
+	"Power*" {
+	    set cpu powerpc
+	}
+	"arm*" {
+	    set cpu arm
+	}
+	ia64 {
+	    if {$tcl_platform(wordSize) == 4} {
+		append cpu _32
+	    }
+	}
+    }
+
+    switch -glob -- $plat {
+	windows {
+	    if {$tcl_platform(platform) == "unix"} {
+		set plat cygwin
+	    } else {
+		set plat win32
+	    }
+	    if {$cpu eq "amd64"} {
+		# Do not check wordSize, win32-x64 is an IL32P64 platform.
+		set cpu x86_64
+	    }
+	}
+	sunos {
+	    set plat solaris
+	    if {[string match "ix86" $cpu]} {
+		if {$tcl_platform(wordSize) == 8} {
+		    set cpu x86_64
+		}
+	    } elseif {![string match "ia64*" $cpu]} {
+		# sparc
+		if {$tcl_platform(wordSize) == 8} {
+		    append cpu 64
+		}
+	    }
+	}
+	darwin {
+	    set plat macosx
+	    # Correctly identify the cpu when running as a 64bit
+	    # process on a machine with a 32bit kernel
+	    if {$cpu eq "ix86"} {
+		if {$tcl_platform(wordSize) == 8} {
+		    set cpu x86_64
+		}
+	    }
+	}
+	aix {
+	    set cpu powerpc
+	    if {$tcl_platform(wordSize) == 8} {
+		append cpu 64
+	    }
+	}
+	hp-ux {
+	    set plat hpux
+	    if {![string match "ia64*" $cpu]} {
+		set cpu parisc
+		if {$tcl_platform(wordSize) == 8} {
+		    append cpu 64
+		}
+	    }
+	}
+	osf1 {
+	    set plat tru64
+	}
+	default {
+	    set plat [lindex [split $plat _-] 0]
+	}
+    }
+
+    return "${plat}-${cpu}"
+}
+
+# -- platform::identify
+#
+# Assembles an identifier for the exact platform, by extending the
+# generic identifier. I.e. it adds in details like kernel version,
+# libc version, etc., if they are relevant for the loading of
+# packages on the platform.
+
+proc ::platform::identify {} {
+    global tcl_platform
+
+    set id [generic]
+    regexp {^([^-]+)-([^-]+)$} $id -> plat cpu
+
+    switch -- $plat {
+	solaris {
+	    regsub {^5} $tcl_platform(osVersion) 2 text
+	    append plat $text
+	    return "${plat}-${cpu}"
+	}
+	macosx {
+	    set major [lindex [split $tcl_platform(osVersion) .] 0]
+	    if {$major > 19} {
+		set minor [lindex [split $tcl_platform(osVersion) .] 1]
+		incr major -9
+		append plat $major.[expr {$minor - 1}]
+	    } else {
+		incr major -4
+		append plat 10.$major
+		return "${plat}-${cpu}"
+	    }
+	    return "${plat}-${cpu}"
+	}
+	linux {
+	    # Look for the libc*.so and determine its version
+	    # (libc5/6, libc6 further glibc 2.X)
+
+	    set v unknown
+
+	    # Determine in which directory to look. /lib, or /lib64.
+	    # For that we use the tcl_platform(wordSize).
+	    #
+	    # We could use the 'cpu' info, per the equivalence below,
+	    # that however would be restricted to intel. And this may
+	    # be a arm, mips, etc. system. The wordsize is more
+	    # fundamental.
+	    #
+	    # ix86   <=> (wordSize == 4) <=> 32 bit ==> /lib
+	    # x86_64 <=> (wordSize == 8) <=> 64 bit ==> /lib64
+	    #
+	    # Do not look into /lib64 even if present, if the cpu
+	    # doesn't fit.
+
+	    # TODO: Determine the prefixes (i386, x86_64, ...) for
+	    # other cpus.  The path after the generic one is utterly
+	    # specific to intel right now.  Ok, on Ubuntu, possibly
+	    # other Debian systems we may apparently be able to query
+	    # the necessary CPU code. If we can't we simply use the
+	    # hardwired fallback.
+
+	    switch -exact -- $tcl_platform(wordSize) {
+		4 {
+		    lappend bases /lib
+		    if {[catch {
+			exec dpkg-architecture -qDEB_HOST_MULTIARCH
+		    } res]} {
+			lappend bases /lib/i386-linux-gnu
+		    } else {
+			# dpkg-arch returns the full tripled, not just cpu.
+			lappend bases /lib/$res
+		    }
+		}
+		8 {
+		    lappend bases /lib64
+		    if {[catch {
+			exec dpkg-architecture -qDEB_HOST_MULTIARCH
+		    } res]} {
+			lappend bases /lib/x86_64-linux-gnu
+		    } else {
+			# dpkg-arch returns the full tripled, not just cpu.
+			lappend bases /lib/$res
+		    }
+		}
+		default {
+		    return -code error "Bad wordSize $tcl_platform(wordSize), expected 4 or 8"
+		}
+	    }
+
+	    foreach base $bases {
+		if {[LibcVersion $base -> v]} break
+	    }
+
+	    append plat -$v
+	    return "${plat}-${cpu}"
+	}
+    }
+
+    return $id
+}
+
+proc ::platform::LibcVersion {base _->_ vv} {
+    upvar 1 $vv v
+    set libclist [lsort [glob -nocomplain -directory $base libc*]]
+
+    if {![llength $libclist]} { return 0 }
+
+    set libc [lindex $libclist 0]
+
+    # Try executing the library first. This should suceed
+    # for a glibc library, and return the version
+    # information.
+
+    if {![catch {
+	set vdata [lindex [split [exec $libc] \n] 0]
+    }]} {
+	regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v
+	foreach {major minor} [split $v .] break
+	set v glibc${major}.${minor}
+	return 1
+    } else {
+	# We had trouble executing the library. We are now
+	# inspecting its name to determine the version
+	# number. This code by Larry McVoy.
+
+	if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
+	    set v glibc${major}.${minor}
+	    return 1
+	}
+    }
+    return 0
+}
+
+# -- platform::patterns
+#
+# Given an exact platform identifier, i.e. _not_ the generic
+# identifier it assembles a list of exact platform identifier
+# describing platform which should be compatible with the
+# input.
+#
+# I.e. packages for all platforms in the result list should be
+# loadable on the specified platform.
+
+# << Should we add the generic identifier to the list as well ? In
+#    general it is not compatible I believe. So better not. In many
+#    cases the exact identifier is identical to the generic one
+#    anyway.
+# >>
+
+proc ::platform::patterns {id} {
+    set res [list $id]
+    if {$id eq "tcl"} {return $res}
+
+    switch -glob --  $id {
+	solaris*-* {
+	    if {[regexp {solaris([^-]*)-(.*)} $id -> v cpu]} {
+		if {$v eq ""} {return $id}
+		foreach {major minor} [split $v .] break
+		incr minor -1
+		for {set j $minor} {$j >= 6} {incr j -1} {
+		    lappend res solaris${major}.${j}-${cpu}
+		}
+	    }
+	}
+	linux*-* {
+	    if {[regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} {
+		foreach {major minor} [split $v .] break
+		incr minor -1
+		for {set j $minor} {$j >= 0} {incr j -1} {
+		    lappend res linux-glibc${major}.${j}-${cpu}
+		}
+	    }
+	}
+	macosx-powerpc {
+	    lappend res macosx-universal
+	}
+	macosx-x86_64 {
+	    lappend res macosx-i386-x86_64
+	}
+	macosx-ix86 {
+	    lappend res macosx-universal macosx-i386-x86_64
+	}
+	macosx*-*    {
+	    # 10.5+,11.0+
+	    if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {
+
+		switch -exact -- $cpu {
+		    ix86    {
+			lappend alt i386-x86_64
+			lappend alt universal
+		    }
+		    x86_64  {
+			if {[lindex [split $::tcl_platform(osVersion) .] 0] < 19} {
+			    set alt i386-x86_64
+			} else {
+			    set alt {}
+			}
+		    }
+		    arm  {
+			lappend alt x86_64
+		    }
+		    default { set alt {} }
+		}
+
+		if {$v ne ""} {
+		    foreach {major minor} [split $v .] break
+
+		    set res {}
+		    if {$major eq 13} {
+			# Add 13.0 to 13.minor to patterns.
+			for {set j $minor} {$j >= 0} {incr j -1} {
+			    lappend res macosx${major}.${j}-${cpu}
+			    foreach a $alt {
+				lappend res macosx${major}.${j}-$a
+			    }
+			}
+			set major 12
+			set minor 5
+		    }
+		    if {$major eq 12} {
+			# Add 12.0 to 12.minor to patterns.
+			for {set j $minor} {$j >= 0} {incr j -1} {
+			    lappend res macosx${major}.${j}-${cpu}
+			    foreach a $alt {
+				lappend res macosx${major}.${j}-$a
+			    }
+			}
+			set major 11
+			set minor 5
+		    }
+		    if {$major eq 11} {
+			# Add 11.0 to 11.minor to patterns.
+			for {set j $minor} {$j >= 0} {incr j -1} {
+			    lappend res macosx${major}.${j}-${cpu}
+			    foreach a $alt {
+				lappend res macosx${major}.${j}-$a
+			    }
+			}
+			set major 10
+			set minor 15
+		    }
+		    # Add 10.5 to 10.minor to patterns.
+		    for {set j $minor} {$j >= 5} {incr j -1} {
+			if {$cpu ne "arm"} {
+			    lappend res macosx${major}.${j}-${cpu}
+			}
+			foreach a $alt {
+			    lappend res macosx${major}.${j}-$a
+			}
+		    }
+
+		    # Add unversioned patterns for 10.3/10.4 builds.
+		    lappend res macosx-${cpu}
+		    foreach a $alt {
+			lappend res macosx-$a
+		    }
+		} else {
+		    # No version, just do unversioned patterns.
+		    foreach a $alt {
+			lappend res macosx-$a
+		    }
+		}
+	    } else {
+		# no v, no cpu ... nothing
+	    }
+	}
+    }
+    lappend res tcl ; # Pure tcl packages are always compatible.
+    return $res
+}
+
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide platform 1.0.19
+
+# ### ### ### ######### ######### #########
+## Demo application
+
+if {[info exists argv0] && ($argv0 eq [info script])} {
+    puts ====================================
+    parray tcl_platform
+    puts ====================================
+    puts Generic\ identification:\ [::platform::generic]
+    puts Exact\ identification:\ \ \ [::platform::identify]
+    puts ====================================
+    puts Search\ patterns:
+    puts *\ [join [::platform::patterns [::platform::identify]] \n*\ ]
+    puts ====================================
+    exit 0
+}

dist/client/tcl8/8.4/platform/shell-1.1.4.tm

@@ -0,0 +1,241 @@
+
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Overview
+
+# Higher-level commands which invoke the functionality of this package
+# for an arbitrary tcl shell (tclsh, wish, ...). This is required by a
+# repository as while the tcl shell executing packages uses the same
+# platform in general as a repository application there can be
+# differences in detail (i.e. 32/64 bit builds).
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require platform
+namespace eval ::platform::shell {}
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+# -- platform::shell::generic
+
+proc ::platform::shell::generic {shell} {
+    # Argument is the path to a tcl shell.
+
+    CHECK $shell
+    LOCATE base out
+
+    set     code {}
+    # Forget any pre-existing platform package, it might be in
+    # conflict with this one.
+    lappend code {package forget platform}
+    # Inject our platform package
+    lappend code [list source $base]
+    # Query and print the architecture
+    lappend code {puts [platform::generic]}
+    # And done
+    lappend code {exit 0}
+
+    set arch [RUN $shell [join $code \n]]
+
+    if {$out} {file delete -force $base}
+    return $arch
+}
+
+# -- platform::shell::identify
+
+proc ::platform::shell::identify {shell} {
+    # Argument is the path to a tcl shell.
+
+    CHECK $shell
+    LOCATE base out
+
+    set     code {}
+    # Forget any pre-existing platform package, it might be in
+    # conflict with this one.
+    lappend code {package forget platform}
+    # Inject our platform package
+    lappend code [list source $base]
+    # Query and print the architecture
+    lappend code {puts [platform::identify]}
+    # And done
+    lappend code {exit 0}
+
+    set arch [RUN $shell [join $code \n]]
+
+    if {$out} {file delete -force $base}
+    return $arch
+}
+
+# -- platform::shell::platform
+
+proc ::platform::shell::platform {shell} {
+    # Argument is the path to a tcl shell.
+
+    CHECK $shell
+
+    set     code {}
+    lappend code {puts $tcl_platform(platform)}
+    lappend code {exit 0}
+
+    return [RUN $shell [join $code \n]]
+}
+
+# ### ### ### ######### ######### #########
+## Internal helper commands.
+
+proc ::platform::shell::CHECK {shell} {
+    if {![file exists $shell]} {
+	return -code error "Shell \"$shell\" does not exist"
+    }
+    if {![file executable $shell]} {
+	return -code error "Shell \"$shell\" is not executable (permissions)"
+    }
+    return
+}
+
+proc ::platform::shell::LOCATE {bv ov} {
+    upvar 1 $bv base $ov out
+
+    # Locate the platform package for injection into the specified
+    # shell. We are using package management to find it, whereever it
+    # is, instead of using hardwired relative paths. This allows us to
+    # install the two packages as TMs without breaking the code
+    # here. If the found package is wrapped we copy the code somewhere
+    # where the spawned shell will be able to read it.
+
+    # This code is brittle, it needs has to adapt to whatever changes
+    # are made to the TM code, i.e. the provide statement generated by
+    # tm.tcl
+
+    set pl [package ifneeded platform [package require platform]]
+    set base [lindex $pl end]
+
+    set out 0
+    if {[lindex [file system $base]] ne "native"} {
+	set temp [TEMP]
+	file copy -force $base $temp
+	set base $temp
+	set out 1
+    }
+    return
+}
+
+proc ::platform::shell::RUN {shell code} {
+    set     c [TEMP]
+    set    cc [open $c w]
+    puts  $cc $code
+    close $cc
+
+    set e [TEMP]
+
+    set code [catch {
+        exec $shell $c 2> $e
+    } res]
+
+    file delete $c
+
+    if {$code} {
+	append res \n[read [set chan [open $e r]]][close $chan]
+	file delete $e
+	return -code error "Shell \"$shell\" is not executable ($res)"
+    }
+
+    file delete $e
+    return $res
+}
+
+proc ::platform::shell::TEMP {} {
+    set prefix platform
+
+    # This code is copied out of Tcllib's fileutil package.
+    # (TempFile/tempfile)
+
+    set tmpdir [DIR]
+
+    set chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
+    set nrand_chars 10
+    set maxtries 10
+    set access [list RDWR CREAT EXCL TRUNC]
+    set permission 0600
+    set channel ""
+    set checked_dir_writable 0
+    set mypid [pid]
+    for {set i 0} {$i < $maxtries} {incr i} {
+ 	set newname $prefix
+ 	for {set j 0} {$j < $nrand_chars} {incr j} {
+ 	    append newname [string index $chars \
+		    [expr {int(rand()*62)}]]
+ 	}
+	set newname [file join $tmpdir $newname]
+ 	if {[file exists $newname]} {
+ 	    after 1
+ 	} else {
+ 	    if {[catch {open $newname $access $permission} channel]} {
+ 		if {!$checked_dir_writable} {
+ 		    set dirname [file dirname $newname]
+ 		    if {![file writable $dirname]} {
+ 			return -code error "Directory $dirname is not writable"
+ 		    }
+ 		    set checked_dir_writable 1
+ 		}
+ 	    } else {
+ 		# Success
+		close $channel
+ 		return [file normalize $newname]
+ 	    }
+ 	}
+    }
+    if {$channel ne ""} {
+ 	return -code error "Failed to open a temporary file: $channel"
+    } else {
+ 	return -code error "Failed to find an unused temporary file name"
+    }
+}
+
+proc ::platform::shell::DIR {} {
+    # This code is copied out of Tcllib's fileutil package.
+    # (TempDir/tempdir)
+
+    global tcl_platform env
+
+    set attempdirs [list]
+
+    foreach tmp {TMPDIR TEMP TMP} {
+	if { [info exists env($tmp)] } {
+	    lappend attempdirs $env($tmp)
+	}
+    }
+
+    switch $tcl_platform(platform) {
+	windows {
+	    lappend attempdirs "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"
+	}
+	macintosh {
+	    set tmpdir $env(TRASH_FOLDER)  ;# a better place?
+	}
+	default {
+	    lappend attempdirs \
+		[file join / tmp] \
+		[file join / var tmp] \
+		[file join / usr tmp]
+	}
+    }
+
+    lappend attempdirs [pwd]
+
+    foreach tmp $attempdirs {
+	if { [file isdirectory $tmp] && [file writable $tmp] } {
+	    return [file normalize $tmp]
+	}
+    }
+
+    # Fail if nothing worked.
+    return -code error "Unable to determine a proper directory for temporary files"
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide platform::shell 1.1.4

dist/client/tcl8/8.6/tdbc/sqlite3-1.1.5.tm

@@ -0,0 +1,715 @@
+# tdbcsqlite3.tcl --
+#
+#    SQLite3 database driver for TDBC
+#
+# Copyright (c) 2008 by Kevin B. Kenny.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tdbcodbc.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $
+#
+#------------------------------------------------------------------------------
+
+package require tdbc
+package require sqlite3
+
+package provide tdbc::sqlite3 1.1.5
+
+namespace eval tdbc::sqlite3 {
+    namespace export connection
+}
+
+#------------------------------------------------------------------------------
+#
+# tdbc::sqlite3::connection --
+#
+#	Class representing a SQLite3 database connection
+#
+#------------------------------------------------------------------------------
+
+::oo::class create ::tdbc::sqlite3::connection {
+
+    superclass ::tdbc::connection
+
+    variable timeout
+
+    # The constructor accepts a database name and opens the database.
+
+    constructor {databaseName args} {
+	set timeout 0
+	if {[llength $args] % 2 != 0} {
+	    set cmd [lrange [info level 0] 0 end-[llength $args]]
+	    return -code error \
+		-errorcode {TDBC GENERAL_ERROR HY000 SQLITE3 WRONGNUMARGS} \
+		"wrong # args, should be \"$cmd ?-option value?...\""
+	}
+	next
+	sqlite3 [namespace current]::db $databaseName
+	if {[llength $args] > 0} {
+	    my configure {*}$args
+	}
+	db nullvalue \ufffd
+    }
+
+    # The 'statementCreate' method forwards to the constructor of the
+    # statement class
+
+    forward statementCreate ::tdbc::sqlite3::statement create
+
+    # The 'configure' method queries and sets options to the database
+
+    method configure args {
+	if {[llength $args] == 0} {
+
+	    # Query all configuration options
+
+	    set result {-encoding utf-8}
+	    lappend result -isolation
+	    if {[db onecolumn {PRAGMA read_uncommitted}]} {
+		lappend result readuncommitted
+	    } else {
+		lappend result serializable
+	    }
+	    lappend result -readonly 0
+	    lappend result -timeout $timeout
+	    return $result
+
+	} elseif {[llength $args] == 1} {
+
+	    # Query a single option
+
+	    set option [lindex $args 0]
+	    switch -exact -- $option {
+		-e - -en - -enc - -enco - -encod - -encodi - -encodin -
+		-encoding {
+		    return utf-8
+		}
+		-i - -is - -iso - -isol - -isola - -isolat - -isolati -
+		-isolatio - -isolation {
+		    if {[db onecolumn {PRAGMA read_uncommitted}]} {
+			return readuncommitted
+		    } else {
+			return serializable
+		    }
+		}
+		-r - -re - -rea - -read - -reado - -readon - -readonl -
+		-readonly {
+		    return 0
+		}
+		-t - -ti - -tim - -time - -timeo - -timeou - -timeout {
+		    return $timeout
+		}
+		default {
+		    return -code error \
+			-errorcode [list TDBC GENERAL_ERROR HY000 SQLITE3 \
+					BADOPTION $option] \
+			"bad option \"$option\": must be\
+                         -encoding, -isolation, -readonly or -timeout"
+
+		}
+	    }
+
+	} elseif {[llength $args] % 2 != 0} {
+
+	    # Syntax error
+
+	    set cmd [lrange [info level 0] 0 end-[llength $args]]
+	    return -code error \
+		-errorcode [list TDBC GENERAL_ERROR HY000 \
+				SQLITE3 WRONGNUMARGS] \
+		"wrong # args, should be \" $cmd ?-option value?...\""
+	}
+
+	# Set one or more options
+
+	foreach {option value} $args {
+	    switch -exact -- $option {
+		-e - -en - -enc - -enco - -encod - -encodi - -encodin -
+		-encoding {
+		    if {$value ne {utf-8}} {
+			return -code error \
+			    -errorcode [list TDBC FEATURE_NOT_SUPPORTED 0A000 \
+					    SQLITE3 ENCODING] \
+			    "-encoding not supported. SQLite3 is always \
+                             Unicode."
+		    }
+		}
+		-i - -is - -iso - -isol - -isola - -isolat - -isolati -
+		-isolatio - -isolation {
+		    switch -exact -- $value {
+			readu - readun - readunc - readunco - readuncom -
+			readuncomm - readuncommi - readuncommit -
+			readuncommitt - readuncommitte - readuncommitted {
+			    db eval {PRAGMA read_uncommitted = 1}
+			}
+			readc - readco - readcom - readcomm - readcommi -
+			readcommit - readcommitt - readcommitte -
+			readcommitted -
+			rep - repe - repea - repeat - repeata - repeatab -
+			repeatabl - repeatable - repeatabler - repeatablere -
+			repeatablerea - repeatablread -
+			s - se - ser - seri - seria - serial - seriali -
+			serializ - serializa - serializab - serializabl -
+			serializable -
+			reado - readon - readonl - readonly {
+			    db eval {PRAGMA read_uncommitted = 0}
+			}
+			default {
+			    return -code error \
+				-errorcode [list TDBC GENERAL_ERROR HY000 \
+						SQLITE3 BADISOLATION $value] \
+				"bad isolation level \"$value\":\
+                                should be readuncommitted, readcommitted,\
+                                repeatableread, serializable, or readonly"
+			}
+		    }
+		}
+		-r - -re - -rea - -read - -reado - -readon - -readonl -
+		-readonly {
+		    if {$value} {
+			return -code error \
+			    -errorcode [list TDBC FEATURE_NOT_SUPPORTED 0A000 \
+					    SQLITE3 READONLY] \
+			    "SQLite3's Tcl API does not support read-only\
+                             access"
+		    }
+		}
+		-t - -ti - -tim - -time - -timeo - -timeou - -timeout {
+		    if {![string is integer $value]} {
+			return -code error \
+			    -errorcode [list TDBC DATA_EXCEPTION 22018 \
+					    SQLITE3 $value] \
+			    "expected integer but got \"$value\""
+		    }
+		    db timeout $value
+		    set timeout $value
+		}
+		default {
+		    return -code error \
+			-errorcode [list TDBC GENERAL_ERROR HY000 \
+					SQLITE3 BADOPTION $value] \
+			"bad option \"$option\": must be\
+                         -encoding, -isolation, -readonly or -timeout"
+
+		}
+	    }
+	}
+	return
+    }
+
+    # The 'tables' method introspects on the tables in the database.
+
+    method tables {{pattern %}} {
+	set retval {}
+	my foreach row {
+	    SELECT * from sqlite_master
+	    WHERE type IN ('table', 'view')
+	    AND name LIKE :pattern
+	} {
+	    dict set row name [string tolower [dict get $row name]]
+	    dict set retval [dict get $row name] $row
+	}
+	return $retval
+    }
+
+    # The 'columns' method introspects on columns of a table.
+
+    method columns {table {pattern %}} {
+	regsub -all ' $table '' table
+	set retval {}
+	set pattern [string map [list \
+				     * {[*]} \
+				     ? {[?]} \
+				     \[ \\\[ \
+				     \] \\\[ \
+				     _ ? \
+				     % *] [string tolower $pattern]]
+	my foreach origrow "PRAGMA table_info('$table')" {
+	    set row {}
+	    dict for {key value} $origrow {
+		dict set row [string tolower $key] $value
+	    }
+	    dict set row name [string tolower [dict get $row name]]
+	    if {![string match $pattern [dict get $row name]]} {
+		continue
+	    }
+	    switch -regexp -matchvar info [dict get $row type] {
+		{^(.+)\(\s*([[:digit:]]+)\s*,\s*([[:digit:]]+)\s*\)\s*$} {
+		    dict set row type [string tolower [lindex $info 1]]
+		    dict set row precision [lindex $info 2]
+		    dict set row scale [lindex $info 3]
+		}
+		{^(.+)\(\s*([[:digit:]]+)\s*\)\s*$} {
+		    dict set row type [string tolower [lindex $info 1]]
+		    dict set row precision [lindex $info 2]
+		    dict set row scale 0
+		}
+		default {
+		    dict set row type [string tolower [dict get $row type]]
+		    dict set row precision 0
+		    dict set row scale 0
+		}
+	    }
+	    dict set row nullable [expr {![dict get $row notnull]}]
+	    dict set retval [dict get $row name] $row
+	}
+	return $retval
+    }
+
+    # The 'primarykeys' method enumerates the primary keys on a table.
+
+    method primarykeys {table} {
+	set result {}
+	my foreach row "PRAGMA table_info($table)" {
+	    if {[dict get $row pk]} {
+		lappend result [dict create ordinalPosition \
+				    [expr {[dict get $row cid]+1}] \
+				    columnName \
+				    [dict get $row name]]
+	    }
+	}
+	return $result
+    }
+
+    # The 'foreignkeys' method enumerates the foreign keys that are
+    # declared in a table or that refer to a given table.
+
+    method foreignkeys {args} {
+
+	variable ::tdbc::generalError
+
+	# Check arguments
+
+	set argdict {}
+	if {[llength $args] % 2 != 0} {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+                 ?-option value?..."
+	}
+	foreach {key value} $args {
+	    if {$key ni {-primary -foreign}} {
+		set errorcode $generalError
+		lappend errorcode badOption
+		return -code error -errorcode $errorcode \
+		    "bad option \"$key\", must be -primary or -foreign"
+	    }
+	    set key [string range $key 1 end]
+	    if {[dict exists $argdict $key]} {
+		set errorcode $generalError
+		lappend errorcode dupOption
+		return -code error -errorcode $errorcode \
+		    "duplicate option \"$key\" supplied"
+	    }
+	    dict set argdict $key $value
+	}
+
+	# If we know the table with the foreign key, search just its
+	# foreign keys. Otherwise, iterate over all the tables in the
+	# database.
+
+	if {[dict exists $argdict foreign]} {
+	    return [my ForeignKeysForTable [dict get $argdict foreign] \
+			$argdict]
+	} else {
+	    set result {}
+	    foreach foreignTable [dict keys [my tables]] {
+		lappend result {*}[my ForeignKeysForTable \
+				       $foreignTable $argdict]
+	    }
+	    return $result
+	}
+
+    }
+
+    # The private ForeignKeysForTable method enumerates the foreign keys
+    # in a specific table.
+    #
+    # Parameters:
+    #
+    #	foreignTable - Name of the table containing foreign keys.
+    #   argdict - Dictionary that may or may not contain a key,
+    #             'primary', whose value is the name of a table that
+    #             must hold the primary key corresponding to the foreign
+    #             key. If the 'primary' key is absent, all tables are
+    #             candidates.
+    # Results:
+    #
+    # 	Returns the list of foreign keys that meed the specified
+    # 	conditions, as a list of dictionaries, each containing the
+    # 	keys, foreignConstraintName, foreignTable, foreignColumn,
+    # 	primaryTable, primaryColumn, and ordinalPosition.  Note that the
+    #   foreign constraint name is constructed arbitrarily, since SQLite3
+    #   does not report this information.
+
+    method ForeignKeysForTable {foreignTable argdict} {
+
+	set result {}
+	set n 0
+
+	# Go through the foreign keys in the given table, looking for
+	# ones that refer to the primary table (if one is given), or
+	# for any primary keys if none is given.
+	my foreach row "PRAGMA foreign_key_list($foreignTable)" {
+	    if {(![dict exists $argdict primary])
+		|| ([string tolower [dict get $row table]]
+		    eq [dict get $argdict primary])} {
+
+		# Construct a dictionary for each key, translating
+		# SQLite names to TDBC ones and converting sequence
+		# numbers to 1-based indexing.
+
+		set rrow [dict create foreignTable $foreignTable \
+			      foreignConstraintName \
+			      ?$foreignTable?[dict get $row id]]
+		if {[dict exists $row seq]} {
+		    dict set rrow ordinalPosition \
+			[expr {1 + [dict get $row seq]}]
+		}
+		foreach {to from} {
+		    foreignColumn from
+		    primaryTable table
+		    primaryColumn to
+		    deleteAction on_delete
+		    updateAction on_update
+		} {
+		    if {[dict exists $row $from]} {
+			dict set rrow $to [dict get $row $from]
+		    }
+		}
+
+		# Add the newly-constucted dictionary to the result list
+
+		lappend result $rrow
+	    }
+	}
+
+	return $result
+    }
+
+    # The 'preparecall' method prepares a call to a stored procedure.
+    # SQLite3 does not have stored procedures, since it's an in-process
+    # server.
+
+    method preparecall {call} {
+	return -code error \
+	    -errorcode [list TDBC FEATURE_NOT_SUPPORTED 0A000 \
+			    SQLITE3 PREPARECALL] \
+	    {SQLite3 does not support stored procedures}
+    }
+
+    # The 'begintransaction' method launches a database transaction
+
+    method begintransaction {} {
+	db eval {BEGIN TRANSACTION}
+    }
+
+    # The 'commit' method commits a database transaction
+
+    method commit {} {
+	db eval {COMMIT}
+    }
+
+    # The 'rollback' method abandons a database transaction
+
+    method rollback {} {
+	db eval {ROLLBACK}
+    }
+
+    # The 'transaction' method executes a script as a single transaction.
+    # We override the 'transaction' method of the base class, since SQLite3
+    # has a faster implementation of the same thing. (The base class's generic
+    # method should also work.)
+    # (Don't overload the base class method, because 'break', 'continue'
+    # and 'return' in the transaction body don't work!)
+
+    #method transaction {script} {
+    #	uplevel 1 [list {*}[namespace code db] transaction $script]
+    #}
+
+    method prepare {sqlCode} {
+	set result [next $sqlCode]
+	return $result
+    }
+
+    method getDBhandle {} {
+	return [namespace which db]
+    }
+}
+
+#------------------------------------------------------------------------------
+#
+# tdbc::sqlite3::statement --
+#
+#	Class representing a statement to execute against a SQLite3 database
+#
+#------------------------------------------------------------------------------
+
+::oo::class create ::tdbc::sqlite3::statement {
+
+    superclass ::tdbc::statement
+
+    variable Params db sql
+
+    # The constructor accepts the handle to the connection and the SQL
+    # code for the statement to prepare.  All that it does is to parse the
+    # statement and store it.  The parse is used to support the
+    # 'params' and 'paramtype' methods.
+
+    constructor {connection sqlcode} {
+	next
+	set Params {}
+	set db [$connection getDBhandle]
+	set sql $sqlcode
+	foreach token [::tdbc::tokenize $sqlcode] {
+	    if {[string index $token 0] in {$ : @}} {
+		dict set Params [string range $token 1 end] \
+		    {type Tcl_Obj precision 0 scale 0 nullable 1 direction in}
+	    }
+	}
+    }
+
+    # The 'resultSetCreate' method relays to the result set constructor
+
+    forward resultSetCreate ::tdbc::sqlite3::resultset create
+
+    # The 'params' method returns descriptions of the parameters accepted
+    # by the statement
+
+    method params {} {
+	return $Params
+    }
+
+    # The 'paramtype' method need do nothing; Sqlite3 uses manifest typing.
+
+    method paramtype args {;}
+
+    method getDBhandle {} {
+	return $db
+    }
+
+    method getSql {} {
+	return $sql
+    }
+
+}
+
+#-------------------------------------------------------------------------------
+#
+# tdbc::sqlite3::resultset --
+#
+#	Class that represents a SQLlite result set in Tcl
+#
+#-------------------------------------------------------------------------------
+
+::oo::class create ::tdbc::sqlite3::resultset {
+
+    superclass ::tdbc::resultset
+
+    # The variables of this class all have peculiar names. The reason is
+    # that the RunQuery method needs to execute with an activation record
+    # that has no local variables whose names could conflict with names
+    # in the SQL query. We start the variable names with hyphens because
+    # they can't be bind variables.
+
+    variable -set {*}{
+	-columns -db -needcolumns -resultArray
+	-results -sql -Cursor -RowCount -END
+    }
+
+    constructor {statement args} {
+	next
+	set -db [$statement getDBhandle]
+	set -sql [$statement getSql]
+	set -columns {}
+	set -results {}
+	${-db} trace [namespace code {my RecordStatement}]
+	if {[llength $args] == 0} {
+
+	    # Variable substitutions are evaluated in caller's context
+
+	    uplevel 1 [list ${-db} eval ${-sql} \
+			   [namespace which -variable -resultArray] \
+			   [namespace code {my RecordResult}]]
+
+	} elseif {[llength $args] == 1} {
+
+	    # Variable substitutions are in the dictionary at [lindex $args 0].
+
+	    set -paramDict [lindex $args 0]
+
+	    # At this point, the activation record must contain no variables
+	    # that might be bound within the query.  All variables at this point
+	    # begin with hyphens so that they are syntactically incorrect
+	    # as bound variables in SQL.
+
+	    unset args
+	    unset statement
+
+	    dict with -paramDict {
+		${-db} eval ${-sql} -resultArray {
+		    my RecordResult
+		}
+	    }
+
+	} else {
+
+	    ${-db} trace {}
+
+	    # Too many args
+
+	    return -code error \
+		-errorcode [list TDBC GENERAL_ERROR HY000 \
+				SQLITE3 WRONGNUMARGS] \
+		"wrong # args: should be\
+                 [lrange [info level 0] 0 1] statement ?dictionary?"
+
+	}
+	${-db} trace {}
+	set -Cursor 0
+	if {${-Cursor} < [llength ${-results}]
+	    && [lindex ${-results} ${-Cursor}] eq {statement}} {
+	    incr -Cursor 2
+	}
+	if {${-Cursor} < [llength ${-results}]
+	    && [lindex ${-results} ${-Cursor}] eq {columns}} {
+	    incr -Cursor
+	    set -columns [lindex ${-results} ${-Cursor}]
+	    incr -Cursor
+	}
+	set -RowCount [${-db} changes]
+    }
+
+    # Record the start of a SQL statement
+
+    method RecordStatement {stmt} {
+	set -needcolumns 1
+	lappend -results statement {}
+    }
+
+    # Record one row of results from a query by appending it as a dictionary
+    # to the 'results' list.  As a side effect, set 'columns' to a list
+    # comprising the names of the columns of the result.
+
+    method RecordResult {} {
+	set columns ${-resultArray(*)}
+	if {[info exists -needcolumns]} {
+	    lappend -results columns $columns
+	    unset -needcolumns
+	}
+	set dict {}
+	foreach key $columns {
+	    if {[set -resultArray($key)] ne "\ufffd"} {
+		dict set dict $key [set -resultArray($key)]
+	    }
+	}
+	lappend -results row $dict
+    }
+
+    # Advance to the next result set
+
+    method nextresults {} {
+	set have 0
+	while {${-Cursor} < [llength ${-results}]} {
+	    if {[lindex ${-results} ${-Cursor}] eq {statement}} {
+		set have 1
+		incr -Cursor 2
+		break
+	    }
+	    incr -Cursor 2
+	}
+	if {!$have} {
+	    set -END {}
+	}
+	if {${-Cursor} >= [llength ${-results}]} {
+	    set -columns {}
+	} elseif {[lindex ${-results} ${-Cursor}] eq {columns}} {
+	    incr -Cursor
+	    set -columns [lindex ${-results} ${-Cursor}]
+	    incr -Cursor
+	} else {
+	    set -columns {}
+	}
+	return $have
+    }
+
+    method getDBhandle {} {
+	return ${-db}
+    }
+
+    # Return a list of the columns
+
+    method columns {} {
+	if {[info exists -END]} {
+	    return -code error \
+		-errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \
+		"Function sequence error: result set is exhausted."
+	}
+	return ${-columns}
+    }
+
+    # Return the next row of the result set as a list
+
+    method nextlist var {
+
+	upvar 1 $var row
+
+	if {[info exists -END]} {
+	    return -code error \
+		-errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \
+		"Function sequence error: result set is exhausted."
+	}
+	if {${-Cursor} >= [llength ${-results}]
+	    || [lindex ${-results} ${-Cursor}] ne {row}} {
+	    return 0
+	} else {
+	    set row {}
+	    incr -Cursor
+	    set d [lindex ${-results} ${-Cursor}]
+	    incr -Cursor
+	    foreach key ${-columns} {
+		if {[dict exists $d $key]} {
+		    lappend row [dict get $d $key]
+		} else {
+		    lappend row {}
+		}
+	    }
+	}
+	return 1
+    }
+
+    # Return the next row of the result set as a dict
+
+    method nextdict var {
+
+	upvar 1 $var row
+
+	if {[info exists -END]} {
+	    return -code error \
+		-errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \
+		"Function sequence error: result set is exhausted."
+	}
+	if {${-Cursor} >= [llength ${-results}]
+	    || [lindex ${-results} ${-Cursor}] ne {row}} {
+	    return 0
+	} else {
+	    incr -Cursor
+	    set row [lindex ${-results} ${-Cursor}]
+	    incr -Cursor
+	}
+	return 1
+    }
+
+    # Return the number of rows affected by a statement
+
+    method rowcount {} {
+	if {[info exists -END]} {
+	    return -code error \
+		-errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \
+		"Function sequence error: result set is exhausted."
+	}
+	return ${-RowCount}
+    }
+
+}