diff --git a/COPYRIGHT b/COPYRIGHT --- a/COPYRIGHT +++ b/COPYRIGHT @@ -1,4 +1,4 @@ -Copyright (C) 2005-2007 John Goerzen +Copyright (C) 2005-2008 John Goerzen This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public diff --git a/Database/HDBC/ODBC/Connection.hs b/Database/HDBC/ODBC/Connection.hs new file mode 100644 --- /dev/null +++ b/Database/HDBC/ODBC/Connection.hs @@ -0,0 +1,266 @@ +{-# OPTIONS_GHC -optc-D__HUGS__ #-} +{-# INCLUDE #-} +{-# INCLUDE #-} +{-# 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 + + 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" #-} + +{- | Connect to an ODBC server. + +For information on the meaning of the passed string, please see: + + + +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 81 "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 87 "Database/HDBC/ODBC/Connection.hsc" #-} + (getSqlOvOdbc3) 0 + + -- Create the DBC handle. + sqlAllocHandle 2 (castPtr envptr) +{-# LINE 91 "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 102 "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 116 "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 121 "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 126 "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 131 "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 136 "Database/HDBC/ODBC/Connection.hsc" #-} + 0 nullPtr + >>= checkError "sqlGetInfo SQL_TXN_CAPABLE" (DbcHandle cconn) + txninfo <- ((peek psqlusmallint)::IO (Word16)) +{-# LINE 139 "Database/HDBC/ODBC/Connection.hsc" #-} + let txnsupport = txninfo /= 0 +{-# LINE 140 "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 175 "Database/HDBC/ODBC/Connection.hsc" #-} + >>= checkError "sqlEndTran commit" (DbcHandle cconn) + +frollback iconn = withConn iconn $ \cconn -> + sqlEndTran 2 cconn 1 +{-# LINE 179 "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" + sqlAllocHandle :: Int16 -> Ptr () -> +{-# LINE 190 "Database/HDBC/ODBC/Connection.hsc" #-} + Ptr () -> IO (Int16) +{-# LINE 191 "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 200 "Database/HDBC/ODBC/Connection.hsc" #-} + +foreign import ccall unsafe "sql.h SQLSetEnvAttr" + sqlSetEnvAttr :: Ptr CEnv -> Int32 -> +{-# LINE 203 "Database/HDBC/ODBC/Connection.hsc" #-} + Ptr () -> Int32 -> IO Int16 +{-# LINE 204 "Database/HDBC/ODBC/Connection.hsc" #-} + +foreign import ccall unsafe "sql.h SQLDriverConnect" + sqlDriverConnect :: Ptr CConn -> Ptr () -> CString -> Int16 +{-# LINE 207 "Database/HDBC/ODBC/Connection.hsc" #-} + -> CString -> Int16 +{-# LINE 208 "Database/HDBC/ODBC/Connection.hsc" #-} + -> Ptr Int16 -> Word16 +{-# LINE 209 "Database/HDBC/ODBC/Connection.hsc" #-} + -> IO Int16 +{-# LINE 210 "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 216 "Database/HDBC/ODBC/Connection.hsc" #-} + -> Ptr Word32 -> Int32 +{-# LINE 217 "Database/HDBC/ODBC/Connection.hsc" #-} + -> IO Int16 +{-# LINE 218 "Database/HDBC/ODBC/Connection.hsc" #-} + +foreign import ccall unsafe "sql.h SQLEndTran" + sqlEndTran :: Int16 -> Ptr CConn -> Int16 +{-# LINE 221 "Database/HDBC/ODBC/Connection.hsc" #-} + -> IO Int16 +{-# LINE 222 "Database/HDBC/ODBC/Connection.hsc" #-} + +foreign import ccall unsafe "hdbc-odbc-helper.h disableAutoCommit" + disableAutoCommit :: Ptr CConn -> IO Int16 +{-# LINE 225 "Database/HDBC/ODBC/Connection.hsc" #-} + +foreign import ccall unsafe "sql.h SQLGetInfo" + sqlGetInfo :: Ptr CConn -> Word16 -> Ptr () -> +{-# LINE 228 "Database/HDBC/ODBC/Connection.hsc" #-} + Int16 -> Ptr Int16 -> +{-# LINE 229 "Database/HDBC/ODBC/Connection.hsc" #-} + IO Int16 +{-# LINE 230 "Database/HDBC/ODBC/Connection.hsc" #-} diff --git a/Database/HDBC/ODBC/Statement.hs b/Database/HDBC/ODBC/Statement.hs new file mode 100644 --- /dev/null +++ b/Database/HDBC/ODBC/Statement.hs @@ -0,0 +1,450 @@ +{-# OPTIONS_GHC -optc-D__HUGS__ #-} +{-# INCLUDE #-} +{-# INCLUDE #-} +{-# LINE 1 "Database/HDBC/ODBC/Statement.hsc" #-} +-- -*- mode: haskell; -*- +{-# LINE 2 "Database/HDBC/ODBC/Statement.hsc" #-} +{-# CFILES hdbc-odbc-helper.c #-} +-- Above line for hugs +{- +Copyright (C) 2005-2006 John Goerzen + + 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.Statement where +import Database.HDBC.Types +import Database.HDBC +import Database.HDBC.DriverUtils +import Database.HDBC.ODBC.Types +import Database.HDBC.ODBC.Utils +import Database.HDBC.ODBC.TypeConv +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr +import Control.Concurrent.MVar +import Foreign.C.String +import Foreign.Marshal +import Foreign.Storable +import Control.Monad +import Data.List +import Data.Word +import Data.Int +import Control.Exception +import System.IO +import Data.Maybe + +l _ = return () +--l m = hPutStrLn stderr ("\n" ++ m) + + +{-# LINE 49 "Database/HDBC/ODBC/Statement.hsc" #-} + +{-# LINE 50 "Database/HDBC/ODBC/Statement.hsc" #-} + +{-# LINE 51 "Database/HDBC/ODBC/Statement.hsc" #-} + +data SState = + SState { stomv :: MVar (Maybe Stmt), + dbo :: Conn, + squery :: String, + colinfomv :: MVar [(String, SqlColDesc)]} + +-- FIXME: we currently do no prepare optimization whatsoever. + +newSState :: Conn -> String -> IO SState +newSState indbo query = + do newstomv <- newMVar Nothing + newcolinfomv <- newMVar [] + return SState {stomv = newstomv, + dbo = indbo, squery = query, + colinfomv = newcolinfomv} + +wrapStmt :: SState -> Statement +wrapStmt sstate = + Statement {execute = fexecute sstate, + executeMany = fexecutemany sstate, + finish = public_ffinish sstate, + fetchRow = ffetchrow sstate, + originalQuery = (squery sstate), + getColumnNames = readMVar (colinfomv sstate) + >>= (return . map fst), + describeResult = readMVar (colinfomv sstate)} + +newSth :: Conn -> ChildList -> String -> IO Statement +newSth indbo mchildren query = + do l "in newSth" + sstate <- newSState indbo query + let retval = wrapStmt sstate + addChild mchildren retval + return retval + +makesth iconn name = alloca $ \(psthptr::Ptr (Ptr CStmt)) -> + withConn iconn $ \cconn -> + withCString "" $ \emptycs -> + do rc1 <- sqlAllocStmtHandle 3 cconn psthptr +{-# LINE 91 "Database/HDBC/ODBC/Statement.hsc" #-} + sthptr <- peek psthptr + wrappedsthptr <- withRawConn iconn + (\rawconn -> wrapstmt sthptr rawconn) + fsthptr <- newForeignPtr sqlFreeHandleSth_ptr wrappedsthptr + checkError (name ++ " allocHandle") (DbcHandle cconn) rc1 + return fsthptr + +wrapTheStmt iconn fsthptr = + do sstate <- newSState iconn "" + sstate <- newSState iconn "" + swapMVar (stomv sstate) (Just fsthptr) + let sth = wrapStmt sstate + return sth + +fgettables iconn = + do fsthptr <- makesth iconn "fgettables" + withStmt fsthptr (\sthptr -> + simpleSqlTables sthptr >>= + checkError "gettables simpleSqlTables" + (StmtHandle sthptr) + ) + sth <- wrapTheStmt iconn fsthptr + results <- fetchAllRows' sth + l (show results) + return $ map (\x -> fromSql (x !! 2)) results + +fdescribetable iconn tablename = withCStringLen tablename $ \(cs, csl) -> + do fsthptr <- makesth iconn "fdescribetable" + withStmt fsthptr (\sthptr -> + simpleSqlColumns sthptr cs (fromIntegral csl) >>= + checkError "fdescribetable simpleSqlColumns" + (StmtHandle sthptr) + ) + sth <- wrapTheStmt iconn fsthptr + results <- fetchAllRows' sth + l (show results) + return $ map fromOTypeCol results + +{- For now, we try to just handle things as simply as possible. +FIXME lots of room for improvement here (types, etc). -} +fexecute sstate args = withConn (dbo sstate) $ \cconn -> + withCStringLen (squery sstate) $ \(cquery, cqlen) -> + alloca $ \(psthptr::Ptr (Ptr CStmt)) -> + do l "in fexecute" + public_ffinish sstate + rc1 <- sqlAllocStmtHandle 3 cconn psthptr +{-# LINE 137 "Database/HDBC/ODBC/Statement.hsc" #-} + sthptr <- peek psthptr + wrappedsthptr <- withRawConn (dbo sstate) + (\rawconn -> wrapstmt sthptr rawconn) + fsthptr <- newForeignPtr sqlFreeHandleSth_ptr wrappedsthptr + checkError "execute allocHandle" (DbcHandle cconn) rc1 + + sqlPrepare sthptr cquery (fromIntegral cqlen) >>= + checkError "execute prepare" (StmtHandle sthptr) + + argsToFree <- zipWithM (bindCol sthptr) args [1..] + + r <- sqlExecute sthptr + + -- Our bound columns must be valid through this point, + -- but we don't care after here. + mapM (\(x, y) -> touchForeignPtr x >> touchForeignPtr y) + (concat argsToFree) + + case r of + 100 -> return () -- Update that did nothing +{-# LINE 157 "Database/HDBC/ODBC/Statement.hsc" #-} + x -> checkError "execute execute" (StmtHandle sthptr) x + + rc <- getNumResultCols sthptr + + case rc of + 0 -> do rowcount <- getSqlRowCount sthptr + ffinish fsthptr + swapMVar (colinfomv sstate) [] + touchForeignPtr fsthptr + return (fromIntegral rowcount) + colcount -> do fgetcolinfo sthptr >>= swapMVar (colinfomv sstate) + swapMVar (stomv sstate) (Just fsthptr) + touchForeignPtr fsthptr + return 0 + +getNumResultCols sthptr = alloca $ \pcount -> + do sqlNumResultCols sthptr pcount >>= checkError "SQLNumResultCols" + (StmtHandle sthptr) + peek pcount + +-- Bind a parameter column before execution. + +bindCol sthptr arg icol = alloca $ \pdtype -> + alloca $ \pcolsize -> + alloca $ \pdecdigits -> +{- We have to start by getting the SQL type of the column so we can + send the correct type back to the server. Sigh. If the ODBC + backend won't tell us the type, we fake it. + + We've got an annoying situation with error handling. Must make + sure that all data is freed, but if there's an error, we have to raise + it and the caller never gets to freed the allocated data to-date. + So, make sure we either free of have foreignized everything before + control passes out of this function. -} + + do rc1 <- sqlDescribeParam sthptr icol pdtype pcolsize pdecdigits + nullPtr + when (not (isOK rc1)) $ -- Some drivers don't support that call + do poke pdtype 1 +{-# LINE 196 "Database/HDBC/ODBC/Statement.hsc" #-} + poke pcolsize 0 + poke pdecdigits 0 + coltype <- peek pdtype + colsize <- peek pcolsize + decdigits <- peek pdecdigits + case arg of + SqlNull -> -- NULL parameter, bind it as such. + do rc2 <- sqlBindParameter sthptr (fromIntegral icol) + 1 +{-# LINE 205 "Database/HDBC/ODBC/Statement.hsc" #-} + 1 coltype colsize decdigits +{-# LINE 206 "Database/HDBC/ODBC/Statement.hsc" #-} + nullPtr 0 nullData + checkError ("bindparameter " ++ show icol) + (StmtHandle sthptr) rc2 + return [] + x -> do -- Otherwise, we have to allocate RAM, make sure it's + -- not freed now, and pass it along... + (csptr, cslen) <- newCStringLen (fromSql x) + do pcslen <- malloc + poke pcslen (fromIntegral cslen) + rc2 <- sqlBindParameter sthptr (fromIntegral icol) + 1 +{-# LINE 217 "Database/HDBC/ODBC/Statement.hsc" #-} + 1 coltype colsize decdigits +{-# LINE 218 "Database/HDBC/ODBC/Statement.hsc" #-} + csptr (fromIntegral cslen + 1) pcslen + if isOK rc2 + then do -- We bound it. Make foreignPtrs and return. + fp1 <- newForeignPtr finalizerFree pcslen + fp2 <- newForeignPtr finalizerFree csptr + return [(fp1, fp2)] + else do -- Binding failed. Free the data and raise + -- error. + free pcslen + free csptr + checkError ("bindparameter " ++ show icol) + (StmtHandle sthptr) rc2 + return [] -- will never get hit + +getSqlRowCount cstmt = alloca $ \prows -> + do sqlRowCount cstmt prows >>= checkError "SQLRowCount" (StmtHandle cstmt) + peek prows + +{- General algorithm: find out how many columns we have, check the type +of each to see if it's NULL. If it's not, fetch it as text and return that. +-} + +ffetchrow :: SState -> IO (Maybe [SqlValue]) +ffetchrow sstate = modifyMVar (stomv sstate) $ \stmt -> + case stmt of + Nothing -> l "ffr nos" >> return (stmt, Nothing) + Just cmstmt -> withStmt cmstmt $ \cstmt -> + do rc <- sqlFetch cstmt + if rc == 100 +{-# LINE 247 "Database/HDBC/ODBC/Statement.hsc" #-} + then do l "no more rows" + -- Don't use public_ffinish here + ffinish cmstmt + return (Nothing, Nothing) + else do l "getting stuff" + checkError "sqlFetch" (StmtHandle cstmt) rc + ncols <- getNumResultCols cstmt + res <- mapM (getCol cstmt ) + [1..ncols] + return (stmt, Just res) + where getCol cstmt icol = alloca $ \psize -> + do sqlDescribeCol cstmt icol nullPtr 0 nullPtr nullPtr + psize nullPtr nullPtr + >>= checkError "sqlDescribeCol" + (StmtHandle cstmt) + size <- peek psize + l $ "colsize: " ++ show size + let bufsize = size + 127 -- Try to give extra space + alloca $ \plen -> + allocaBytes (fromIntegral bufsize + 1) $ \cs -> + do sqlGetData cstmt (fromIntegral icol) 1 +{-# LINE 268 "Database/HDBC/ODBC/Statement.hsc" #-} + cs (fromIntegral bufsize) plen + reslen <- peek plen + case reslen of + -1 -> return SqlNull +{-# LINE 272 "Database/HDBC/ODBC/Statement.hsc" #-} + -4 -> fail $ "Unexpected SQL_NO_TOTAL" +{-# LINE 273 "Database/HDBC/ODBC/Statement.hsc" #-} + len -> do s <- peekCStringLen (cs, fromIntegral len) + l $ "col is: " ++ s + return (SqlString s) + + +fgetcolinfo cstmt = + do ncols <- getNumResultCols cstmt + mapM getname [1..ncols] + where getname icol = alloca $ \colnamelp -> + allocaBytes 128 $ \cscolname -> + alloca $ \datatypeptr -> + alloca $ \colsizeptr -> + alloca $ \nullableptr -> + do sqlDescribeCol cstmt icol cscolname 127 colnamelp + datatypeptr colsizeptr nullPtr nullableptr + colnamelen <- peek colnamelp + colname <- peekCStringLen (cscolname, fromIntegral colnamelen) + datatype <- peek datatypeptr + colsize <- peek colsizeptr + nullable <- peek nullableptr + return $ fromOTypeInfo colname datatype colsize nullable + +-- FIXME: needs a faster algorithm. +fexecutemany :: SState -> [[SqlValue]] -> IO () +fexecutemany sstate arglist = + mapM_ (fexecute sstate) arglist >> return () + +-- Finish and change state +public_ffinish sstate = + do l "public_ffinish" + modifyMVar_ (stomv sstate) worker + where worker Nothing = return Nothing + worker (Just sth) = ffinish sth >> return Nothing + +ffinish :: Stmt -> IO () +ffinish p = withRawStmt p $ sqlFreeHandleSth_app + + +foreign import ccall unsafe "hdbc-odbc-helper.h wrapobjodbc" + wrapstmt :: Ptr CStmt -> Ptr WrappedCConn -> IO (Ptr WrappedCStmt) + +foreign import ccall unsafe "sql.h SQLDescribeCol" + sqlDescribeCol :: Ptr CStmt + -> Int16 -- ^ Column number +{-# LINE 317 "Database/HDBC/ODBC/Statement.hsc" #-} + -> CString -- ^ Column name + -> Int16 -- ^ Buffer length +{-# LINE 319 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr (Int16) -- ^ name length ptr +{-# LINE 320 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr (Int16) -- ^ data type ptr +{-# LINE 321 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr (Word32) -- ^ column size ptr +{-# LINE 322 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr (Int16) -- ^ decimal digits ptr +{-# LINE 323 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr (Int16) -- ^ nullable ptr +{-# LINE 324 "Database/HDBC/ODBC/Statement.hsc" #-} + -> IO Int16 +{-# LINE 325 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLGetData" + sqlGetData :: Ptr CStmt -- ^ statement handle + -> Word16 -- ^ Column number +{-# LINE 329 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Int16 -- ^ target type +{-# LINE 330 "Database/HDBC/ODBC/Statement.hsc" #-} + -> CString -- ^ target value pointer (void * in C) + -> Int32 -- ^ buffer len +{-# LINE 332 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr (Int32) +{-# LINE 333 "Database/HDBC/ODBC/Statement.hsc" #-} + -> IO Int16 +{-# LINE 334 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "hdbc-odbc-helper.h sqlFreeHandleSth_app" + sqlFreeHandleSth_app :: Ptr WrappedCStmt -> IO () + +foreign import ccall unsafe "hdbc-odbc-helper.h &sqlFreeHandleSth_finalizer" + sqlFreeHandleSth_ptr :: FunPtr (Ptr WrappedCStmt -> IO ()) + +foreign import ccall unsafe "sql.h SQLPrepare" + sqlPrepare :: Ptr CStmt -> CString -> Int32 +{-# LINE 343 "Database/HDBC/ODBC/Statement.hsc" #-} + -> IO Int16 +{-# LINE 344 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLExecute" + sqlExecute :: Ptr CStmt -> IO Int16 +{-# LINE 347 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLAllocHandle" + sqlAllocStmtHandle :: Int16 -> Ptr CConn -> +{-# LINE 350 "Database/HDBC/ODBC/Statement.hsc" #-} + Ptr (Ptr CStmt) -> IO Int16 +{-# LINE 351 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLNumResultCols" + sqlNumResultCols :: Ptr CStmt -> Ptr Int16 +{-# LINE 354 "Database/HDBC/ODBC/Statement.hsc" #-} + -> IO Int16 +{-# LINE 355 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLRowCount" + sqlRowCount :: Ptr CStmt -> Ptr Int32 -> IO Int16 +{-# LINE 358 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLBindParameter" + sqlBindParameter :: Ptr CStmt -- ^ Statement handle + -> Word16 -- ^ Parameter Number +{-# LINE 362 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Int16 -- ^ Input or output +{-# LINE 363 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Int16 -- ^ Value type +{-# LINE 364 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Int16 -- ^ Parameter type +{-# LINE 365 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Word32 -- ^ column size +{-# LINE 366 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Int16 -- ^ decimal digits +{-# LINE 367 "Database/HDBC/ODBC/Statement.hsc" #-} + -> CString -- ^ Parameter value pointer + -> Int32 -- ^ buffer length +{-# LINE 369 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr Int32 -- ^ strlen_or_indptr +{-# LINE 370 "Database/HDBC/ODBC/Statement.hsc" #-} + -> IO Int16 +{-# LINE 371 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "hdbc-odbc-helper.h &nullData" + nullData :: Ptr Int32 +{-# LINE 374 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLDescribeParam" + sqlDescribeParam :: Ptr CStmt + -> Word16 -- ^ parameter number +{-# LINE 378 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr Int16 -- ^ data type ptr +{-# LINE 379 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr Word32 -- ^ parameter size ptr +{-# LINE 380 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr Int16 -- ^ dec digits ptr +{-# LINE 381 "Database/HDBC/ODBC/Statement.hsc" #-} + -> Ptr Int16 -- ^ nullable ptr +{-# LINE 382 "Database/HDBC/ODBC/Statement.hsc" #-} + -> IO Int16 +{-# LINE 383 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "sql.h SQLFetch" + sqlFetch :: Ptr CStmt -> IO Int16 +{-# LINE 386 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "hdbc-odbc-helper.h simpleSqlTables" + simpleSqlTables :: Ptr CStmt -> IO Int16 +{-# LINE 389 "Database/HDBC/ODBC/Statement.hsc" #-} + +foreign import ccall unsafe "hdbc-odbc-helper.h simpleSqlColumns" + simpleSqlColumns :: Ptr CStmt -> Ptr CChar -> + Int16 -> IO Int16 +{-# LINE 393 "Database/HDBC/ODBC/Statement.hsc" #-} diff --git a/Database/HDBC/ODBC/TypeConv.hs b/Database/HDBC/ODBC/TypeConv.hs new file mode 100644 --- /dev/null +++ b/Database/HDBC/ODBC/TypeConv.hs @@ -0,0 +1,169 @@ +{-# OPTIONS_GHC -optc-D__HUGS__ #-} +{-# INCLUDE #-} +{-# INCLUDE #-} +{-# INCLUDE #-} +{-# LINE 1 "Database/HDBC/ODBC/TypeConv.hsc" #-} +-- -*- mode: haskell; -*- +{-# LINE 2 "Database/HDBC/ODBC/TypeConv.hsc" #-} +{-# CFILES hdbc-odbc-helper.c #-} +-- Above line for hugs +{- +Copyright (C) 2006 John Goerzen + + 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.TypeConv(fromOTypeInfo, fromOTypeCol) where +import Database.HDBC.Types +import Database.HDBC +import Database.HDBC.DriverUtils +import Database.HDBC.ODBC.Types +import Database.HDBC.ODBC.Utils +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Ptr +import Control.Concurrent.MVar +import Foreign.C.String +import Foreign.Marshal +import Foreign.Storable +import Control.Monad +import Data.List +import Data.Word +import Data.Int +import Control.Exception +import System.IO +import Data.Maybe + +l _ = return () +--l m = hPutStrLn stderr ("\n" ++ m) + + +{-# LINE 48 "Database/HDBC/ODBC/TypeConv.hsc" #-} + +{-# LINE 49 "Database/HDBC/ODBC/TypeConv.hsc" #-} + +{-# LINE 50 "Database/HDBC/ODBC/TypeConv.hsc" #-} + +{-# LINE 51 "Database/HDBC/ODBC/TypeConv.hsc" #-} + +fromOTypeInfo :: String -- ^ Column name + -> Int16 -- ^ Data type +{-# LINE 54 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -> Word32 -- ^ Column size +{-# LINE 55 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -> Int16 -- ^ Is it nullable +{-# LINE 56 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -> (String, SqlColDesc) +fromOTypeInfo colname datatype colsize nullable = + (colname, + SqlColDesc {colType = convdatatype datatype, + colOctetLength = Nothing, + colDecDigits = Nothing, + colSize = Just (fromIntegral colsize), + colNullable = case nullable of + 0 -> Just False +{-# LINE 65 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 1 -> Just True +{-# LINE 66 "Database/HDBC/ODBC/TypeConv.hsc" #-} + _ -> Nothing + } + ) + +fromOTypeCol (_:_:_:colname:datatype:_:colsize:buflen:decdig:precrad:nullable:_:_:_:subtype:octetlen:_) = + fromOTypeInfo (fromSql colname) + (fromIntegral ((fromSql datatype)::Int)) + (fromSql colsize) + (fromIntegral ((fromSql nullable)::Int)) +fromOTypeCol x = error $ "fromOTypeCol: unexpected result set: " ++ show x + +convdatatype :: Int16 -> SqlTypeId +{-# LINE 78 "Database/HDBC/ODBC/TypeConv.hsc" #-} +convdatatype intype = + case intype of + 1 -> SqlCharT +{-# LINE 81 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 12 -> SqlVarCharT +{-# LINE 82 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -1 -> SqlLongVarCharT +{-# LINE 83 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -8 -> SqlWCharT +{-# LINE 84 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -9 -> SqlWVarCharT +{-# LINE 85 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -10 -> SqlWLongVarCharT +{-# LINE 86 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 3 -> SqlDecimalT +{-# LINE 87 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 2 -> SqlNumericT +{-# LINE 88 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 5 -> SqlSmallIntT +{-# LINE 89 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 4 -> SqlIntegerT +{-# LINE 90 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 7 -> SqlRealT +{-# LINE 91 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 6 -> SqlFloatT +{-# LINE 92 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 8 -> SqlDoubleT +{-# LINE 93 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -7 -> SqlBitT +{-# LINE 94 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -6 -> SqlTinyIntT +{-# LINE 95 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -5 -> SqlBigIntT +{-# LINE 96 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -2 -> SqlBinaryT +{-# LINE 97 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -3 -> SqlVarBinaryT +{-# LINE 98 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -4 -> SqlLongVarBinaryT +{-# LINE 99 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 91 -> SqlDateT +{-# LINE 100 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 92 -> SqlTimeT +{-# LINE 101 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 93 -> SqlTimestampT +{-# LINE 102 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -- ODBC libraries don't seem to define the UTC items + -- {const SQL_TYPE_UTCDATETIME} -> SqlUTCDateTimeT + -- {const SQL_TYPE_UTCTIME} -> SqlUTCTimeT + 102 -> SqlIntervalT SqlIntervalMonthT +{-# LINE 106 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 101 -> SqlIntervalT SqlIntervalYearT +{-# LINE 107 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 107 -> SqlIntervalT SqlIntervalYearToMonthT +{-# LINE 108 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 103 -> SqlIntervalT SqlIntervalDayT +{-# LINE 109 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 104 -> SqlIntervalT SqlIntervalHourT +{-# LINE 110 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 105 -> SqlIntervalT SqlIntervalMinuteT +{-# LINE 111 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 106 -> SqlIntervalT SqlIntervalSecondT +{-# LINE 112 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 108 -> SqlIntervalT SqlIntervalDayToHourT +{-# LINE 113 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 109 -> SqlIntervalT SqlIntervalDayToMinuteT +{-# LINE 114 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 110 -> SqlIntervalT SqlIntervalDayToSecondT +{-# LINE 115 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 111 -> SqlIntervalT SqlIntervalHourToMinuteT +{-# LINE 116 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 112 -> SqlIntervalT SqlIntervalHourToSecondT +{-# LINE 117 "Database/HDBC/ODBC/TypeConv.hsc" #-} + 113 -> SqlIntervalT SqlIntervalMinuteToSecondT +{-# LINE 118 "Database/HDBC/ODBC/TypeConv.hsc" #-} + -11 -> SqlGUIDT +{-# LINE 119 "Database/HDBC/ODBC/TypeConv.hsc" #-} + x -> SqlUnknownT (show x) diff --git a/Database/HDBC/ODBC/Utils.hs b/Database/HDBC/ODBC/Utils.hs new file mode 100644 --- /dev/null +++ b/Database/HDBC/ODBC/Utils.hs @@ -0,0 +1,157 @@ +{-# OPTIONS_GHC -optc-D__HUGS__ #-} +{-# INCLUDE "hdbc-odbc-helper.h" #-} +{-# LINE 1 "Database/HDBC/ODBC/Utils.hsc" #-} +{- -*- mode: haskell; -*- +{-# LINE 2 "Database/HDBC/ODBC/Utils.hsc" #-} +Copyright (C) 2005 John Goerzen + + 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.Utils where +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Ptr +import Data.Int +import Database.HDBC.Types +import Database.HDBC.ODBC.Types +import Foreign.C.Types +import Control.Exception +import Foreign.Storable +import Foreign.Marshal.Array +import Foreign.Marshal.Alloc +import Data.Word + + +{-# LINE 36 "Database/HDBC/ODBC/Utils.hsc" #-} + +{-# LINE 37 "Database/HDBC/ODBC/Utils.hsc" #-} + +data SqlHandleT = EnvHandle (Ptr CEnv) + | DbcHandle (Ptr CConn) + | StmtHandle (Ptr CStmt) + +checkError :: String -> SqlHandleT -> Int16 -> IO () +{-# LINE 43 "Database/HDBC/ODBC/Utils.hsc" #-} +checkError msg o res = + do let rc = sqlSucceeded res + if rc == 0 + then raiseError msg res o + else return () + +raiseError :: String -> Int16 -> SqlHandleT -> IO a +{-# LINE 50 "Database/HDBC/ODBC/Utils.hsc" #-} +raiseError msg code cconn = + do info <- getdiag ht hp 1 + throwDyn $ SqlError {seState = show (map fst info), + seNativeError = fromIntegral code, + seErrorMsg = msg ++ ": " ++ + show (map snd info)} + where (ht, hp::(Ptr ())) = case cconn of + EnvHandle c -> (1, castPtr c) +{-# LINE 58 "Database/HDBC/ODBC/Utils.hsc" #-} + DbcHandle c -> (2, castPtr c) +{-# LINE 59 "Database/HDBC/ODBC/Utils.hsc" #-} + StmtHandle c -> (3, castPtr c) +{-# LINE 60 "Database/HDBC/ODBC/Utils.hsc" #-} + getdiag ht hp irow = allocaBytes 6 $ \csstate -> + alloca $ \pnaterr -> + allocaBytes 1025 $ \csmsg -> + alloca $ \pmsglen -> + do ret <- sqlGetDiagRec ht hp irow csstate pnaterr + csmsg 1024 pmsglen + if sqlSucceeded ret == 0 + then return [] + else do state <- peekCStringLen (csstate, 5) + nat <- peek pnaterr + msglen <- peek pmsglen + msg <- peekCStringLen (csmsg, + fromIntegral msglen) + next <- getdiag ht hp (irow + 1) + return $ (state, + (show nat) ++ ": " ++ msg) : next + +{- This is a little hairy. + +We have a Conn object that is actually a finalizeonce wrapper around +the real object. We use withConn to dereference the foreign pointer, +and then extract the pointer to the real object from the finalizeonce struct. + +But, when we close the connection, we need the finalizeonce struct, so that's +done by withRawConn. + +Ditto for statements. -} + +withConn :: Conn -> (Ptr CConn -> IO b) -> IO b +withConn = genericUnwrap + +withRawConn :: Conn -> (Ptr WrappedCConn -> IO b) -> IO b +withRawConn = withForeignPtr + +withStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b +withStmt = genericUnwrap + +withRawStmt :: Stmt -> (Ptr WrappedCStmt -> IO b) -> IO b +withRawStmt = withForeignPtr + +withEnv :: Env -> (Ptr CEnv -> IO b) -> IO b +withEnv = genericUnwrap + +withRawEnv :: Env -> (Ptr WrappedCEnv -> IO b) -> IO b +withRawEnv = withForeignPtr + +withCStringArr0 :: [SqlValue] -> (Ptr CString -> IO a) -> IO a +withCStringArr0 inp action = withAnyArr0 convfunc freefunc inp action + where convfunc SqlNull = return nullPtr + convfunc x = newCString (fromSql x) + freefunc x = + if x == nullPtr + then return () + else free x + +withAnyArr0 :: (a -> IO (Ptr b)) -- ^ Function that transforms input data into pointer + -> (Ptr b -> IO ()) -- ^ Function that frees generated data + -> [a] -- ^ List of input data + -> (Ptr (Ptr b) -> IO c) -- ^ Action to run with the C array + -> IO c -- ^ Return value +withAnyArr0 input2ptract freeact inp action = + bracket (mapM input2ptract inp) + (\clist -> mapM_ freeact clist) + (\clist -> withArray0 nullPtr clist action) + + +genericUnwrap :: ForeignPtr (Ptr a) -> (Ptr a -> IO b) -> IO b +genericUnwrap fptr action = withForeignPtr fptr (\structptr -> + do objptr <- (\hsc_ptr -> peekByteOff hsc_ptr 0) structptr +{-# LINE 129 "Database/HDBC/ODBC/Utils.hsc" #-} + action objptr + ) +isOK :: Int16 -> Bool +{-# LINE 132 "Database/HDBC/ODBC/Utils.hsc" #-} +isOK r = sqlSucceeded r /= 0 + +foreign import ccall unsafe "sqlSucceeded" + sqlSucceeded :: Int16 -> CInt +{-# LINE 136 "Database/HDBC/ODBC/Utils.hsc" #-} + +foreign import ccall unsafe "sql.h SQLGetDiagRec" + sqlGetDiagRec :: Int16 -> Ptr () -> +{-# LINE 139 "Database/HDBC/ODBC/Utils.hsc" #-} + Int16 -> CString -> Ptr (Int32) +{-# LINE 140 "Database/HDBC/ODBC/Utils.hsc" #-} + -> CString -> Int16 +{-# LINE 141 "Database/HDBC/ODBC/Utils.hsc" #-} + -> Ptr (Int16) -> IO Int16 +{-# LINE 142 "Database/HDBC/ODBC/Utils.hsc" #-} diff --git a/HDBC-odbc.cabal b/HDBC-odbc.cabal --- a/HDBC-odbc.cabal +++ b/HDBC-odbc.cabal @@ -1,14 +1,13 @@ --- Extra-Libraries: odbc -- handled via Setup.hs in its buildinfo file -include-dirs: . --- extra-lib-dirs: Name: HDBC-odbc -Version: 1.1.3.1 +Version: 1.1.4.0 +Cabal-Version: >=1.2 +Build-type: Simple License: LGPL Maintainer: John Goerzen Author: John Goerzen -Copyright: Copyright (c) 2005-2007 John Goerzen +Copyright: Copyright (c) 2005-2008 John Goerzen license-file: COPYRIGHT -extra-source-files: COPYING +extra-source-files: COPYING, hdbc-odbc-helper.h homepage: http://software.complete.org/hdbc-odbc Category: Database synopsis: ODBC driver for HDBC @@ -17,16 +16,25 @@ and Microsoft ODBC on Windows. It is also the preferred way to access MySQL databases from Haskell. Stability: Beta -Exposed-Modules: Database.HDBC.ODBC -Other-Modules: Database.HDBC.ODBC.Connection, - Database.HDBC.ODBC.Statement, - Database.HDBC.ODBC.Types, - Database.HDBC.ODBC.Utils, - Database.HDBC.ODBC.TypeConv, - Database.HDBC.ODBC.ConnectionImpl ---Extensions: ExistentialQuantification, AllowOverlappingInstances, --- AllowUndecidableInstances, CPP -Extensions: ExistentialQuantification -Build-Depends: base, mtl, HDBC>=1.1.0, parsec -GHC-Options: -O2 -C-Sources: hdbc-odbc-helper.c + +Library + Exposed-Modules: Database.HDBC.ODBC + Other-Modules: Database.HDBC.ODBC.Connection, + Database.HDBC.ODBC.Statement, + Database.HDBC.ODBC.Types, + Database.HDBC.ODBC.Utils, + Database.HDBC.ODBC.TypeConv, + Database.HDBC.ODBC.ConnectionImpl + Extensions: + ExistentialQuantification, + ForeignFunctionInterface, + PatternSignatures + Build-Depends: base, mtl, HDBC>=1.1.0, parsec + GHC-Options: -O2 + C-Sources: hdbc-odbc-helper.c + if os(win32) + Extra-Libraries: odbc32 + else + Extra-Libraries: odbc + include-dirs: . + -- extra-lib-dirs: diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,20 +1,5 @@ -import Distribution.Simple -import qualified System.Info -import Data.List -import Distribution.Simple.Utils -import Distribution.PackageDescription -import System.Exit - -main = defaultMainWithHooks defaultUserHooks{preConf = conf, postConf = ok} - where ok _ _ _ _ = return ExitSuccess +#!/usr/bin/env runhaskell -conf args flags = - do config <- if isWindows - then do putStrLn "On Windows -- using odbc32" - return (emptyBuildInfo {extraLibs = ["odbc32"]}) - else do putStrLn "Not on Windows -- using odbc" - return (emptyBuildInfo {extraLibs = ["odbc"]}) - writeHookedBuildInfo "HDBC-odbc.buildinfo" (Just config, []) - return (Just config, []) +import Distribution.Simple - where isWindows = isPrefixOf "mingw" System.Info.os +main = defaultMain diff --git a/hdbc-odbc-helper.h b/hdbc-odbc-helper.h new file mode 100644 --- /dev/null +++ b/hdbc-odbc-helper.h @@ -0,0 +1,34 @@ +#ifdef mingw32_HOST_OS +#include +#endif +#include + +extern int sqlSucceeded(SQLRETURN ret); +extern SQLRETURN sqlFreeHandleEnv(SQLHANDLE hdl); + +typedef struct TAG_finalizeonce { + void *encapobj; + int refcount; + int isfinalized; + void *extrainfo; + struct TAG_finalizeonce *parent; +} finalizeonce; + +extern finalizeonce *wrapobjodbc(void *obj, finalizeonce *parentobj); +extern finalizeonce *wrapobjodbc_extra(void *obj, void *extra, + finalizeonce *parentobj); + +extern SQLRETURN sqlFreeHandleDbc_app(finalizeonce *res); +extern void sqlFreeHandleDbc_finalizer(finalizeonce *res); + +extern void sqlFreeHandleSth_app(finalizeonce *res); +extern void sqlFreeHandleSth_finalizer(finalizeonce *res); + +extern SQLINTEGER nullData; +extern void *getSqlOvOdbc3(void); + +extern SQLRETURN disableAutoCommit(SQLHDBC conn); +extern SQLRETURN simpleSqlTables(SQLHSTMT stmt); +extern SQLRETURN simpleSqlColumns(SQLHSTMT stmt, SQLCHAR *tablename, + SQLSMALLINT tnlen); +