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

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

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

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


Index: MySQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL/MySQL.hsc,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** MySQL.hsc	5 Aug 2006 15:26:34 -0000	1.7
--- MySQL.hsc	19 Nov 2006 21:56:56 -0000	1.8
***************
*** 32,35 ****
--- 32,36 ----
  
  type MYSQL = Ptr ()
+ type MYSQL_STMT = Ptr ()
  type MYSQL_RES = Ptr ()
  type MYSQL_FIELD = Ptr ()
***************
*** 48,51 ****
--- 49,53 ----
  foreign import #{CALLCONV} "HsMySQL.h mysql_errno" mysql_errno :: MYSQL -> IO CInt
  foreign import #{CALLCONV} "HsMySQL.h mysql_error" mysql_error :: MYSQL -> IO CString
+ foreign import #{CALLCONV} "HsMySQL.h mysql_sqlstate" mysql_sqlstate :: MYSQL -> IO CString
  foreign import #{CALLCONV} "HsMySQL.h mysql_query" mysql_query :: MYSQL -> CString -> IO CInt
  foreign import #{CALLCONV} "HsMySQL.h mysql_affected_rows" mysql_affected_rows :: MYSQL -> IO (#type my_ulonglong)
***************
*** 58,62 ****
  foreign import #{CALLCONV} "HsMySQL.h mysql_list_fields" mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES
  foreign import #{CALLCONV} "HsMySQL.h mysql_next_result" mysql_next_result :: MYSQL -> IO CInt
! 
  
  
--- 60,73 ----
  foreign import #{CALLCONV} "HsMySQL.h mysql_list_fields" mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES
  foreign import #{CALLCONV} "HsMySQL.h mysql_next_result" mysql_next_result :: MYSQL -> IO CInt
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_init" mysql_stmt_init :: MYSQL -> IO MYSQL_STMT
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_prepare" mysql_stmt_prepare :: MYSQL_STMT -> CString -> CInt -> IO CInt
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_close" mysql_stmt_close :: MYSQL_STMT -> IO (#type my_bool)
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_result_metadata" mysql_stmt_result_metadata :: MYSQL_STMT -> IO MYSQL_RES
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_execute" mysql_stmt_execute :: MYSQL_STMT -> IO CInt
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_fetch" mysql_stmt_fetch :: MYSQL_STMT -> IO CInt
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_error" mysql_stmt_error :: MYSQL_STMT -> IO CString
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_error" mysql_stmt_errno :: MYSQL_STMT -> IO CInt
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_sqlstate" mysql_stmt_sqlstate :: MYSQL_STMT -> IO CString
! foreign import #{CALLCONV} "HsMySQL.h mysql_stmt_affected_rows" mysql_stmt_affected_rows :: MYSQL_STMT -> IO (#type my_ulonglong)
  
  
***************
*** 67,73 ****
  handleSqlError :: MYSQL -> IO a
  handleSqlError pMYSQL = do
! 	errno <- mysql_errno pMYSQL
! 	errMsg <- mysql_error pMYSQL >>= peekCString
! 	throwDyn (SqlError "" (fromIntegral errno) errMsg)
  
  -----------------------------------------------------------------------------------------
--- 78,92 ----
  handleSqlError :: MYSQL -> IO a
  handleSqlError pMYSQL = do
!   state <- mysql_sqlstate pMYSQL >>= peekCString
!   errno <- mysql_errno pMYSQL
!   errMsg <- mysql_error pMYSQL >>= peekCString
!   throwDyn (SqlError state (fromIntegral errno) errMsg)
! 
! handleStmtError :: MYSQL_STMT -> IO a
! handleStmtError pStmt = do
!   state <- mysql_stmt_sqlstate pStmt >>= peekCString
!   errno <- mysql_stmt_errno pStmt
!   errMsg <- mysql_stmt_error pStmt >>= peekCString
!   throwDyn (SqlError state (fromIntegral errno) errMsg)
  
  -----------------------------------------------------------------------------------------
***************
*** 89,100 ****
          -> IO Connection
  connect server database user authentication = do
!         let (host,port) = parseServer server
  	pMYSQL <- mysql_init nullPtr
!         pServerHost <- newCString host
  	pDatabase <- newCString database
  	pUser <- newCString user
  	pAuthentication <- newCString authentication
!         res <- mysql_real_connect pMYSQL pServerHost pUser pAuthentication pDatabase port nullPtr (#const MYSQL_DEFAULT_CONNECT_FLAGS)
!         free pServerHost
  	free pDatabase
  	free pUser
--- 108,119 ----
          -> IO Connection
  connect server database user authentication = do
! 	let (host,port) = parseServer server
  	pMYSQL <- mysql_init nullPtr
! 	pServerHost <- newCString host
  	pDatabase <- newCString database
  	pUser <- newCString user
  	pAuthentication <- newCString authentication
! 	res <- mysql_real_connect pMYSQL pServerHost pUser pAuthentication pDatabase port nullPtr (#const MYSQL_DEFAULT_CONNECT_FLAGS)
! 	free pServerHost
  	free pDatabase
  	free pUser
***************
*** 105,108 ****
--- 124,128 ----
  		{ connDisconnect = mysql_close pMYSQL
  		, connExecute = execute pMYSQL
+ 		, connPrepare = prepare connection pMYSQL
  		, connQuery = query connection pMYSQL
  		, connTables = tables connection pMYSQL
***************
*** 121,124 ****
--- 141,169 ----
  			nrows <- mysql_affected_rows pMYSQL
  			return $! fromIntegral nrows
+ 			
+ 		prepare :: Connection -> MYSQL -> String -> IO Statement
+ 		prepare conn pMYSQL query = do
+ 		  pStmt <- mysql_stmt_init pMYSQL
+ 		  when (pStmt == nullPtr) (handleSqlError pMYSQL)
+ 		  res <- withCStringLen query $ \(cquery,len) ->
+ 		               mysql_stmt_prepare pStmt cquery (fromIntegral len)
+ 		  when (res /= 0) (handleStmtError pStmt)
+ 		  pRes <- mysql_stmt_result_metadata pStmt
+ 		  fieldDefs <- if pRes == nullPtr 
+ 		                 then return []
+ 		                 else getFieldDefs pRes
+ 		  mysql_free_result pRes
+ 		  currRow  <- newMVar (nullPtr, nullPtr)
+ 		  refFalse <- newMVar False
+ 		  return (Statement
+ 			     { stmtConn   = conn
+ 			     , stmtClose  = do res <- mysql_stmt_close pStmt
+ 			                       when (res /= 0) (handleStmtError pStmt)
+ 			     , stmtExecute= executePrepared pStmt
+ 			     , stmtFetch  = fetchStmt pStmt
+ 			     , stmtGetCol = getColValue currRow
+ 			     , stmtFields = fieldDefs
+ 			     , stmtClosed = refFalse
+ 			     })
  
  		withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
***************
*** 133,136 ****
--- 178,182 ----
  			              { stmtConn   = conn
  			              , stmtClose  = return ()
+ 			              , stmtExecute= throwDyn SqlUnsupportedOperation
  			              , stmtFetch  = fetch pRes currRow
  			              , stmtGetCol = getColValue currRow
***************
*** 143,146 ****
--- 189,193 ----
  			              { stmtConn   = conn
  			              , stmtClose  = mysql_free_result pRes
+ 			              , stmtExecute= throwDyn SqlUnsupportedOperation
  			              , stmtFetch  = fetch pRes currRow
  			              , stmtGetCol = getColValue currRow
***************
*** 148,186 ****
  			              , stmtClosed = refFalse
  			              })
- 			where
- 				getFieldDefs pRes = do
- 					pField <- mysql_fetch_field pRes
- 					if pField == nullPtr
- 					  then return []
- 					  else do
- 						name <- (#peek MYSQL_FIELD, name) pField >>= peekCString
- 						dataType <-  (#peek MYSQL_FIELD, type) pField
- 						columnSize <-  (#peek MYSQL_FIELD, length) pField
- 						flags <-  (#peek MYSQL_FIELD, flags) pField
- 						decimalDigits <-  (#peek MYSQL_FIELD, decimals) pField
- 						let sqlType = mkSqlType dataType columnSize decimalDigits
- 						defs <- getFieldDefs pRes
- 						return ((name,sqlType,((flags :: Int) .&. (#const NOT_NULL_FLAG)) == 0):defs)
  
! 				mkSqlType :: Int -> Int -> Int -> SqlType
! 				mkSqlType (#const FIELD_TYPE_STRING)     size _	   = SqlChar size
! 				mkSqlType (#const FIELD_TYPE_VAR_STRING) size _    = SqlVarChar size
! 				mkSqlType (#const FIELD_TYPE_DECIMAL)    size prec = SqlNumeric size prec
! 				mkSqlType (#const FIELD_TYPE_SHORT)      _    _    = SqlSmallInt
! 				mkSqlType (#const FIELD_TYPE_INT24)      _    _    = SqlMedInt
! 				mkSqlType (#const FIELD_TYPE_LONG)       _    _    = SqlInteger
! 				mkSqlType (#const FIELD_TYPE_FLOAT)      _    _	   = SqlReal
! 				mkSqlType (#const FIELD_TYPE_DOUBLE)     _    _    = SqlDouble
! 				mkSqlType (#const FIELD_TYPE_TINY)       _    _    = SqlTinyInt
! 				mkSqlType (#const FIELD_TYPE_LONGLONG)   _    _    = SqlBigInt
! 				mkSqlType (#const FIELD_TYPE_DATE)       _    _    = SqlDate
! 				mkSqlType (#const FIELD_TYPE_TIME)       _    _    = SqlTime
! 				mkSqlType (#const FIELD_TYPE_TIMESTAMP)  _    _    = SqlTimeStamp
! 				mkSqlType (#const FIELD_TYPE_DATETIME)   _    _    = SqlDateTime
! 				mkSqlType (#const FIELD_TYPE_YEAR)       _    _    = SqlYear
! 				mkSqlType (#const FIELD_TYPE_BLOB)       _    _    = SqlBLOB
! 				mkSqlType (#const FIELD_TYPE_SET)        _    _    = SqlSET
! 				mkSqlType (#const FIELD_TYPE_ENUM)       _    _    = SqlENUM
! 				mkSqlType tp                             _    _    = SqlUnknown tp
  
  		query :: Connection -> MYSQL -> String -> IO Statement
--- 195,232 ----
  			              , stmtClosed = refFalse
  			              })
  
! 		getFieldDefs pRes = do
!                   pField <- mysql_fetch_field pRes
!                   if pField == nullPtr
!                     then return []
!                     else do name <- (#peek MYSQL_FIELD, name) pField >>= peekCString
!                             dataType <-  (#peek MYSQL_FIELD, type) pField
!                             columnSize <-  (#peek MYSQL_FIELD, length) pField
!                             flags <-  (#peek MYSQL_FIELD, flags) pField
!                             decimalDigits <-  (#peek MYSQL_FIELD, decimals) pField
!                             let sqlType = mkSqlType dataType columnSize decimalDigits
!                             defs <- getFieldDefs pRes
!                             return ((name,sqlType,((flags :: Int) .&. (#const NOT_NULL_FLAG)) == 0):defs)
!                   where
!                     mkSqlType :: Int -> Int -> Int -> SqlType
!                     mkSqlType (#const FIELD_TYPE_STRING)     size _	   = SqlChar size
!                     mkSqlType (#const FIELD_TYPE_VAR_STRING) size _    = SqlVarChar size
!                     mkSqlType (#const FIELD_TYPE_DECIMAL)    size prec = SqlNumeric size prec
!                     mkSqlType (#const FIELD_TYPE_SHORT)      _    _    = SqlSmallInt
!                     mkSqlType (#const FIELD_TYPE_INT24)      _    _    = SqlMedInt
!                     mkSqlType (#const FIELD_TYPE_LONG)       _    _    = SqlInteger
!                     mkSqlType (#const FIELD_TYPE_FLOAT)      _    _	   = SqlReal
!                     mkSqlType (#const FIELD_TYPE_DOUBLE)     _    _    = SqlDouble
!                     mkSqlType (#const FIELD_TYPE_TINY)       _    _    = SqlTinyInt
!                     mkSqlType (#const FIELD_TYPE_LONGLONG)   _    _    = SqlBigInt
!                     mkSqlType (#const FIELD_TYPE_DATE)       _    _    = SqlDate
!                     mkSqlType (#const FIELD_TYPE_TIME)       _    _    = SqlTime
!                     mkSqlType (#const FIELD_TYPE_TIMESTAMP)  _    _    = SqlTimeStamp
!                     mkSqlType (#const FIELD_TYPE_DATETIME)   _    _    = SqlDateTime
!                     mkSqlType (#const FIELD_TYPE_YEAR)       _    _    = SqlYear
!                     mkSqlType (#const FIELD_TYPE_BLOB)       _    _    = SqlBLOB
!                     mkSqlType (#const FIELD_TYPE_SET)        _    _    = SqlSET
!                     mkSqlType (#const FIELD_TYPE_ENUM)       _    _    = SqlENUM
!                     mkSqlType tp                             _    _    = SqlUnknown tp
  
  		query :: Connection -> MYSQL -> String -> IO Statement
***************
*** 202,205 ****
--- 248,258 ----
  			      else return pRes
  
+ 		executePrepared :: MYSQL_STMT -> [SqlValue] -> IO Integer
+ 		executePrepared pStmt values = do
+ 		  res <- mysql_stmt_execute pStmt
+ 		  when (res /= 0) (handleStmtError pStmt)
+ 		  nrows <- mysql_stmt_affected_rows pStmt
+ 		  return $! fromIntegral nrows
+ 
  		fetch :: MYSQL_RES -> MVar (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool
  		fetch pRes currRow
***************
*** 210,213 ****
--- 263,274 ----
  				return ((pRow, pLengths), pRow /= nullPtr)
  
+ 		fetchStmt :: MYSQL_STMT -> IO Bool
+ 		fetchStmt pStmt = do
+ 		  res <- mysql_stmt_fetch pStmt
+ 		  case res of
+ 		    0                      -> return True
+ 		    (#const MYSQL_NO_DATA) -> return False
+ 		    _                      -> handleStmtError pStmt
+ 
  		getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a
  		getColValue currRow colNumber fieldDef f = do