1: # dio_Mysql.tcl -- Mysql 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_Mysql.tcl,v 1.3 2004/10/29 20:17:54 karl Exp $ 18: 19: package provide dio_Mysql 0.1 20: 21: namespace eval DIO { 22: ::itcl::class Mysql { 23: inherit Database 24: 25: constructor {args} {eval configure $args} { 26: if {[catch {package require Mysqltcl}] \ 27: && [catch {package require mysql}]} { 28: return -code error "No MySQL Tcl package available" 29: } 30: 31: eval configure $args 32: 33: if {[lempty $db]} { 34: if {[lempty $user]} { 35: set user $::env(USER) 36: } 37: set db $user 38: } 39: } 40: 41: destructor { 42: close 43: } 44: 45: method open {} { 46: set command "mysqlconnect" 47: 48: if {![lempty $user]} { lappend command -user $user } 49: if {![lempty $pass]} { lappend command -password $pass } 50: if {![lempty $port]} { lappend command -port $port } 51: if {![lempty $host]} { lappend command $host } 52: 53: if {[catch $command error]} { return -code error $error } 54: 55: set conn $error 56: 57: if {![lempty $db]} { mysqluse $conn $db } 58: } 59: 60: method close {} { 61: if {![info exists conn]} { return } 62: catch {mysqlclose $conn} 63: unset conn 64: } 65: 66: method exec {req} { 67: if {![info exists conn]} { open } 68: 69: set cmd mysqlexec 70: if {[::string tolower [lindex $req 0]] == "select"} { set cmd mysqlsel } 71: 72: set errorinfo "" 73: if {[catch {$cmd $conn $req} error]} { 74: set errorinfo $error 75: set obj [result Mysql -error 1 -errorinfo [::list $error]] 76: return $obj 77: } 78: if {[catch {mysqlcol $conn -current name} fields]} { set fields "" } 79: set obj [result Mysql -resultid $conn \ 80: -numrows [::list $error] -fields [::list $fields]] 81: return $obj 82: } 83: 84: method lastkey {} { 85: if {![info exists conn]} { return } 86: return [mysqlinsertid $conn] 87: } 88: 89: method quote {string} { 90: if {![catch {mysqlquote $string} result]} { return $result } 91: regsub -all {'} $string {\'} string 92: return $string 93: } 94: 95: method sql_limit_syntax {limit {offset ""}} { 96: if {[lempty $offset]} { 97: return " LIMIT $limit" 98: } 99: return " LIMIT [expr $offset - 1],$limit" 100: } 101: 102: method handle {} { 103: if {![info exists conn]} { open } 104: 105: return $conn 106: } 107: 108: public variable db "" { 109: if {[info exists conn]} { 110: mysqluse $conn $db 111: } 112: } 113: 114: public variable interface "Mysql" 115: private variable conn 116: 117: } ; ## ::itcl::class Mysql 118: 119: ::itcl::class MysqlResult { 120: inherit Result 121: 122: constructor {args} { 123: eval configure $args 124: } 125: 126: destructor { 127: 128: } 129: 130: method nextrow {} { 131: return [mysqlnext $resultid] 132: } 133: 134: } ; ## ::itcl::class MysqlResult 135: 136: } |