1: # dio_Postgresql.tcl -- Postgres backend. 2: 3: # Copyright 2002-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_Postgresql.tcl,v 1.4 2004/11/04 20:26:53 karl Exp $ 18: 19: package provide dio_Postgresql 0.1 20: 21: namespace eval DIO { 22: ::itcl::class Postgresql { 23: inherit Database 24: 25: constructor {args} {eval configure $args} { 26: package require Pgtcl 27: set_conn_defaults 28: eval configure $args 29: } 30: 31: destructor { 32: close 33: } 34: 35: ## Setup our variables with the default conninfo from Postgres. 36: private method set_conn_defaults {} { 37: foreach list [pg_conndefaults] { 38: set var [lindex $list 0] 39: set val [lindex $list end] 40: switch -- $var { 41: "dbname" { set db $val } 42: default { set $var $val } 43: } 44: } 45: } 46: 47: method open {} { 48: set command "pg_connect" 49: 50: set info "" 51: if {![lempty $user]} { append info " user=$user" } 52: if {![lempty $pass]} { append info " password=$pass" } 53: if {![lempty $host]} { append info " host=$host" } 54: if {![lempty $port]} { append info " port=$port" } 55: if {![lempty $db]} { append info " dbname=$db" } 56: 57: if {![lempty $info]} { append command " -conninfo [::list $info]" } 58: 59: if {[catch $command error]} { return -code error $error } 60: 61: set conn $error 62: } 63: 64: method close {} { 65: if {![info exists conn]} { return } 66: pg_disconnect $conn 67: unset conn 68: } 69: 70: method exec {req} { 71: if {![info exists conn]} { open } 72: 73: set command pg_exec 74: if {[catch {$command $conn $req} result]} { return -code error $result } 75: 76: set errorinfo "" 77: set obj [result Postgresql -resultid $result] 78: if {[$obj error]} { set errorinfo [$obj errorinfo] } 79: return $obj 80: } 81: 82: method nextkey {} { 83: return [$this string "select nextval( '$sequence' )"] 84: } 85: 86: method lastkey {} { 87: return [$this string "select last_value from $sequence"] 88: } 89: 90: method sql_limit_syntax {limit {offset ""}} { 91: set sql " LIMIT $limit" 92: if {![lempty $offset]} { append sql " OFFSET $offset" } 93: return $sql 94: } 95: 96: # 97: # handle - return the internal database handle, in the postgres 98: # case, the postgres connection handle 99: # 100: method handle {} { 101: if {![info exists conn]} { open } 102: return $conn 103: } 104: 105: ## If they change DBs, we need to close the connection and re-open it. 106: public variable db "" { 107: if {[info exists conn]} { 108: close 109: open 110: } 111: } 112: 113: public variable interface "Postgresql" 114: private variable conn 115: 116: } ; ## ::itcl::class Postgresql 117: 118: # 119: # PostgresqlResult object -- superclass of ::DIO::Result object 120: # 121: # 122: ::itcl::class PostgresqlResult { 123: inherit Result 124: 125: constructor {args} { 126: eval configure $args 127: 128: if {[lempty $resultid]} { 129: return -code error "No resultid specified while creating result" 130: } 131: 132: set numrows [pg_result $resultid -numTuples] 133: set fields [pg_result $resultid -attributes] 134: set errorcode [pg_result $resultid -status] 135: set errorinfo [pg_result $resultid -error] 136: 137: if {$errorcode != "PGRES_COMMAND_OK" \ 138: && $errorcode != "PGRES_TUPLES_OK"} { set error 1 } 139: 140: ## Reconfigure incase we want to overset the default values. 141: eval configure $args 142: } 143: 144: destructor { 145: pg_result $resultid -clear 146: } 147: 148: method clear {} { 149: pg_result $resultid -clear 150: } 151: 152: method nextrow {} { 153: if {$rowid >= $numrows} { return } 154: return [pg_result $resultid -getTuple $rowid] 155: } 156: 157: } ; ## ::itcl::class PostgresqlResult 158: 159: } |