[htoolkit-cvs] HSQL/ODBC/Database/HSQL ODBC.hsc,1.7,1.8

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

Update of /cvsroot/htoolkit/HSQL/ODBC/Database/HSQL
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv7938/Database/HSQL

Modified Files:
	ODBC.hsc 
Log Message:
Prepared statements for ODBC (UNTESTED!!!)


Index: ODBC.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/Database/HSQL/ODBC.hsc,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** ODBC.hsc	4 Jan 2006 19:47:57 -0000	1.7
--- ODBC.hsc	19 Nov 2006 22:23:03 -0000	1.8
***************
*** 73,77 ****
  foreign import #{CALLCONV} "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import #{CALLCONV} "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLRowCount" sqlRowCount :: HSTMT -> Ptr SQLINTEGER -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
--- 73,80 ----
  foreign import #{CALLCONV} "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import #{CALLCONV} "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> SQLINTEGER -> IO SQLRETURN
! foreign import #{CALLCONV} "HsODBC.h SQLPrepare" sqlPrepare :: HSTMT -> CString -> SQLINTEGER -> IO SQLRETURN
! foreign import #{CALLCONV} "HsODBC.h SQLExecute" sqlExecute :: HSTMT -> IO SQLRETURN
! foreign import #{CALLCONV} "HsODBC.h SQLBindParameter" sqlBindParameter :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> SQLSMALLINT -> SQLSMALLINT -> SQLUINTEGER -> SQLSMALLINT -> CString -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLRowCount" sqlRowCount :: HSTMT -> Ptr SQLINTEGER -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
***************
*** 168,182 ****
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
  	refFalse <- newMVar False
! 	let connection = (Connection
! 			{ connDisconnect = disconnect hDBC
! 			, connExecute    = execute hDBC
! 			, connQuery      = query connection hDBC
! 			, connTables     = tables connection hDBC
! 			, connDescribe   = describe connection hDBC
! 			, connBeginTransaction = beginTransaction myEnvironment hDBC
! 			, connCommitTransaction = commitTransaction myEnvironment hDBC
! 			, connRollbackTransaction = rollbackTransaction myEnvironment hDBC
! 			, connClosed     = refFalse
! 			})
  	return connection
  	where
--- 171,187 ----
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
  	refFalse <- newMVar False
! 	let connection = 
! 	       Connection
! 	          { connDisconnect = disconnect hDBC
! 	          , connExecute    = execute hDBC
! 	          , connPrepare    = prepare connection hDBC
! 	          , connQuery      = query connection hDBC
! 	          , connTables     = tables connection hDBC
! 	          , connDescribe   = describe connection hDBC
! 	          , connBeginTransaction = beginTransaction myEnvironment hDBC
! 	          , connCommitTransaction = commitTransaction myEnvironment hDBC
! 	          , connRollbackTransaction = rollbackTransaction myEnvironment hDBC
! 	          , connClosed     = refFalse
! 	          }
  	return connection
  	where
***************
*** 193,197 ****
  			hSTMT <- peek pStmt
  			withCStringLen query $ \(pQuery,len) -> do
! 			     res <- sqlExecDirect hSTMT pQuery len
                               handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
                          numRows <- alloca $ \pNumRows -> do
--- 198,202 ----
  			hSTMT <- peek pStmt
  			withCStringLen query $ \(pQuery,len) -> do
! 			     res <- sqlExecDirect hSTMT pQuery (fromIntegral len)
                               handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
                          numRows <- alloca $ \pNumRows -> do
***************
*** 202,206 ****
  			handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
  			return $! fromIntegral numRows
! 
  		stmtBufferSize = 256
  
--- 207,217 ----
  			handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
  			return $! fromIntegral numRows
! 
! 		prepare :: Connection -> HDBC -> String -> IO Statement
! 		prepare connection hDBC query = 
! 		  withStatement connection hDBC $ \hSTMT ->
! 		  withCStringLen query          $ \(pQuery,len) ->
! 		    sqlPrepare hSTMT pQuery (fromIntegral len)
! 
  		stmtBufferSize = 256
  
***************
*** 220,233 ****
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
  			refFalse <- newMVar False
! 			let statement = Statement
! 				{ stmtConn   = connection
! 				, stmtClose  = closeStatement hSTMT buffer
! 				, stmtFetch  = fetch hSTMT
! 				, stmtGetCol = getColValue hSTMT buffer
! 				, stmtFields = fields
! 				, stmtClosed = refFalse
! 				}
  			return statement
  			where
  				moveToFirstResult :: HSTMT -> Ptr a -> IO [FieldDef]
  				moveToFirstResult hSTMT pFIELD = do
--- 231,278 ----
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
  			refFalse <- newMVar False
! 			let statement = 
! 			       Statement
! 			          { stmtConn    = connection
! 			          , stmtClose   = closeStatement hSTMT buffer
! 			          , stmtExecute = executePrepared hSTMT
! 			          , stmtSetParam= setParam hSTMT buffer
! 			          , stmtFetch   = fetch hSTMT
! 			          , stmtGetCol  = getColValue hSTMT buffer
! 			          , stmtFields  = fields
! 			          , stmtClosed  = refFalse
! 			          }
  			return statement
  			where
+ 				executePrepared hSTMT =
+ 				  alloca $ \pNumRows -> do
+ 				    res <- sqlExecute hSTMT
+ 				    handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ 				    res <- sqlRowCount hSTMT pNumRows
+ 				    handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ 				    numRows <- peek pNumRows
+ 				    return $! fromIntegral numRows
+ 
+ 				setParam hSTMT buffer paramNum (SqlStringValue s) = 
+ 				  withCStringLen s $ \(cstr,len) -> do
+ 				    res <- sqlBindParameter hSTMT (fromIntegral paramNum) (#const SQL_PARAM_INPUT) (#const SQL_C_CHAR) (#const SQL_VARCHAR) (fromIntegral len) 0 cstr (fromIntegral len) nullPtr
+ 				    handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ 				setParam hSTMT buffer paramNum (SqlIntValue    n) = do
+ 				  poke (castPtr buffer :: Ptr SQLINTEGER) (fromIntegral n)
+ 				  res <- sqlBindParameter hSTMT (fromIntegral paramNum) (#const SQL_PARAM_INPUT) (#const SQL_C_SLONG) (#const SQL_INTEGER) 0 0 buffer (#const sizeof(SQLINTEGER)) nullPtr
+ 				  handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ 				setParam hSTMT buffer paramNum (SqlDoubleValue d) = do
+ 				  poke (castPtr buffer :: Ptr (#type SQLDOUBLE)) d
+ 				  res <- sqlBindParameter hSTMT (fromIntegral paramNum) (#const SQL_PARAM_INPUT) (#const SQL_C_DOUBLE) (#const SQL_DOUBLE) 0 0 buffer (#const sizeof(SQLDOUBLE)) nullPtr
+ 				  handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ {-				setParam hSTMT buffer paramNum (SqlBoolValue   b) = do
+ 				  res <- sqlBindParameter hSTMT (fromIntegral paramNum) (#const SQL_PARAM_INPUT) SQLSMALLINT -> SQLSMALLINT -> SQLUINTEGER -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ 				  handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ 				setParam hSTMT buffer paramNum (SqlClockTimeValue t) = do
+ 				  res <- sqlBindParameter hSTMT (fromIntegral paramNum) (#const SQL_PARAM_INPUT) SQLSMALLINT -> SQLSMALLINT -> SQLUINTEGER -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ 				  handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ 				setParam hSTMT buffer paramNum SqlNullValue        = do
+ 				  res <- sqlBindParameter hSTMT (fromIntegral paramNum) (#const SQL_PARAM_INPUT) SQLSMALLINT -> SQLSMALLINT -> SQLUINTEGER -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ 				  handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
+ -}
  				moveToFirstResult :: HSTMT -> Ptr a -> IO [FieldDef]
  				moveToFirstResult hSTMT pFIELD = do
***************
*** 295,299 ****
  		query :: Connection -> HDBC -> String -> IO Statement
  		query connection hDBC q = withStatement connection hDBC doQuery
!     			where doQuery hSTMT = withCStringLen q (uncurry (sqlExecDirect hSTMT))
  
  		beginTransaction myEnvironment hDBC = do
--- 340,344 ----
  		query :: Connection -> HDBC -> String -> IO Statement
  		query connection hDBC q = withStatement connection hDBC doQuery
!     			where doQuery hSTMT = withCStringLen q (\(pQuery,len) -> sqlExecDirect hSTMT pQuery (fromIntegral len))
  
  		beginTransaction myEnvironment hDBC = do