[htoolkit-cvs] HSQL/src/HSQL ODBC.hsc,1.12,1.13

[<kr_...@us...>]

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