[htoolkit-cvs] HSQL/src/HSQL ODBC.hsc,1.9,1.10

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/htoolkit/HSQL/src/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20618

Modified Files:
	ODBC.hsc 
Log Message:
Changed malloc / mallocBytes / free / newCString to alloca / allocaBytes / withCString where possible. Used SQL_NTS instead of calculating string length.

Index: ODBC.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/ODBC.hsc,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** ODBC.hsc	28 Feb 2004 19:26:46 -0000	1.9
--- ODBC.hsc	28 Feb 2004 20:09:50 -0000	1.10
***************
*** 89,97 ****
  	| res == (#const SQL_STILL_EXECUTING) = throwDyn SqlStillExecuting
  	| res == (#const SQL_NEED_DATA) = throwDyn SqlNeedData
! 	| res == (#const SQL_ERROR) = do
! 		pState  <- mallocBytes 256
! 		pNative <- malloc
! 		pMsg    <- mallocBytes 256
! 		pTextLen <- malloc
  		res <- sqlGetDiagRec handleType handle 1 pState pNative pMsg 256 pTextLen
  		e <- if res == (#const SQL_NO_DATA)
--- 89,98 ----
  	| 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)
***************
*** 102,109 ****
  		          msg    <- peekCString pMsg
  		          return (SqlError {seState=state, seNativeError=fromIntegral native, seErrorMsg=msg})
- 		free pState
- 		free pNative
- 		free pMsg
- 		free pTextLen
  		throwDyn e
  	| otherwise = error (show res)
--- 103,106 ----
***************
*** 115,123 ****
  {-# NOINLINE myEnvironment #-}
  myEnvironment :: HENVRef
! myEnvironment = unsafePerformIO $ do
! 	(phEnv :: Ptr HENV) <- malloc
  	res <- sqlAllocEnv phEnv
  	hEnv <- peek phEnv
- 	free phEnv
  	handleSqlResult 0 nullPtr res
  	newForeignPtr sqlFreeEnv_p hEnv
--- 112,118 ----
  {-# NOINLINE myEnvironment #-}
  myEnvironment :: HENVRef
! myEnvironment = unsafePerformIO $ alloca $ \ (phEnv :: Ptr HENV) -> do
  	res <- sqlAllocEnv phEnv
  	hEnv <- peek phEnv
  	handleSqlResult 0 nullPtr res
  	newForeignPtr sqlFreeEnv_p hEnv
***************
*** 132,144 ****
          -> String               -- ^ Authentication string (password)
          -> IO Connection        -- ^ the returned value represents the new connection
! connect server user authentication = connectHelper $ \hDBC -> do
! 	pServer <- newCString server
! 	pUser <- newCString user
! 	pAuthentication <- newCString authentication
! 	res <- sqlConnect hDBC pServer (length server) pUser (length user) pAuthentication (length authentication)
! 	free pServer
! 	free pUser
! 	free pAuthentication
! 	return res

  -- | 'driverConnect' is an alternative to 'connect'. It supports data sources that 
--- 127,135 ----
          -> String               -- ^ Authentication string (password)
          -> IO Connection        -- ^ the returned value represents the new connection
! connect server user authentication = connectHelper $ \hDBC ->
!         withCString server $ \pServer ->
! 	withCString user $ \pUser ->
! 	withCString authentication $ \pAuthentication ->
! 	sqlConnect hDBC pServer (#const SQL_NTS) pUser (#const SQL_NTS) pAuthentication (#const SQL_NTS)

  -- | 'driverConnect' is an alternative to 'connect'. It supports data sources that 
***************
*** 147,167 ****
  driverConnect :: String               -- ^ Connection string
                -> IO Connection        -- ^ the returned value represents the new connection
! driverConnect connString = connectHelper $ \hDBC -> do
! 	pConnString <- newCString connString
! 	pOutConnString <- mallocBytes 1024
! 	pLen <- malloc
! 	res <- sqlDriverConnect hDBC nullPtr pConnString (fromIntegral (length connString)) pOutConnString 1024 pLen (#const SQL_DRIVER_NOPROMPT)
! 	free pLen
! 	free pOutConnString
! 	free pConnString
! 	return res

  connectHelper :: (HDBC -> IO SQLRETURN) -> IO Connection
  connectHelper connectFunction = withForeignPtr myEnvironment $ \hEnv -> do
! 	(phDBC :: Ptr HDBC) <- malloc
! 	res <- sqlAllocConnect hEnv phDBC
! 	hDBC <- peek phDBC
! 	free phDBC
! 	handleSqlResult (#const SQL_HANDLE_ENV) hEnv res
  	res <- connectFunction hDBC
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
--- 138,153 ----
  driverConnect :: String               -- ^ Connection string
                -> IO Connection        -- ^ the returned value represents the new connection
! driverConnect connString = connectHelper $ \hDBC -> 
!         withCString connString $ \pConnString ->
! 	allocaBytes 1024 $ \pOutConnString ->
! 	alloca $ \pLen ->
! 	sqlDriverConnect hDBC nullPtr pConnString (#const SQL_NTS) pOutConnString 1024 pLen (#const SQL_DRIVER_NOPROMPT)

  connectHelper :: (HDBC -> IO SQLRETURN) -> IO Connection
  connectHelper connectFunction = withForeignPtr myEnvironment $ \hEnv -> do
!         hDBC <- alloca $ \ (phDBC :: Ptr HDBC) -> do
! 	    res <- sqlAllocConnect hEnv phDBC
! 	    handleSqlResult (#const SQL_HANDLE_ENV) hEnv res
! 	    peek phDBC
  	res <- connectFunction hDBC
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
***************
*** 186,222 ****

  		execute :: HDBC -> String -> IO ()
! 		execute hDBC query = do
! 			pFIELD <- mallocBytes (#const sizeof(FIELD))
! 			res <- sqlAllocStmt hDBC ((#ptr FIELD, hSTMT) pFIELD)
! 			unless (sqlSuccess res) (free pFIELD)
  			handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
! 			hSTMT <- (#peek FIELD, hSTMT) pFIELD
! 			let handleResult res = do
! 				unless (sqlSuccess res) (free pFIELD)
! 				handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 			pQuery <- newCString query
! 			res <- sqlExecDirect hSTMT pQuery (length query)
! 			free pQuery
! 			handleResult res
! 			sqlFreeStmt hSTMT (#const SQL_DROP) >>= handleSqlResult (#const SQL_HANDLE_STMT) hSTMT
! 			free pFIELD
! 			
  		stmtBufferSize = 256

  		withStatement :: Connection -> HDBC -> (HSTMT -> IO SQLRETURN) -> IO Statement
! 		withStatement connection hDBC f = do
! 			pFIELD <- mallocBytes (#const sizeof(FIELD))
  			res <- sqlAllocStmt hDBC ((#ptr FIELD, hSTMT) pFIELD)
- 			unless (sqlSuccess res) (free pFIELD)
  			handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
  			hSTMT <- (#peek FIELD, hSTMT) pFIELD
! 			let handleResult res = do
! 				unless (sqlSuccess res) (free pFIELD)
! 				handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
  			f hSTMT >>= handleResult
  			sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult
  			count <- (#peek FIELD, fieldsCount) pFIELD
  			fields <- getFieldDefs hSTMT pFIELD 1 count
- 			free pFIELD
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
  			refFalse <- newMVar False
--- 172,199 ----

  		execute :: HDBC -> String -> IO ()
! 		execute hDBC query = allocaBytes (#const sizeof(HSTMT)) $
!                   \pStmt -> do
! 			res <- sqlAllocStmt hDBC pStmt
  			handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
! 			hSTMT <- peek pStmt
! 			withCStringLen query $ \(pQuery,len) -> do
! 			     res <- sqlExecDirect hSTMT pQuery len
!                              handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 			res <- sqlFreeStmt hSTMT (#const SQL_DROP)
! 			handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 
  		stmtBufferSize = 256

  		withStatement :: Connection -> HDBC -> (HSTMT -> IO SQLRETURN) -> IO Statement
! 		withStatement connection hDBC f = 
! 		        allocaBytes (#const sizeof(FIELD)) $ \pFIELD -> do
  			res <- sqlAllocStmt hDBC ((#ptr FIELD, hSTMT) pFIELD)
  			handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
  			hSTMT <- (#peek FIELD, hSTMT) pFIELD
! 			let handleResult res = handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
  			f hSTMT >>= handleResult
  			sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult
  			count <- (#peek FIELD, fieldsCount) pFIELD
  			fields <- getFieldDefs hSTMT pFIELD 1 count
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
  			refFalse <- newMVar False
***************
*** 236,240 ****
  					| otherwise = do
  						res <- sqlDescribeCol hSTMT n ((#ptr FIELD, fieldName) pFIELD) (#const FIELD_NAME_LENGTH) ((#ptr FIELD, NameLength) pFIELD) ((#ptr FIELD, DataType) pFIELD) ((#ptr FIELD, ColumnSize) pFIELD) ((#ptr FIELD, DecimalDigits) pFIELD) ((#ptr FIELD, Nullable) pFIELD)
- 						unless (sqlSuccess res) (free pFIELD)
  						handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
  						name <- peekCString ((#ptr FIELD, fieldName) pFIELD)
--- 213,216 ----