HDBC-odbc 1.1.3.1 → 1.1.4.0
raw patch · 8 files changed
+1107/−38 lines, 8 filessetup-changed
Files
- COPYRIGHT +1/−1
- Database/HDBC/ODBC/Connection.hs +266/−0
- Database/HDBC/ODBC/Statement.hs +450/−0
- Database/HDBC/ODBC/TypeConv.hs +169/−0
- Database/HDBC/ODBC/Utils.hs +157/−0
- HDBC-odbc.cabal +27/−19
- Setup.hs +3/−18
- hdbc-odbc-helper.h +34/−0
COPYRIGHT view
@@ -1,4 +1,4 @@-Copyright (C) 2005-2007 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2005-2008 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
+ Database/HDBC/ODBC/Connection.hs view
@@ -0,0 +1,266 @@+{-# OPTIONS_GHC -optc-D__HUGS__ #-}+{-# INCLUDE <sql.h> #-}+{-# INCLUDE <sqlext.h> #-}+{-# 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" #-}++{- | Connect to an ODBC server.++For information on the meaning of the passed string, please see:++<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/odbc/htm/odbcsqldrivers.asp>++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" #-}
+ Database/HDBC/ODBC/Statement.hs view
@@ -0,0 +1,450 @@+{-# OPTIONS_GHC -optc-D__HUGS__ #-}+{-# INCLUDE <sql.h> #-}+{-# INCLUDE <sqlext.h> #-}+{-# 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 <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.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" #-}
+ Database/HDBC/ODBC/TypeConv.hs view
@@ -0,0 +1,169 @@+{-# OPTIONS_GHC -optc-D__HUGS__ #-}+{-# INCLUDE <sql.h> #-}+{-# INCLUDE <sqlext.h> #-}+{-# INCLUDE <sqlucode.h> #-}+{-# 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 <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.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)
+ Database/HDBC/ODBC/Utils.hs view
@@ -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 <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.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" #-}
HDBC-odbc.cabal view
@@ -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 <jgoerzen@complete.org> 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:
Setup.hs view
@@ -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
+ hdbc-odbc-helper.h view
@@ -0,0 +1,34 @@+#ifdef mingw32_HOST_OS+#include <windows.h>+#endif+#include <sql.h>++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);+