HDBC-odbc 2.2.3.0 → 2.2.3.1

raw patch · 10 files changed

+99/−28 lines, 10 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Database/HDBC/ODBC.hs +2/−2
• Database/HDBC/ODBC/Connection.hsc +1/−0
• Database/HDBC/ODBC/ConnectionImpl.hs +1/−0
• Database/HDBC/ODBC/Statement.hsc +86/−19
• Database/HDBC/ODBC/TypeConv.hsc +2/−2
• HDBC-odbc.cabal +1/−1
• hdbc-odbc-helper.c +1/−1
• hdbc-odbc-helper.h +1/−1
• testsrc/TestMisc.hs +2/−1
• testsrc/Tests.hs +2/−1

@@ -32,10 +32,10 @@  module Database.HDBC.ODBC     (-     connectODBC, Connection()+     connectODBC, Connection(), getQueryInfo     )  where  import Database.HDBC.ODBC.Connection(connectODBC, Connection())-+import Database.HDBC.ODBC.ConnectionImpl(getQueryInfo)

@@ -158,6 +158,7 @@           >>= checkError "sqlSetConnectAttr" (DbcHandle cconn)          )        return $ Impl.Connection {+                            Impl.getQueryInfo = fGetQueryInfo iconn children,                             Impl.disconnect = fdisconnect iconn children,                             Impl.commit = fcommit iconn,                             Impl.rollback = frollback iconn,

@@ -24,6 +24,7 @@  data Connection =      Connection {+                getQueryInfo :: String -> IO ([SqlColDesc], [(String, SqlColDesc)]),                 disconnect :: IO (),                 commit :: IO (),                 rollback :: IO (),

@@ -57,7 +57,34 @@ #else #let CALLCONV = "ccall" #endif+fGetQueryInfo iconn children query =+    do l "in fGetQueryInfo"+       sstate <- newSState iconn query+       addChild children (wrapStmt sstate)   -- We get error if we forget this one. Not sure why.+       fakeExecute' sstate +fakeExecute' sstate  = withConn (dbo sstate) $ \cconn ->+                       withCStringLen (squery sstate) $ \(cquery, cqlen) ->+                       alloca $ \(psthptr::Ptr (Ptr CStmt)) ->+    do l "in fexecute"+       -- public_ffinish sstate  +       rc1 <- sqlAllocStmtHandle #{const SQL_HANDLE_STMT} cconn psthptr+       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)++       -- parmCount <- getNumParams sthptr+       parmInfo <- fgetparminfo sthptr+       +       -- rc <- getNumResultCols sthptr+       colInfo <- fgetcolinfo sthptr+       return (parmInfo, colInfo)+ data SState =      SState { stomv :: MVar (Maybe Stmt),              dbo :: Conn,@@ -109,18 +136,22 @@        sstate <- newSState iconn ""        swapMVar (stomv sstate) (Just fsthptr)        let sth = wrapStmt sstate-       return sth+       return (sth, sstate)  fgettables iconn =     do fsthptr <- makesth iconn "fgettables"+       l "fgettables: after makesth"        withStmt fsthptr (\sthptr ->                              simpleSqlTables sthptr >>=                                 checkError "gettables simpleSqlTables"                                                 (StmtHandle sthptr)                         )-       sth <- wrapTheStmt iconn fsthptr+       l "fgettables: after withStmt"+       (sth, sstate) <- wrapTheStmt iconn fsthptr+       withStmt fsthptr (\sthptr -> fgetcolinfo sthptr >>= swapMVar (colinfomv sstate))+       l "fgettables: after wrapTheStmt"        results <- fetchAllRows' sth-       l (show results)+       l ("fgettables: results: " ++ (show results))        return $ map (\x -> fromSql (x !! 2)) results  fdescribetable iconn tablename = B.useAsCStringLen (BUTF8.fromString tablename) $ @@ -131,7 +162,8 @@                                checkError "fdescribetable simpleSqlColumns"                                           (StmtHandle sthptr)                         )-       sth <- wrapTheStmt iconn fsthptr+       (sth, sstate) <- wrapTheStmt iconn fsthptr+       withStmt fsthptr (\sthptr -> fgetcolinfo sthptr >>= swapMVar (colinfomv sstate))        results <- fetchAllRows' sth        l (show results)        return $ map fromOTypeCol results@@ -142,7 +174,7 @@                        B.useAsCStringLen (BUTF8.fromString (squery sstate)) $                              \(cquery, cqlen) ->                        alloca $ \(psthptr::Ptr (Ptr CStmt)) ->-    do l "in fexecute"+    do l $ "in fexecute: " ++ show (squery sstate) ++ show args        public_ffinish sstate          rc1 <- sqlAllocStmtHandle #{const SQL_HANDLE_STMT} cconn psthptr        sthptr <- peek psthptr@@ -156,11 +188,12 @@         argsToFree <- zipWithM (bindCol sthptr) args [1..] +       l $ "Ready for sqlExecute: " ++ show (squery sstate) ++ show args        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)+       mapM_ (\(x, y) -> touchForeignPtr x >> touchForeignPtr y)                 (concat argsToFree)          case r of@@ -201,8 +234,10 @@    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+    do l $ "Binding col " ++ show icol ++ ": " ++ show arg+       rc1 <- sqlDescribeParam sthptr icol pdtype pcolsize pdecdigits                       pnullable+       l $ "rc1 is " ++ show (isOK rc1)        when (not (isOK rc1)) $ -- Some drivers don't support that call           do poke pdtype #{const SQL_CHAR}              poke pcolsize 0@@ -210,13 +245,15 @@        coltype <- peek pdtype        colsize <- peek pcolsize        decdigits <- peek pdecdigits+       l $ "Results: " ++ show (coltype, colsize, decdigits)        case arg of          SqlNull -> -- NULL parameter, bind it as such.-                    do rc2 <- sqlBindParameter sthptr (fromIntegral icol)+                    do l "Binding null"+                       rc2 <- sqlBindParameter sthptr (fromIntegral icol)                               #{const SQL_PARAM_INPUT}                               #{const SQL_C_CHAR} coltype colsize decdigits-                              nullPtr 0 nullData-                       checkError ("bindparameter " ++ show icol)+                              nullPtr 0 nullDataHDBC+                       checkError ("bindparameter NULL " ++ show icol)                                       (StmtHandle sthptr) rc2                        return []          x -> do -- Otherwise, we have to allocate RAM, make sure it's@@ -276,12 +313,14 @@                        else do l "getting stuff"                                checkError "sqlFetch" (StmtHandle cstmt) rc                                ncols <- getNumResultCols cstmt+                               l $ "ncols: " ++ show ncols                                res <- mapM (getCol cstmt )                                        [1..ncols]                                return (stmt, Just res)     where getCol cstmt icol =              do let defaultLen = 128                 colinfo <- readMVar (colinfomv sstate)+                l $ "getCol: colinfo is " ++ show colinfo ++ ", icol " ++ show icol                 let cBinding = case colType (snd (colinfo !! ((fromIntegral icol) - 1))) of                                  SqlBinaryT -> #{const SQL_C_BINARY}                                  SqlVarBinaryT -> #{const SQL_C_BINARY}@@ -361,7 +400,7 @@                  -> #{type SQLSMALLINT} -- ^ Buffer length                  -> Ptr (#{type SQLSMALLINT}) -- ^ name length ptr                  -> Ptr (#{type SQLSMALLINT}) -- ^ data type ptr-                 -> Ptr (#{type SQLUINTEGER}) -- ^ column size ptr+                 -> Ptr (#{type SQLULEN}) -- ^ column size ptr                  -> Ptr (#{type SQLSMALLINT}) -- ^ decimal digits ptr                  -> Ptr (#{type SQLSMALLINT}) -- ^ nullable ptr                  -> IO #{type SQLRETURN}@@ -371,8 +410,8 @@              -> #{type SQLUSMALLINT} -- ^ Column number              -> #{type SQLSMALLINT} -- ^ target type              -> CString -- ^ target value pointer (void * in C)-             -> #{type SQLINTEGER} -- ^ buffer len-             -> Ptr (#{type SQLINTEGER})+             -> #{type SQLLEN} -- ^ buffer len+             -> Ptr (#{type SQLLEN})              -> IO #{type SQLRETURN}  foreign import ccall unsafe "hdbc-odbc-helper.h sqlFreeHandleSth_app"@@ -405,21 +444,21 @@                    -> #{type SQLSMALLINT} -- ^ Input or output                    -> #{type SQLSMALLINT} -- ^ Value type                    -> #{type SQLSMALLINT} -- ^ Parameter type-                   -> #{type SQLUINTEGER} -- ^ column size+                   -> #{type SQLULEN} -- ^ column size                    -> #{type SQLSMALLINT} -- ^ decimal digits                    -> CString   -- ^ Parameter value pointer-                   -> #{type SQLINTEGER} -- ^ buffer length-                   -> Ptr #{type SQLINTEGER} -- ^ strlen_or_indptr+                   -> #{type SQLLEN} -- ^ buffer length+                   -> Ptr #{type SQLLEN} -- ^ strlen_or_indptr                    -> IO #{type SQLRETURN} -foreign import ccall unsafe "hdbc-odbc-helper.h &nullData"-  nullData :: Ptr #{type SQLINTEGER}+foreign import ccall unsafe "hdbc-odbc-helper.h &nullDataHDBC"+  nullDataHDBC :: Ptr #{type SQLLEN}  foreign import #{CALLCONV} unsafe "sql.h SQLDescribeParam"   sqlDescribeParam :: Ptr CStmt                     -> #{type SQLUSMALLINT} -- ^ parameter number                    -> Ptr #{type SQLSMALLINT} -- ^ data type ptr-                   -> Ptr #{type SQLUINTEGER} -- ^ parameter size ptr+                   -> Ptr #{type SQLULEN} -- ^ parameter size ptr                    -> Ptr #{type SQLSMALLINT} -- ^ dec digits ptr                    -> Ptr #{type SQLSMALLINT} -- ^ nullable ptr                    -> IO #{type SQLRETURN}@@ -433,3 +472,31 @@ foreign import ccall unsafe "hdbc-odbc-helper.h simpleSqlColumns"   simpleSqlColumns :: Ptr CStmt -> Ptr CChar ->                        #{type SQLSMALLINT} -> IO #{type SQLRETURN}++fgetparminfo cstmt =+    do ncols <- getNumParams cstmt+       mapM getname [1..ncols]+    where getname icol = -- alloca $ \colnamelp ->+                         -- allocaBytes 128 $ \cscolname ->+                         alloca $ \datatypeptr ->+                         alloca $ \colsizeptr ->+                         alloca $ \nullableptr ->+              do poke datatypeptr 127 -- to test if sqlDescribeParam actually writes something to the area+                 res <- sqlDescribeParam cstmt (fromInteger $ toInteger icol) -- cscolname 127 colnamelp +                                  datatypeptr colsizeptr nullPtr nullableptr+                 putStrLn $ show res+                 -- We need proper error handling here. Not all ODBC drivers supports SQLDescribeParam.+                 -- Not supporting SQLDescribeParam is quite allright according to the ODBC standard.+                 datatype <- peek datatypeptr+                 colsize  <- peek colsizeptr+                 nullable <- peek nullableptr+                 return $ snd $ fromOTypeInfo "" datatype colsize nullable++getNumParams sthptr = alloca $ \pcount ->+    do sqlNumParams sthptr pcount >>= checkError "SQLNumResultCols" +                                          (StmtHandle sthptr)+       peek pcount++foreign import ccall unsafe "sql.h SQLNumParams"+  sqlNumParams :: Ptr CStmt -> Ptr #{type SQLSMALLINT} +               -> IO #{type SQLRETURN}

@@ -40,7 +40,7 @@ import Data.Maybe  l _ = return ()---l m = hPutStrLn stderr ("\n" ++ m)+-- l m = hPutStrLn stderr ("\n" ++ m)  #ifdef mingw32_HOST_OS #include <windows.h>@@ -51,7 +51,7 @@  fromOTypeInfo :: String         -- ^ Column name               -> #{type SQLSMALLINT} -- ^ Data type-              -> #{type SQLUINTEGER} -- ^ Column size+              -> #{type SQLULEN}     -- ^ Column size               -> #{type SQLSMALLINT} -- ^ Is it nullable               -> (String, SqlColDesc) fromOTypeInfo colname datatype colsize nullable =

@@ -1,5 +1,5 @@ Name: HDBC-odbc-Version: 2.2.3.0+Version: 2.2.3.1 Cabal-Version: >=1.2.3 Build-type: Simple License: LGPL

@@ -8,7 +8,7 @@ #include <stdlib.h> #include "hdbc-odbc-helper.h" -SQLINTEGER nullData = SQL_NULL_DATA;+SQLLEN nullDataHDBC = SQL_NULL_DATA;  int sqlSucceeded(SQLRETURN ret) {   return SQL_SUCCEEDED(ret);

@@ -25,7 +25,7 @@ extern void sqlFreeHandleSth_app(finalizeonce *res); extern void sqlFreeHandleSth_finalizer(finalizeonce *res); -extern SQLINTEGER nullData;+extern SQLLEN nullDataHDBC; extern void *getSqlOvOdbc3(void);  extern SQLRETURN disableAutoCommit(SQLHDBC conn);

@@ -163,7 +163,8 @@                   [SqlInt32 101, SqlString "bar\x00A3", SqlNull],                   [SqlInt32 102, SqlString (take 263 (repeat 'a')), SqlNull]] -tests = TestList [TestLabel "getColumnNames" testgetColumnNames,+tests = TestList [+                  TestLabel "getColumnNames" testgetColumnNames,                   TestLabel "describeResult" testdescribeResult,                   TestLabel "describeTable" testdescribeTable,                   TestLabel "quickQuery" testquickQuery,

@@ -31,4 +31,5 @@                   TestLabel "SqlValue basics" Testbasics.tests,                   TestLabel "SpecificDB" SpecificDBTests.tests,                   TestLabel "Misc tests" TestMisc.tests,-                  TestLabel "Time tests" TestTime.tests]+                  TestLabel "Time tests" TestTime.tests+                 ]