Update of /cvsroot/htoolkit/HSQL/src/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3618
Modified Files:
ODBC.hsc
Log Message:
Some fixes for MSSQL and add support for ODBC debuging
Index: ODBC.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/ODBC.hsc,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** ODBC.hsc 4 Nov 2004 12:50:29 -0000 1.12
--- ODBC.hsc 31 Jan 2005 11:01:30 -0000 1.13
***************
*** 26,29 ****
--- 26,32 ----
import System.IO.Unsafe
import System.Time
+ #ifdef ODBC_DEBUG
+ import Debug.Trace
+ #endif
#include <time.h>
***************
*** 83,112 ****
-----------------------------------------------------------------------------------------
- sqlSuccess :: SQLRETURN -> Bool
- sqlSuccess res =
- (res == (#const SQL_SUCCESS)) || (res == (#const SQL_SUCCESS_WITH_INFO)) || (res == (#const SQL_NO_DATA))
-
handleSqlResult :: SQLSMALLINT -> SQLHANDLE -> SQLRETURN -> IO ()
handleSqlResult handleType handle res
! | sqlSuccess res = return ()
| res == (#const SQL_INVALID_HANDLE) = throwDyn SqlInvalidHandle
| res == (#const SQL_STILL_EXECUTING) = throwDyn SqlStillExecuting
| res == (#const SQL_NEED_DATA) = throwDyn SqlNeedData
! | res == (#const SQL_ERROR) =
! allocaBytes 256 $ \pState ->
! alloca $ \pNative ->
! allocaBytes 256 $ \pMsg ->
! alloca $ \pTextLen ->
! do
! res <- sqlGetDiagRec handleType handle 1 pState pNative pMsg 256 pTextLen
! e <- if res == (#const SQL_NO_DATA)
! then return SqlNoData
! else do
! state <- peekCString pState
! native <- peek pNative
! msg <- peekCString pMsg
! return (SqlError {seState=state, seNativeError=fromIntegral native, seErrorMsg=msg})
! throwDyn e
| otherwise = error (show res)
-----------------------------------------------------------------------------------------
--- 86,120 ----
-----------------------------------------------------------------------------------------
handleSqlResult :: SQLSMALLINT -> SQLHANDLE -> SQLRETURN -> IO ()
handleSqlResult handleType handle res
! | res == (#const SQL_SUCCESS) || res == (#const SQL_NO_DATA) = return ()
! | res == (#const SQL_SUCCESS_WITH_INFO) = do
! #ifdef ODBC_DEBUG
! e <- getDiagRec
! trace (show e) $ return ()
! #else
! return ()
! #endif
| res == (#const SQL_INVALID_HANDLE) = throwDyn SqlInvalidHandle
| res == (#const SQL_STILL_EXECUTING) = throwDyn SqlStillExecuting
| res == (#const SQL_NEED_DATA) = throwDyn SqlNeedData
! | res == (#const SQL_ERROR) = do
! e <- getDiagRec
! throwDyn e
| otherwise = error (show res)
+ where
+ getDiagRec =
+ allocaBytes 256 $ \pState ->
+ alloca $ \pNative ->
+ allocaBytes 256 $ \pMsg ->
+ alloca $ \pTextLen -> do
+ res <- sqlGetDiagRec handleType handle 1 pState pNative pMsg 256 pTextLen
+ if res == (#const SQL_NO_DATA)
+ then return SqlNoData
+ else do
+ state <- peekCString pState
+ native <- peek pNative
+ msg <- peekCString pMsg
+ return (SqlError {seState=state, seNativeError=fromIntegral native, seErrorMsg=msg})
-----------------------------------------------------------------------------------------
***************
*** 198,201 ****
--- 206,210 ----
#if defined(MSSQL_ODBC)
sqlSetStmtAttr hSTMT (#const SQL_ATTR_ROW_ARRAY_SIZE) 2 (#const SQL_IS_INTEGER)
+ sqlSetStmtAttr hSTMT (#const SQL_ATTR_CURSOR_TYPE) (#const SQL_CURSOR_STATIC) (#const SQL_IS_INTEGER)
#endif
f hSTMT >>= handleResult
***************
*** 220,227 ****
if count == 0
then do
res <- sqlMoreResults hSTMT
! if res == (#const SQL_SUCCESS)
! then moveToFirstResult hSTMT pFIELD
! else return []
else
getFieldDefs hSTMT pFIELD 1 count
--- 229,241 ----
if count == 0
then do
+ #if defined(MSSQL_ODBC)
+ sqlSetStmtAttr hSTMT (#const SQL_ATTR_ROW_ARRAY_SIZE) 2 (#const SQL_IS_INTEGER)
+ sqlSetStmtAttr hSTMT (#const SQL_ATTR_CURSOR_TYPE) (#const SQL_CURSOR_STATIC) (#const SQL_IS_INTEGER)
+ #endif
res <- sqlMoreResults hSTMT
! handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! if res == (#const SQL_NO_DATA)
! then return []
! else moveToFirstResult hSTMT pFIELD
else
getFieldDefs hSTMT pFIELD 1 count
|
