From: Harald O. <har...@el...> - 2012-09-18 09:38:20
|
Am 18.09.2012 11:25, schrieb Alexandre Ferrieux: > On Tue, Sep 18, 2012 at 9:22 AM, Harald Oehlmann > <har...@el...> wrote: >> >> % info errorstack >> INNER {invokeStk1 info errorStack} > > Side note: you obtained this because you typed 'error*S*tack' instead > of 'errorstack', which itself raised an error and overwrote the > previous error stack ;) > > Please retry without the typo, you'll see a more interesting stack > (though here it might not be much more than errorInfo since most args > are constant). Thank you ;-) And what I am seeing informs me that it is "experts only"... Harald ---- (bin) 1 % package require tdbc::sqlite3 ::tdbc::connection does not refer to an object (bin) 2 % info errorstack INNER {::oo::Obj6::my Set ::tdbc::connection} UP 1 CALL {my -set ::tdbc::connection} UP 1 CALL {superclass ::tdbc::connection} CALL {::oo::define ::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] } }} (bin) 3 % set errorInfo ::tdbc::connection does not refer to an object while executing "::oo::Obj6::my Set ::tdbc::connection" ("uplevel" body line 1) invoked from within "uplevel 1 [list [namespace which my] Set $args]" (class "::oo::Slot" method "-set" line 2) invoked from within "::oo::Obj6::my --default-operation ::tdbc::connection" ("uplevel" body line 1) invoked from within "uplevel 1 [list [namespace which my] $def {*}$args]" (class "::oo::Slot" method "unknown" line 6) invoked from within "superclass ::tdbc::connection" (in definition script for class "::tdbc::sqlite3::connection" line 3) invoked from within "::oo::class create ::tdbc::sqlite3::connection { superclass ::tdbc::connection variable timeout # The constructor accepts a database na..." (file "C:/test/tcl86b3/lib/tcl8/8.6/tdbc/sqlite3-1.0b17.tm" line 30) invoked from within "source -encoding utf-8 C:/test/tcl86b3/lib/tcl8/8.6/tdbc/sqlite3-1.0b17.tm" ("package ifneeded tdbc::sqlite3 1.0b17" script) invoked from within "package require tdbc::sqlite3" |