summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2022-04-04 03:14:42 +0000
committerNorbert Preining <norbert@preining.info>2022-04-04 03:14:42 +0000
commit7548e4d37c2aaefd32fe0a9bcd83f8e71326dde1 (patch)
treed335b608e63e9b3c37d7ba0e567c63e77250e171 /systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm
parent506de1e2d3515161cdbc7018b4ccc9e49d7f86e8 (diff)
CTAN sync 202204040314
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm')
-rw-r--r--systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm715
1 files changed, 715 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.tm
new file mode 100644
index 0000000000..1794f07409
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8/8.6/tdbc/sqlite3-1.1.3.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.3
+
+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}
+ }
+
+}