{-# LINE 1 "Database/HDBC/ODBC/Connection.hsc" #-}-- -*- mode: haskell; -*-{-# LINE 2 "Database/HDBC/ODBC/Connection.hsc" #-}{-# CFILES hdbc-odbc-helper.c #-}-- Above line for hugs{-
Copyright (C) 2005-2009 John Goerzen <jgoerzen@complete.org>
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-}moduleDatabase.HDBC.ODBC.Connection(connectODBC,Impl.Connection)whereimportDatabase.HDBC.TypesimportDatabase.HDBCimportDatabase.HDBC.DriverUtilsimportqualifiedDatabase.HDBC.ODBC.ConnectionImplasImplimportDatabase.HDBC.ODBC.TypesimportDatabase.HDBC.ODBC.StatementimportForeign.C.TypesimportForeign.C.StringimportForeign.MarshalimportForeign.StorableimportDatabase.HDBC.ODBC.UtilsimportForeign.ForeignPtrimportForeign.PtrimportData.WordimportData.IntimportControl.Concurrent.MVarimportControl.Monad(when)importqualifiedData.ByteStringasBimportqualifiedData.ByteString.UTF8asBUTF8{-# LINE 47 "Database/HDBC/ODBC/Connection.hsc" #-}{-# LINE 48 "Database/HDBC/ODBC/Connection.hsc" #-}{-# LINE 49 "Database/HDBC/ODBC/Connection.hsc" #-}{-# LINE 53 "Database/HDBC/ODBC/Connection.hsc" #-}{-# LINE 54 "Database/HDBC/ODBC/Connection.hsc" #-}{-# LINE 55 "Database/HDBC/ODBC/Connection.hsc" #-}{- | Connect to an ODBC server.
For information on the meaning of the passed string, please see:
<http://msdn2.microsoft.com/en-us/library/ms715433(VS.85).aspx>
An example string is:
>"DSN=hdbctest1"
This, and all other functions that use ODBC directly or indirectly, can raise
SqlErrors just like other HDBC backends. The seErrorMsg field is specified
as a String in HDBC. ODBC specifies this data as a list of strings.
Therefore, this driver uses show on the data from ODBC. For friendly display,
or handling of individual component messages in your code, you can use
read on the seErrorMsg field in a context that expects @[String]@.
Important note for MySQL users:
Unless you are going to use InnoDB tables, you are strongly encouraged to set
>Option = 262144
in your odbc.ini (for Unix users), or to disable transaction support in your
DSN setup for Windows users.
If you fail to do this, the MySQL ODBC driver will incorrectly state that it
supports transactions. dbTransactionSupport will incorrectly return True.
commit and rollback will then silently fail. This is certainly /NOT/ what you
want. It is a bug (or misfeature) in the MySQL driver, not in HDBC.
You should ignore this advice if you are using InnoDB tables.
-}connectODBC::String->IOImpl.ConnectionconnectODBCargs=B.useAsCStringLen(BUTF8.fromStringargs)$\(cs,cslen)->alloca$\(penvptr::Ptr(PtrCEnv))->alloca$\(pdbcptr::Ptr(PtrCConn))->do-- Create the Environment Handlerc1<-sqlAllocHandle1{-# LINE 96 "Database/HDBC/ODBC/Connection.hsc" #-}nullPtr-- {const SQL_NULL_HANDLE}(castPtrpenvptr)envptr<-peekpenvptrcheckError"connectODBC/alloc env"(EnvHandleenvptr)rc1sqlSetEnvAttrenvptr200{-# LINE 102 "Database/HDBC/ODBC/Connection.hsc" #-}(getSqlOvOdbc3)0-- Create the DBC handle.sqlAllocHandle2(castPtrenvptr){-# LINE 106 "Database/HDBC/ODBC/Connection.hsc" #-}(castPtrpdbcptr)>>=checkError"connectODBC/alloc dbc"(EnvHandleenvptr)dbcptr<-peekpdbcptrwrappeddbcptr<-wrapconndbcptrenvptrnullPtrfdbcptr<-newForeignPtrsqlFreeHandleDbc_ptrwrappeddbcptr-- Now connect.sqlDriverConnectdbcptrnullPtrcs(fromIntegralcslen)nullPtr0nullPtr0{-# LINE 117 "Database/HDBC/ODBC/Connection.hsc" #-}>>=checkError"connectODBC/sqlDriverConnect"(DbcHandledbcptr)mkConnargsfdbcptr-- FIXME: environment vars may have changed, should use pgsql enquiries-- for clone.mkConn::String->Conn->IOImpl.ConnectionmkConnargsiconn=withConniconn$\cconn->alloca$\plen->alloca$\psqlusmallint->allocaBytes128$\pbuf->dochildren<-newMVar[]sqlGetInfocconn18(castPtrpbuf)127plen{-# LINE 131 "Database/HDBC/ODBC/Connection.hsc" #-}>>=checkError"sqlGetInfo SQL_DBMS_VER"(DbcHandlecconn)len<-peekplenserverver<-peekCStringLen(pbuf,fromIntegrallen)sqlGetInfocconn7(castPtrpbuf)127plen{-# LINE 136 "Database/HDBC/ODBC/Connection.hsc" #-}>>=checkError"sqlGetInfo SQL_DRIVER_VER"(DbcHandlecconn)len<-peekplenproxiedclientver<-peekCStringLen(pbuf,fromIntegrallen)sqlGetInfocconn10(castPtrpbuf)127plen{-# LINE 141 "Database/HDBC/ODBC/Connection.hsc" #-}>>=checkError"sqlGetInfo SQL_ODBC_VER"(DbcHandlecconn)len<-peekplenclientver<-peekCStringLen(pbuf,fromIntegrallen)sqlGetInfocconn17(castPtrpbuf)127plen{-# LINE 146 "Database/HDBC/ODBC/Connection.hsc" #-}>>=checkError"sqlGetInfo SQL_DBMS_NAME"(DbcHandlecconn)len<-peekplenclientname<-peekCStringLen(pbuf,fromIntegrallen)sqlGetInfocconn46(castPtrpsqlusmallint){-# LINE 151 "Database/HDBC/ODBC/Connection.hsc" #-}0nullPtr>>=checkError"sqlGetInfo SQL_TXN_CAPABLE"(DbcHandlecconn)txninfo<-((peekpsqlusmallint)::IO(Word16)){-# LINE 154 "Database/HDBC/ODBC/Connection.hsc" #-}lettxnsupport=txninfo/=0{-# LINE 155 "Database/HDBC/ODBC/Connection.hsc" #-}whentxnsupport(disableAutoCommitcconn>>=checkError"sqlSetConnectAttr"(DbcHandlecconn))return$Impl.Connection{Impl.getQueryInfo=fGetQueryInfoiconnchildren,Impl.disconnect=fdisconnecticonnchildren,Impl.commit=fcommiticonn,Impl.rollback=frollbackiconn,Impl.run=fruniconnchildren,Impl.prepare=newSthiconnchildren,Impl.clone=connectODBCargs,-- FIXME: add cloneImpl.hdbcDriverName="odbc",Impl.hdbcClientVer=clientver,Impl.proxiedClientName=clientname,Impl.proxiedClientVer=proxiedclientver,Impl.dbServerVer=serverver,Impl.dbTransactionSupport=txnsupport,Impl.getTables=fgettablesiconn,Impl.describeTable=fdescribetableiconn}---------------------------------------------------- Guts here--------------------------------------------------frunconnchildrenqueryargs=dosth<-newSthconnchildrenqueryres<-executesthargsfinishsthreturnresfcommiticonn=withConniconn$\cconn->sqlEndTran2cconn0{-# LINE 191 "Database/HDBC/ODBC/Connection.hsc" #-}>>=checkError"sqlEndTran commit"(DbcHandlecconn)frollbackiconn=withConniconn$\cconn->sqlEndTran2cconn1{-# LINE 195 "Database/HDBC/ODBC/Connection.hsc" #-}>>=checkError"sqlEndTran rollback"(DbcHandlecconn)fdisconnecticonnmchildren=withRawConniconn$\rawconn->withConniconn$\llconn->docloseAllChildrenmchildrenres<-sqlFreeHandleDbc_apprawconn-- FIXME: will this checkError segfault?checkError"disconnect"(DbcHandle$llconn)resforeignimportccallunsafe"sql.h SQLAllocHandle"{-# LINE 205 "Database/HDBC/ODBC/Connection.hsc" #-}sqlAllocHandle::Int16->Ptr()->{-# LINE 206 "Database/HDBC/ODBC/Connection.hsc" #-}Ptr()->IO(Int16){-# LINE 207 "Database/HDBC/ODBC/Connection.hsc" #-}foreignimportccallunsafe"hdbc-odbc-helper.h wrapobjodbc_extra"wrapconn::PtrCConn->PtrCEnv->PtrWrappedCConn->IO(PtrWrappedCConn)foreignimportccallunsafe"hdbc-odbc-helper.h &sqlFreeHandleDbc_finalizer"sqlFreeHandleDbc_ptr::FunPtr(PtrWrappedCConn->IO())foreignimportccallunsafe"hdbc-odbc-helper.h sqlFreeHandleDbc_app"sqlFreeHandleDbc_app::PtrWrappedCConn->IO(Int16){-# LINE 216 "Database/HDBC/ODBC/Connection.hsc" #-}foreignimportccallunsafe"sql.h SQLSetEnvAttr"{-# LINE 218 "Database/HDBC/ODBC/Connection.hsc" #-}sqlSetEnvAttr::PtrCEnv->Int32->{-# LINE 219 "Database/HDBC/ODBC/Connection.hsc" #-}Ptr()->Int32->IOInt16{-# LINE 220 "Database/HDBC/ODBC/Connection.hsc" #-}foreignimportccallunsafe"sql.h SQLDriverConnect"{-# LINE 222 "Database/HDBC/ODBC/Connection.hsc" #-}sqlDriverConnect::PtrCConn->Ptr()->CString->Int16{-# LINE 223 "Database/HDBC/ODBC/Connection.hsc" #-}->CString->Int16{-# LINE 224 "Database/HDBC/ODBC/Connection.hsc" #-}->PtrInt16->Word16{-# LINE 225 "Database/HDBC/ODBC/Connection.hsc" #-}->IOInt16{-# LINE 226 "Database/HDBC/ODBC/Connection.hsc" #-}foreignimportccallunsafe"hdbc-odbc-helper.h getSqlOvOdbc3"getSqlOvOdbc3::Ptr()foreignimportccallunsafe"hdbc-odbc-helper.h SQLSetConnectAttr"sqlSetConnectAttr::PtrCConn->Int32{-# LINE 232 "Database/HDBC/ODBC/Connection.hsc" #-}->PtrWord32->Int32{-# LINE 233 "Database/HDBC/ODBC/Connection.hsc" #-}->IOInt16{-# LINE 234 "Database/HDBC/ODBC/Connection.hsc" #-}foreignimportccallunsafe"sql.h SQLEndTran"{-# LINE 236 "Database/HDBC/ODBC/Connection.hsc" #-}sqlEndTran::Int16->PtrCConn->Int16{-# LINE 237 "Database/HDBC/ODBC/Connection.hsc" #-}->IOInt16{-# LINE 238 "Database/HDBC/ODBC/Connection.hsc" #-}foreignimportccallunsafe"hdbc-odbc-helper.h disableAutoCommit"disableAutoCommit::PtrCConn->IOInt16{-# LINE 241 "Database/HDBC/ODBC/Connection.hsc" #-}foreignimportccallunsafe"sql.h SQLGetInfo"{-# LINE 243 "Database/HDBC/ODBC/Connection.hsc" #-}sqlGetInfo::PtrCConn->Word16->Ptr()->{-# LINE 244 "Database/HDBC/ODBC/Connection.hsc" #-}Int16->PtrInt16->{-# LINE 245 "Database/HDBC/ODBC/Connection.hsc" #-}IOInt16{-# LINE 246 "Database/HDBC/ODBC/Connection.hsc" #-}