1: # dio_Sqlite.tcl -- DIO interface for sqlite 2: 3: # Copyright 2004 The Apache Software Foundation 4: 5: # Licensed under the Apache License, Version 2.0 (the "License"); 6: # you may not use this file except in compliance with the License. 7: # You may obtain a copy of the License at 8: 9: # http://www.apache.org/licenses/LICENSE-2.0 10: 11: # Unless required by applicable law or agreed to in writing, software 12: # distributed under the License is distributed on an "AS IS" BASIS, 13: # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14: # See the License for the specific language governing permissions and 15: # limitations under the License. 16: 17: # $Id: dio_Sqlite.tcl,v 1.1 2004/04/21 17:05:09 davidw Exp $ 18: 19: package provide dio_Sqlite 0.1 20: 21: namespace eval DIO { 22: ::itcl::class Sqlite { 23: inherit Database 24: 25: private variable dbcmd "" 26: private variable dbname sqlitedb 27: constructor {args} {eval configure $args} { 28: package require sqlite 29: eval configure $args 30: } 31: 32: destructor { 33: catch { $dbcmd close } 34: } 35: 36: method open {} { 37: ::sqlite [::itcl::scope dbcmd] $db 38: set db [::itcl::scope dbcmd] 39: } 40: 41: method close {} { 42: catch { $dbcmd close } 43: } 44: 45: method exec {req} { 46: if { $dbcmd == "" } { 47: open 48: } 49: 50: if { [catch {$dbcmd eval $req} result] } { 51: return -code error $result 52: } 53: set errorInfo "" 54: 55: set obj [result sqlite -resultid $result] 56: if {[$obj error]} { 57: set errorinfo [$obj errorinfo] 58: } 59: return $obj 60: } 61: 62: method nextkey {} { 63: return [$this string "select nextval( '$sequence' )"] 64: } 65: 66: method lastkey {} { 67: return [$this string "select last_value from $sequence"] 68: } 69: 70: ## If they change DBs, we need to close the connection and re-open it. 71: public variable db "" { 72: if {[info exists conn]} { 73: close 74: open 75: } 76: } 77: 78: } 79: 80: 81: 82: # THIS BIT IS UNFINISHED XXX. 83: 84: ::itcl::class SqliteResult { 85: inherit Result 86: 87: constructor {args} { 88: eval configure $args 89: 90: if {[lempty $resultid]} { 91: return -code error "No resultid specified while creating result" 92: } 93: 94: set numrows [pg_result $resultid -numTuples] 95: set fields [pg_result $resultid -attributes] 96: set errorcode [pg_result $resultid -status] 97: set errorinfo [pg_result $resultid -error] 98: 99: if {$errorcode != "PGRES_COMMAND_OK" \ 100: && $errorcode != "PGRES_TUPLES_OK"} { set error 1 } 101: 102: ## Reconfigure incase we want to overset the default values. 103: eval configure $args 104: } 105: 106: destructor { 107: pg_result $resultid -clear 108: } 109: 110: method clear {} { 111: pg_result $resultid -clear 112: } 113: 114: method nextrow {} { 115: if {$rowid >= $numrows} { return } 116: return [pg_result $resultid -getTuple $rowid] 117: } 118: 119: } ; ## ::itcl::class PostgresqlResult 120: 121: 122: 123: 124: } |