[htoolkit-cvs] HSQL/src/HSQL MySQL.hsc,1.3,1.4 ODBC.hsc,1.6,1.7 PostgreSQL.hsc,1.8,1.9 SQLite.hsc,1.1,1.2 Types.hs,1.4,1.5

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

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

Modified Files:
	MySQL.hsc ODBC.hsc PostgreSQL.hsc SQLite.hsc Types.hs 
Log Message:
All functions in the HSQL API are now thread safe


Index: MySQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/MySQL.hsc,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** MySQL.hsc	23 Jan 2004 08:54:13 -0000	1.3
--- MySQL.hsc	10 Feb 2004 11:30:52 -0000	1.4
***************
*** 20,24 ****
  import Data.Dynamic
  import Data.Bits
- import Data.IORef
  import Data.Char
  import Foreign
--- 20,23 ----
***************
*** 26,29 ****
--- 25,29 ----
  import Control.Monad(when,unless)
  import Control.Exception (throwDyn, finally)
+ import Control.Concurrent.MVar
  import System.Time
  import System.IO.Unsafe
***************
*** 88,92 ****
  	free pAuthentication
  	when (res == nullPtr) (handleSqlError pMYSQL)
! 	refFalse <- newIORef False
  	let connection = Connection
  		{ connDisconnect = mysql_close pMYSQL
--- 88,92 ----
  	free pAuthentication
  	when (res == nullPtr) (handleSqlError pMYSQL)
! 	refFalse <- newMVar False
  	let connection = Connection
  		{ connDisconnect = mysql_close pMYSQL
***************
*** 109,114 ****
  		withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
  		withStatement conn pMYSQL pRes = do
! 			currRow  <- newIORef (nullPtr, nullPtr)
! 			refFalse <- newIORef False
  			if (pRes == nullPtr)
  			  then do
--- 109,114 ----
  		withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
  		withStatement conn pMYSQL pRes = do
! 			currRow  <- newMVar (nullPtr, nullPtr)
! 			refFalse <- newMVar False
  			if (pRes == nullPtr)
  			  then do
***************
*** 176,191 ****
  			withStatement conn pMYSQL pRes
  
! 		fetch :: MYSQL_RES -> IORef (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool
  		fetch pRes currRow
  			| pRes == nullPtr = return False
! 			| otherwise = do
  				pRow <- mysql_fetch_row pRes
  				pLengths <- mysql_fetch_lengths pRes
! 				writeIORef currRow (pRow, pLengths)
! 				return (pRow /= nullPtr)
  
! 		getColValue :: IORef (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue currRow colNumber (name,sqlType,nullable) f = do
! 			(row, lengths) <- readIORef currRow
  			pValue <- peekElemOff row colNumber
  			len <- fmap fromIntegral (peekElemOff lengths colNumber)
--- 176,190 ----
  			withStatement conn pMYSQL pRes
  
! 		fetch :: MYSQL_RES -> MVar (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool
  		fetch pRes currRow
  			| pRes == nullPtr = return False
! 			| otherwise = modifyMVar currRow $ \(pRow, pLengths) -> do
  				pRow <- mysql_fetch_row pRes
  				pLengths <- mysql_fetch_lengths pRes
! 				return ((pRow, pLengths), pRow /= nullPtr)
  
! 		getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue currRow colNumber (name,sqlType,nullable) f = do
! 			(row, lengths) <- readMVar currRow
  			pValue <- peekElemOff row colNumber
  			len <- fmap fromIntegral (peekElemOff lengths colNumber)

Index: ODBC.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/ODBC.hsc,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** ODBC.hsc	9 Feb 2004 06:33:10 -0000	1.6
--- ODBC.hsc	10 Feb 2004 11:30:52 -0000	1.7
***************
*** 18,22 ****
  import Data.Word(Word32, Word16)
  import Data.Int(Int32, Int16)
- import Data.IORef
  import Data.Maybe
  import Foreign
--- 18,21 ----
***************
*** 24,27 ****
--- 23,27 ----
  import Control.Monad(unless)
  import Control.Exception(throwDyn)
+ import Control.Concurrent.MVar
  import System.IO.Unsafe
  import System.Time
***************
*** 145,149 ****
  	free pAuthentication
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
! 	refFalse <- newIORef False
  	let connection = (Connection
  			{ connDisconnect = disconnect hDBC
--- 145,149 ----
  	free pAuthentication
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
! 	refFalse <- newMVar False
  	let connection = (Connection
  			{ connDisconnect = disconnect hDBC
***************
*** 199,203 ****
  			free pFIELD
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
! 			refFalse <- newIORef False
  			let statement = Statement
  				{ stmtConn   = connection
--- 199,203 ----
  			free pFIELD
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
! 			refFalse <- newMVar False
  			let statement = Statement
  				{ stmtConn   = connection

Index: PostgreSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/PostgreSQL.hsc,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** PostgreSQL.hsc	9 Feb 2004 21:49:43 -0000	1.8
--- PostgreSQL.hsc	10 Feb 2004 11:30:52 -0000	1.9
***************
*** 17,21 ****
  import Database.HSQL.Types
  import Data.Dynamic
- import Data.IORef
  import Data.Char
  import Foreign
--- 17,20 ----
***************
*** 23,26 ****
--- 22,26 ----
  import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..))
  import Control.Monad(when,unless,mplus)
+ import Control.Concurrent.MVar
  import System.Time
  import System.IO.Unsafe
***************
*** 83,87 ****
  		pqFinish pConn
  		throwDyn (SqlError {seState="C", seNativeError=fromIntegral status, seErrorMsg=errMsg}))
! 	refFalse <- newIORef False
  	let connection = Connection
  		{ connDisconnect = pqFinish pConn
--- 83,87 ----
  		pqFinish pConn
  		throwDyn (SqlError {seState="C", seNativeError=fromIntegral status, seErrorMsg=errMsg}))
! 	refFalse <- newMVar False
  	let connection = Connection
  		{ connDisconnect = pqFinish pConn
***************
*** 121,126 ****
  			defs <- if status ==  (#const PGRES_TUPLES_OK) then pgNFields pRes >>= getFieldDefs pRes 0 else return []
  			countTuples <- pqNTuples pRes;
! 			tupleIndex <- newIORef (-1)
! 			refFalse <- newIORef False
  			return (Statement
  			              { stmtConn   = conn
--- 121,126 ----
  			defs <- if status ==  (#const PGRES_TUPLES_OK) then pgNFields pRes >>= getFieldDefs pRes 0 else return []
  			countTuples <- pqNTuples pRes;
! 			tupleIndex <- newMVar (-1)
! 			refFalse <- newMVar False
  			return (Statement
  			              { stmtConn   = conn
***************
*** 203,217 ****
  					return (column_name, sqlType, not notnull)
  
! 		fetch :: IORef Int -> Int -> IO Bool
! 		fetch tupleIndex countTuples= do
! 			index <- readIORef tupleIndex
! 			let index' = index+1
! 			if (index' >= countTuples)
! 			  then return False
! 			  else writeIORef tupleIndex index' >> return True
  
! 		getColValue :: PGresult -> IORef Int -> Int -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue pRes tupleIndex countTuples colNumber  (name,sqlType,nullable) f = do
! 			index <- readIORef tupleIndex
  			when (index >= countTuples) (throwDyn SqlNoData)
  			isnull <- pqGetisnull pRes index colNumber
--- 203,213 ----
  					return (column_name, sqlType, not notnull)
  
! 		fetch :: MVar Int -> Int -> IO Bool
! 		fetch tupleIndex countTuples =
! 			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples-1))
  
! 		getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue pRes tupleIndex countTuples colNumber  (name,sqlType,nullable) f = do
! 			index <- readMVar tupleIndex
  			when (index >= countTuples) (throwDyn SqlNoData)
  			isnull <- pqGetisnull pRes index colNumber

Index: SQLite.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/SQLite.hsc,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** SQLite.hsc	26 Jan 2004 23:36:19 -0000	1.1
--- SQLite.hsc	10 Feb 2004 11:30:52 -0000	1.2
***************
*** 16,20 ****
  import Database.HSQL
  import Database.HSQL.Types
- import Data.IORef
  import Foreign
  import Foreign.C
--- 16,19 ----
***************
*** 22,25 ****
--- 21,25 ----
  import Control.Monad(when)
  import Control.Exception(throwDyn)
+ import Control.Concurrent.MVar
  
  #include <fcntl.h>
***************
*** 68,72 ****
  			            , seErrorMsg = msg
  			            })
! 		refFalse <- newIORef False
  		let connection = Connection
  			{ connDisconnect = sqlite_close sqlite
--- 68,72 ----
  			            , seErrorMsg = msg
  			            })
! 		refFalse <- newMVar False
  		let connection = Connection
  			{ connDisconnect = sqlite_close sqlite
***************
*** 108,113 ****
  				columns <- peek pnColumn
  				defs <- getFieldDefs pResult 0 columns
! 				refFalse <- newIORef False
! 				refIndex <- newIORef 0
  				return (Statement
  				              { stmtConn   = connection
--- 108,113 ----
  				columns <- peek pnColumn
  				defs <- getFieldDefs pResult 0 columns
! 				refFalse <- newMVar False
! 				refIndex <- newMVar 0
  				return (Statement
  				              { stmtConn   = connection
***************
*** 142,155 ****
  					return (name, SqlText, notnull=="0")
  
! 		fetch :: IORef Int -> Int -> IO Bool
! 		fetch refIndex countTuples= do
! 			index <- readIORef refIndex
! 			let index' = index+1
! 			if (index' > countTuples)
! 			  then return False
! 			  else writeIORef refIndex index' >> return True
  
  		getColValue pResult refIndex columns rows colNumber  (name,sqlType,nullable) f = do
! 			index <- readIORef refIndex
  			when (index > rows) (throwDyn SqlNoData)
  			pStr <- peekElemOff pResult (columns*index+colNumber)
--- 142,150 ----
  					return (name, SqlText, notnull=="0")
  
! 		fetch tupleIndex countTuples =
! 			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples))
  
  		getColValue pResult refIndex columns rows colNumber  (name,sqlType,nullable) f = do
! 			index <- readMVar refIndex
  			when (index > rows) (throwDyn SqlNoData)
  			pStr <- peekElemOff pResult (columns*index+colNumber)

Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/Types.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Types.hs	23 Jan 2004 08:54:19 -0000	1.4
--- Types.hs	10 Feb 2004 11:30:52 -0000	1.5
***************
*** 2,7 ****
  module Database.HSQL.Types where
  
  import Data.Dynamic
- import Data.IORef
  import Foreign.C
  
--- 2,7 ----
  module Database.HSQL.Types where
  
+ import Control.Concurrent.MVar
  import Data.Dynamic
  import Foreign.C
  
***************
*** 106,110 ****
  		, connCommitTransaction :: IO ()
  		, connRollbackTransaction :: IO ()
! 		, connClosed :: IORef Bool
  		}
  
--- 106,110 ----
  		, connCommitTransaction :: IO ()
  		, connRollbackTransaction :: IO ()
! 		, connClosed :: MVar Bool
  		}
  
***************
*** 117,121 ****
  		, stmtGetCol :: forall a . Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		, stmtFields :: [FieldDef]
! 		, stmtClosed :: IORef Bool
  		}
  
--- 117,121 ----
  		, stmtGetCol :: forall a . Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		, stmtFields :: [FieldDef]
! 		, stmtClosed :: MVar Bool
  		}