{-# 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-2006 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
-}

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.Types
import Database.HDBC.ODBC.Statement
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal
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)


{-# LINE 45 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 46 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 47 "Database/HDBC/ODBC/Connection.hsc" #-}


{-# LINE 51 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 52 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 53 "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"

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 -> IO Impl.Connection
connectODBC args = withCStringLen args $ \(cs, cslen) -> 
                   alloca $ \(penvptr::Ptr (Ptr CEnv)) ->
                   alloca $ \(pdbcptr::Ptr (Ptr CConn)) ->
         do -- Create the Environment Handle
            rc1 <- sqlAllocHandle 1
{-# LINE 87 "Database/HDBC/ODBC/Connection.hsc" #-}
                                  nullPtr  -- {const SQL_NULL_HANDLE}
                                   (castPtr penvptr)
            envptr <- peek penvptr 

            checkError "connectODBC/alloc env" (EnvHandle envptr) rc1
            sqlSetEnvAttr envptr 200
{-# LINE 93 "Database/HDBC/ODBC/Connection.hsc" #-}
                             (getSqlOvOdbc3) 0

            -- Create the DBC handle.
            sqlAllocHandle 2 (castPtr envptr) 
{-# LINE 97 "Database/HDBC/ODBC/Connection.hsc" #-}
                               (castPtr pdbcptr)
                          >>= checkError "connectODBC/alloc dbc"
                                  (EnvHandle envptr)
            dbcptr <- peek pdbcptr
            wrappeddbcptr <- wrapconn dbcptr envptr nullPtr
            fdbcptr <- newForeignPtr sqlFreeHandleDbc_ptr wrappeddbcptr

            -- Now connect.
            sqlDriverConnect dbcptr nullPtr cs (fromIntegral cslen)
                             nullPtr 0 nullPtr
                             0
{-# LINE 108 "Database/HDBC/ODBC/Connection.hsc" #-}
                              >>= checkError "connectODBC/sqlDriverConnect" 
                                  (DbcHandle dbcptr)
            mkConn args fdbcptr

-- FIXME: environment vars may have changed, should use pgsql enquiries
-- for clone.
mkConn :: String -> Conn -> IO Impl.Connection
mkConn args iconn = withConn iconn $ \cconn -> 
                    alloca $ \plen ->
                    alloca $ \psqlusmallint ->
                    allocaBytes 128 $ \pbuf -> 
    do 
       children <- newMVar []
       sqlGetInfo cconn 18 (castPtr pbuf) 127 plen
{-# LINE 122 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_DBMS_VER" (DbcHandle cconn)
       len <- peek plen
       serverver <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 7 (castPtr pbuf) 127 plen
{-# LINE 127 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_DRIVER_VER" (DbcHandle cconn)
       len <- peek plen
       proxiedclientver <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 10 (castPtr pbuf) 127 plen
{-# LINE 132 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_ODBC_VER" (DbcHandle cconn)
       len <- peek plen
       clientver <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 17 (castPtr pbuf) 127 plen
{-# LINE 137 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_DBMS_NAME" (DbcHandle cconn)
       len <- peek plen
       clientname <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 46 (castPtr psqlusmallint)
{-# LINE 142 "Database/HDBC/ODBC/Connection.hsc" #-}
                      0 nullPtr
         >>= checkError "sqlGetInfo SQL_TXN_CAPABLE" (DbcHandle cconn)
       txninfo <- ((peek psqlusmallint)::IO (Word16))
{-# LINE 145 "Database/HDBC/ODBC/Connection.hsc" #-}
       let txnsupport = txninfo /= 0
{-# LINE 146 "Database/HDBC/ODBC/Connection.hsc" #-}

       when txnsupport
         (disableAutoCommit cconn
          >>= checkError "sqlSetConnectAttr" (DbcHandle cconn)
         )
       return $ Impl.Connection {
                            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,
                            -- FIXME: add clone
                            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
                           }

--------------------------------------------------
-- Guts here
--------------------------------------------------

frun conn children query args =
    do sth <- newSth conn children query
       res <- execute sth args
       finish sth
       return res

fcommit iconn = withConn iconn $ \cconn ->
    sqlEndTran 2 cconn 0
{-# LINE 181 "Database/HDBC/ODBC/Connection.hsc" #-}
    >>= checkError "sqlEndTran commit" (DbcHandle cconn)

frollback iconn = withConn iconn $ \cconn ->
    sqlEndTran 2 cconn 1
{-# LINE 185 "Database/HDBC/ODBC/Connection.hsc" #-}
    >>= checkError "sqlEndTran rollback" (DbcHandle cconn)

fdisconnect iconn mchildren  = withRawConn iconn $ \rawconn -> 
                               withConn iconn $ \llconn ->
    do closeAllChildren mchildren
       res <- sqlFreeHandleDbc_app rawconn
       -- FIXME: will this checkError segfault?
       checkError "disconnect" (DbcHandle $ llconn) res

foreign import ccall unsafe "sql.h SQLAllocHandle"
{-# LINE 195 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlAllocHandle :: Int16 -> Ptr () -> 
{-# LINE 196 "Database/HDBC/ODBC/Connection.hsc" #-}
                    Ptr () -> IO (Int16)
{-# LINE 197 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall unsafe "hdbc-odbc-helper.h wrapobjodbc_extra"
  wrapconn :: Ptr CConn -> Ptr CEnv -> Ptr WrappedCConn -> IO (Ptr WrappedCConn)

foreign import ccall unsafe "hdbc-odbc-helper.h &sqlFreeHandleDbc_finalizer"
  sqlFreeHandleDbc_ptr :: FunPtr (Ptr WrappedCConn -> IO ())

foreign import ccall unsafe "hdbc-odbc-helper.h sqlFreeHandleDbc_app"
  sqlFreeHandleDbc_app :: Ptr WrappedCConn -> IO (Int16)
{-# LINE 206 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall unsafe "sql.h SQLSetEnvAttr"
{-# LINE 208 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlSetEnvAttr :: Ptr CEnv -> Int32 -> 
{-# LINE 209 "Database/HDBC/ODBC/Connection.hsc" #-}
                   Ptr () -> Int32 -> IO Int16
{-# LINE 210 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall unsafe "sql.h SQLDriverConnect"
{-# LINE 212 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlDriverConnect :: Ptr CConn -> Ptr () -> CString -> Int16
{-# LINE 213 "Database/HDBC/ODBC/Connection.hsc" #-}
                   -> CString -> Int16
{-# LINE 214 "Database/HDBC/ODBC/Connection.hsc" #-}
                   -> Ptr Int16 -> Word16
{-# LINE 215 "Database/HDBC/ODBC/Connection.hsc" #-}
                   -> IO Int16
{-# LINE 216 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall unsafe "hdbc-odbc-helper.h getSqlOvOdbc3"
  getSqlOvOdbc3 :: Ptr ()

foreign import ccall unsafe "hdbc-odbc-helper.h SQLSetConnectAttr"
  sqlSetConnectAttr :: Ptr CConn -> Int32 
{-# LINE 222 "Database/HDBC/ODBC/Connection.hsc" #-}
                    -> Ptr Word32 -> Int32
{-# LINE 223 "Database/HDBC/ODBC/Connection.hsc" #-}
                    -> IO Int16
{-# LINE 224 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall unsafe "sql.h SQLEndTran"
{-# LINE 226 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlEndTran :: Int16 -> Ptr CConn -> Int16
{-# LINE 227 "Database/HDBC/ODBC/Connection.hsc" #-}
             -> IO Int16
{-# LINE 228 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall unsafe "hdbc-odbc-helper.h disableAutoCommit"
  disableAutoCommit :: Ptr CConn -> IO Int16
{-# LINE 231 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall unsafe "sql.h SQLGetInfo"
{-# LINE 233 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlGetInfo :: Ptr CConn -> Word16 -> Ptr () ->
{-# LINE 234 "Database/HDBC/ODBC/Connection.hsc" #-}
                Int16 -> Ptr Int16 ->
{-# LINE 235 "Database/HDBC/ODBC/Connection.hsc" #-}
                IO Int16
{-# LINE 236 "Database/HDBC/ODBC/Connection.hsc" #-}