module Database.HDBC.ODBC.Connection (connectODBC, Impl.Connection) where
import Database.HDBC.Types
import Database.HDBC
import Database.HDBC.DriverUtils
import qualified Database.HDBC.ODBC.ConnectionImpl as Impl
import Database.HDBC.ODBC.Api.Imports
import Database.HDBC.ODBC.Api.Errors
import Database.HDBC.ODBC.Api.Types
import Database.HDBC.ODBC.Statement
import Database.HDBC.ODBC.Wrappers
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal hiding (void)
import Foreign.Storable
import Database.HDBC.ODBC.Utils
import Foreign.ForeignPtr
import Foreign.Ptr
import Data.Word
import Data.Int
import Control.Concurrent.MVar
import Control.Monad (when, void)
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BUTF8
connectODBC :: String -> IO Impl.Connection
connectODBC args =
B.useAsCStringLen (BUTF8.fromString args) $ \(cs, cslen) -> do
env <- sqlAllocEnv
withEnvOrDie env $ \hEnv ->
sqlSetEnvAttr hEnv 200 (getSqlOvOdbc3) 0
dbc <- sqlAllocDbc env
withDbcOrDie dbc $ \hDbc ->
sqlDriverConnect hDbc nullPtr cs (fromIntegral cslen)
nullPtr 0 nullPtr 0
>>= checkError "connectODBC/sqlDriverConnect" (DbcHandle hDbc)
mkConn args dbc
mkConn :: String -> DbcWrapper -> IO Impl.Connection
mkConn args iconn = withDbcOrDie iconn $ \cconn ->
alloca $ \plen ->
alloca $ \psqlusmallint ->
allocaBytes 128 $ \pbuf ->
do
children <- newMVar []
sqlGetInfo cconn 18 (castPtr pbuf) 127 plen
>>= checkError "sqlGetInfo SQL_DBMS_VER" (DbcHandle cconn)
len <- peek plen
serverver <- peekCStringLen (pbuf, fromIntegral len)
sqlGetInfo cconn 7 (castPtr pbuf) 127 plen
>>= checkError "sqlGetInfo SQL_DRIVER_VER" (DbcHandle cconn)
len <- peek plen
proxiedclientver <- peekCStringLen (pbuf, fromIntegral len)
sqlGetInfo cconn 10 (castPtr pbuf) 127 plen
>>= checkError "sqlGetInfo SQL_ODBC_VER" (DbcHandle cconn)
len <- peek plen
clientver <- peekCStringLen (pbuf, fromIntegral len)
sqlGetInfo cconn 17 (castPtr pbuf) 127 plen
>>= checkError "sqlGetInfo SQL_DBMS_NAME" (DbcHandle cconn)
len <- peek plen
clientname <- peekCStringLen (pbuf, fromIntegral len)
sqlGetInfo cconn 46 (castPtr psqlusmallint)
0 nullPtr
>>= checkError "sqlGetInfo SQL_TXN_CAPABLE" (DbcHandle cconn)
txninfo <- ((peek psqlusmallint)::IO (Word16))
let txnsupport = txninfo /= 0
when txnsupport . void $ fSetAutoCommit cconn False
return $ Impl.Connection {
Impl.getQueryInfo = fGetQueryInfo iconn children,
Impl.disconnect = fdisconnect iconn children,
Impl.commit = fcommit iconn,
Impl.rollback = frollback iconn,
Impl.run = frun iconn children,
Impl.prepare = newSth iconn children,
Impl.clone = connectODBC args,
Impl.hdbcDriverName = "odbc",
Impl.hdbcClientVer = clientver,
Impl.proxiedClientName = clientname,
Impl.proxiedClientVer = proxiedclientver,
Impl.dbServerVer = serverver,
Impl.dbTransactionSupport = txnsupport,
Impl.getTables = fgettables iconn,
Impl.describeTable = fdescribetable iconn,
Impl.setAutoCommit = \x -> withDbcOrDie iconn $ \conn -> fSetAutoCommit conn x
}
frun conn children query args =
do sth <- newSth conn children query
res <- execute sth args
finish sth
return res
fcommit iconn = withDbcOrDie iconn $ \cconn ->
sqlEndTran 2 cconn 0
>>= checkError "sqlEndTran commit" (DbcHandle cconn)
frollback iconn = withDbcOrDie iconn $ \cconn ->
sqlEndTran 2 cconn 1
>>= checkError "sqlEndTran rollback" (DbcHandle cconn)
fdisconnect iconn mchildren = do
closeAllChildren mchildren
freeDbcIfNotAlready True iconn
fGetAutoCommit :: SQLHDBC -> IO Bool
fGetAutoCommit hdbc = do
value <- with (0 :: SQLUINTEGER) $ \acBuf -> do
c_sqlGetConnectAttr hdbc sQL_ATTR_AUTOCOMMIT (castPtr acBuf) sQL_IS_UINTEGER nullPtr
>>= checkError "sqlGetConnectAttr" (DbcHandle hdbc)
peek acBuf
return $ value /= sQL_AUTOCOMMIT_OFF
fSetAutoCommit :: SQLHDBC -> Bool -> IO Bool
fSetAutoCommit hdbc newValue = do
oldValue <- fGetAutoCommit hdbc
let newValueRaw = if newValue then sQL_AUTOCOMMIT_ON else sQL_AUTOCOMMIT_OFF
c_sqlSetConnectAttr hdbc sQL_ATTR_AUTOCOMMIT (wordPtrToPtr $ fromIntegral newValueRaw) sQL_IS_UINTEGER
>>= checkError "sqlSetConnectAttr" (DbcHandle hdbc)
return oldValue
foreign import ccall safe "sql.h SQLSetEnvAttr"
sqlSetEnvAttr :: SQLHENV -> Int32 ->
Ptr () -> Int32 -> IO Int16
foreign import ccall safe "sql.h SQLDriverConnect"
sqlDriverConnect :: SQLHDBC -> Ptr () -> CString -> Int16
-> CString -> Int16
-> Ptr Int16 -> Word16
-> IO Int16
foreign import ccall safe "hdbc-odbc-helper.h getSqlOvOdbc3"
getSqlOvOdbc3 :: Ptr ()
foreign import ccall safe "sql.h SQLEndTran"
sqlEndTran :: Int16 -> SQLHDBC -> Int16
-> IO Int16
foreign import ccall safe "sql.h SQLGetInfo"
sqlGetInfo :: SQLHDBC -> Word16 -> Ptr () ->
Int16 -> Ptr Int16 ->
IO Int16