Menu
▾
▴
htoolkit-cvs — HToolkit CVS commit messages
You can subscribe to this list here.
| 2003 |
Jan
(30) |
Feb
(20) |
Mar
(151) |
Apr
(86) |
May
(23) |
Jun
(25) |
Jul
(107) |
Aug
(141) |
Sep
(55) |
Oct
(85) |
Nov
(65) |
Dec
(2) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(22) |
Feb
(18) |
Mar
(3) |
Apr
(16) |
May
(69) |
Jun
(3) |
Jul
(1) |
Aug
(3) |
Sep
(1) |
Oct
|
Nov
(6) |
Dec
(1) |
| 2005 |
Jan
(2) |
Feb
(16) |
Mar
|
Apr
|
May
|
Jun
(47) |
Jul
(1) |
Aug
|
Sep
(6) |
Oct
(4) |
Nov
|
Dec
(34) |
| 2006 |
Jan
(39) |
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
(5) |
Oct
|
Nov
(4) |
Dec
|
| 2007 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
| 2008 |
Jan
|
Feb
|
Mar
(26) |
Apr
(1) |
May
(1) |
Jun
|
Jul
(5) |
Aug
(2) |
Sep
(8) |
Oct
(8) |
Nov
(22) |
Dec
(30) |
| 2009 |
Jan
(10) |
Feb
(13) |
Mar
(14) |
Apr
(14) |
May
(32) |
Jun
(25) |
Jul
(36) |
Aug
(10) |
Sep
(2) |
Oct
|
Nov
|
Dec
(10) |
| 2010 |
Jan
(9) |
Feb
(4) |
Mar
(2) |
Apr
(1) |
May
(2) |
Jun
(2) |
Jul
(1) |
Aug
(4) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
|
From: <kr_...@us...> - 2006-11-21 08:23:21
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv14411/Database Modified Files: HSQL.hsc Log Message: fix export list Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** HSQL.hsc 20 Sep 2006 10:52:36 -0000 1.20 --- HSQL.hsc 21 Nov 2006 08:23:18 -0000 1.21 *************** *** 22,28 **** -- the functions described here are used to perform SQL queries and commands. , execute -- :: Connection -> String -> IO Integer - , prepare -- :: Connection -> String -> IO Integer , Statement , query -- :: Connection -> String -> IO Statement , closeStatement -- :: Statement -> IO () , executePrepared -- :: Statement -> [SqlValue] -> IO () --- 22,28 ---- -- the functions described here are used to perform SQL queries and commands. , execute -- :: Connection -> String -> IO Integer , Statement , query -- :: Connection -> String -> IO Statement + , prepare -- :: Connection -> String -> IO Statement , closeStatement -- :: Statement -> IO () , executePrepared -- :: Statement -> [SqlValue] -> IO () |
|
From: <kr_...@us...> - 2006-11-19 22:23:06
|
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 |
|
From: <kr_...@us...> - 2006-11-19 22:17:13
|
Update of /cvsroot/htoolkit/HSQL/MSI/Database/HSQL In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv5509/Database/HSQL Modified Files: MSI.hsc Log Message: it's enabled to have equal dest and source databases Index: MSI.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MSI/Database/HSQL/MSI.hsc,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** MSI.hsc 9 Jan 2006 14:49:23 -0000 1.7 --- MSI.hsc 19 Nov 2006 22:17:10 -0000 1.8 *************** *** 24,27 **** --- 24,28 ---- import Foreign import Foreign.C + import System.Directory(canonicalizePath) import Database.HSQL import Database.HSQL.Types *************** *** 36,40 **** withCString dest $ \cdest -> alloca $ \phandle -> do ! msiOpenDatabase csource cdest phandle >>= checkResult hDatabase <- peek phandle refFalse <- newMVar False --- 37,43 ---- withCString dest $ \cdest -> alloca $ \phandle -> do ! source <- canonicalizePath source ! dest <- canonicalizePath dest ! msiOpenDatabase csource (if source == dest then nullPtr `plusPtr` 2 else cdest) phandle >>= checkResult hDatabase <- peek phandle refFalse <- newMVar False |
|
From: <kr_...@us...> - 2006-11-19 21:57:01
|
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 |
|
From: <kr_...@us...> - 2006-09-20 10:53:44
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv21863/Database/HSQL Modified Files: Types.hs Log Message: whitespace Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL/Types.hs,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Types.hs 20 Sep 2006 10:52:36 -0000 1.11 --- Types.hs 20 Sep 2006 10:53:40 -0000 1.12 *************** *** 148,170 **** class SqlBind a where ! -- This allows for faster conversion for eq. integral numeric types, etc. ! -- Default version uses fromSqlValue. ! fromSqlCStringLen :: FieldDef -> CString -> Int -> IO a ! fromSqlCStringLen = defaultFromSqlCStringLen ! getStmtFieldValue :: Statement -> Int -> FieldDef -> IO a ! getStmtFieldValue = defaultGetStmtFieldValue ! fromSqlValue :: SqlType -> String -> Maybe a ! toSqlValue :: a -> String defaultFromSqlCStringLen :: SqlBind a => FieldDef -> CString -> Int -> IO a defaultFromSqlCStringLen (name,sqlType,_) cstr cstrLen ! | cstr == nullPtr = throwDyn (SqlFetchNull name) ! | otherwise = do ! str <- peekCStringLen (cstr, cstrLen) ! case fromSqlValue sqlType str of ! Nothing -> throwDyn (SqlBadTypeCast name sqlType) ! Just v -> return v defaultGetStmtFieldValue :: SqlBind a => Statement -> Int -> FieldDef -> IO a --- 148,169 ---- class SqlBind a where ! -- This allows for faster conversion for eq. integral numeric types, etc. ! -- Default version uses fromSqlValue. ! fromSqlCStringLen :: FieldDef -> CString -> Int -> IO a ! fromSqlCStringLen = defaultFromSqlCStringLen ! getStmtFieldValue :: Statement -> Int -> FieldDef -> IO a ! getStmtFieldValue = defaultGetStmtFieldValue ! fromSqlValue :: SqlType -> String -> Maybe a ! toSqlValue :: a -> String defaultFromSqlCStringLen :: SqlBind a => FieldDef -> CString -> Int -> IO a defaultFromSqlCStringLen (name,sqlType,_) cstr cstrLen ! | cstr == nullPtr = throwDyn (SqlFetchNull name) ! | otherwise = do str <- peekCStringLen (cstr, cstrLen) ! case fromSqlValue sqlType str of ! Nothing -> throwDyn (SqlBadTypeCast name sqlType) ! Just v -> return v defaultGetStmtFieldValue :: SqlBind a => Statement -> Int -> FieldDef -> IO a |
|
From: <kr_...@us...> - 2006-09-20 10:52:41
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv21420/Database Modified Files: HSQL.hsc Log Message: added getStmtFieldValue to SqlBind type class Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** HSQL.hsc 25 Aug 2006 09:23:59 -0000 1.19 --- HSQL.hsc 20 Sep 2006 10:52:36 -0000 1.20 *************** *** 396,400 **** (char '.' >> readDecP) `mplus` (return 0) tz <- parseTZ ! return (mkClockTime 1970 1 1 hour minutes seconds (tz*3600)) fromSqlValue SqlTime s = f_read getTime s --- 396,400 ---- (char '.' >> readDecP) `mplus` (return 0) tz <- parseTZ ! return $! mkClockTime 1970 1 1 hour minutes seconds (tz*3600) fromSqlValue SqlTime s = f_read getTime s *************** *** 403,407 **** getTime = do (hour, minutes, seconds) <- readHMS ! return (mkClockTime 1970 1 1 hour minutes seconds 0) fromSqlValue SqlDate s = f_read getDate s --- 403,407 ---- getTime = do (hour, minutes, seconds) <- readHMS ! return $! mkClockTime 1970 1 1 hour minutes seconds 0 fromSqlValue SqlDate s = f_read getDate s *************** *** 410,414 **** getDate = do (year, month, day) <- readYMD ! return (mkClockTime year month day 0 0 0 0) fromSqlValue SqlDateTimeTZ s = f_read getDateTimeTZ s --- 410,414 ---- getDate = do (year, month, day) <- readYMD ! return $! mkClockTime year month day 0 0 0 0 fromSqlValue SqlDateTimeTZ s = f_read getDateTimeTZ s *************** *** 419,423 **** char '.' >> readDecP -- ) `mplus` (return 0) tz <- parseTZ ! return (mkClockTime year month day hour minutes seconds (tz*3600)) -- The only driver which seems to report the type as SqlTimeStamp seems --- 419,423 ---- char '.' >> readDecP -- ) `mplus` (return 0) tz <- parseTZ ! return $! mkClockTime year month day hour minutes seconds (tz*3600) -- The only driver which seems to report the type as SqlTimeStamp seems *************** *** 430,434 **** getDateTime = do (year, month, day, hour, minutes, seconds) <- readDateTime ! return (mkClockTime year month day hour minutes seconds 0) fromSqlValue _ _ = Nothing --- 430,434 ---- getDateTime = do (year, month, day, hour, minutes, seconds) <- readDateTime ! return $! mkClockTime year month day hour minutes seconds 0 fromSqlValue _ _ = Nothing *************** *** 604,609 **** -> String -- ^ Field name -> IO a -- ^ Field value ! getFieldValue stmt name = ! stmtGetCol stmt colNumber (name,sqlType,nullable) fromSqlCStringLen where (sqlType,nullable,colNumber) = findFieldInfo name (stmtFields stmt) 0 --- 604,608 ---- -> String -- ^ Field name -> IO a -- ^ Field value ! getFieldValue stmt name = getStmtFieldValue stmt colNumber (name,sqlType,nullable) where (sqlType,nullable,colNumber) = findFieldInfo name (stmtFields stmt) 0 *************** *** 617,621 **** getFieldValue' stmt name def = do mb_v <- getFieldValue stmt name ! return (case mb_v of { Nothing -> def; Just a -> a }) -- | Retrieves the value of field with the specified index. --- 616,620 ---- getFieldValue' stmt name def = do mb_v <- getFieldValue stmt name ! return $! case mb_v of { Nothing -> def; Just a -> a } -- | Retrieves the value of field with the specified index. *************** *** 623,628 **** -> Int -- ^ Field index -> IO a -- ^ Field value ! getFieldValueAt stmt index = ! fieldDef `seq` stmtGetCol stmt index fieldDef fromSqlCStringLen where fieldDef = findColumnInfo (stmtFields stmt) index --- 622,626 ---- -> Int -- ^ Field index -> IO a -- ^ Field value ! getFieldValueAt stmt index = getStmtFieldValue stmt index $! fieldDef where fieldDef = findColumnInfo (stmtFields stmt) index *************** *** 636,640 **** getFieldValueAt' stmt index def = do mb_v <- getFieldValueAt stmt index ! return (case mb_v of { Nothing -> def; Just a -> a }) {-# DEPRECATED getFieldValueMB "Use getFieldValue instead." #-} --- 634,638 ---- getFieldValueAt' stmt index def = do mb_v <- getFieldValueAt stmt index ! return $! case mb_v of { Nothing -> def; Just a -> a } {-# DEPRECATED getFieldValueMB "Use getFieldValue instead." #-} |
|
From: <kr_...@us...> - 2006-09-20 10:52:40
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv21420/Database/HSQL Modified Files: Types.hs Log Message: added getStmtFieldValue to SqlBind type class Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL/Types.hs,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Types.hs 11 Mar 2006 20:32:00 -0000 1.10 --- Types.hs 20 Sep 2006 10:52:36 -0000 1.11 *************** *** 153,156 **** --- 153,159 ---- fromSqlCStringLen = defaultFromSqlCStringLen + getStmtFieldValue :: Statement -> Int -> FieldDef -> IO a + getStmtFieldValue = defaultGetStmtFieldValue + fromSqlValue :: SqlType -> String -> Maybe a toSqlValue :: a -> String *************** *** 164,165 **** --- 167,171 ---- Nothing -> throwDyn (SqlBadTypeCast name sqlType) Just v -> return v + + defaultGetStmtFieldValue :: SqlBind a => Statement -> Int -> FieldDef -> IO a + defaultGetStmtFieldValue stmt colNumber fieldDef = stmtGetCol stmt colNumber fieldDef fromSqlCStringLen |
|
From: <kr_...@us...> - 2006-09-20 10:25:43
|
Update of /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv10915 Modified Files: Oracle.hsc Log Message: throw an exception when there is a column with unsupported type Index: Oracle.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/Oracle.hsc,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Oracle.hsc 19 Sep 2006 12:23:09 -0000 1.11 --- Oracle.hsc 20 Sep 2006 10:25:38 -0000 1.12 *************** *** 260,264 **** SqlTimeStamp -> 100 SqlText -> 100 ! SqlUnknown _ -> 0 definePositions stmt err buffer pos offset [] = return () --- 260,264 ---- SqlTimeStamp -> 100 SqlText -> 100 ! SqlUnknown _ -> throwDyn SqlUnsupportedOperation definePositions stmt err buffer pos offset [] = return () |
|
From: <kr_...@us...> - 2006-09-19 12:23:13
|
Update of /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv30720/Database/HSQL Modified Files: Oracle.hsc Log Message: Prepared statements and NULL value fetch for Oracle Index: Oracle.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/Oracle.hsc,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Oracle.hsc 4 Jan 2006 09:04:36 -0000 1.10 --- Oracle.hsc 19 Sep 2006 12:23:09 -0000 1.11 *************** *** 22,25 **** --- 22,26 ---- import Control.Exception(throwDyn) import Data.Word + import Data.List(foldl') #include <HsOCI.h> *************** *** 32,35 **** --- 33,37 ---- type OCIParam = OCIHandle type OCIDefine = OCIHandle + type OCIBind = OCIHandle type OCIDescribe=OCIHandle *************** *** 49,52 **** --- 51,55 ---- foreign import ccall "OCIStmtFetch2" ociStmtFetch2 :: OCIStmt -> OCIError -> CInt -> CInt -> CInt -> CInt -> IO CInt foreign import ccall "OCIDefineByPos" ociDefineByPos :: OCIStmt -> Ptr OCIDefine -> OCIError -> CInt -> Ptr a -> CInt -> CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> CInt -> IO CInt + foreign import ccall "OCIBindByPos" ociBindByPos :: OCIStmt -> Ptr OCIBind -> OCIError -> CInt -> Ptr a -> CInt -> CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> CInt -> Ptr CInt -> CInt -> IO CInt foreign import ccall "OCIParamGet" ociParamGet :: OCIHandle -> CInt -> OCIError -> Ptr OCIParam -> CInt -> IO CInt *************** *** 128,131 **** --- 131,135 ---- { connDisconnect = disconnect svcCtx err , connExecute = execute myEnvironment svcCtx err + , connPrepare = prepare connection myEnvironment svcCtx err , connQuery = query connection myEnvironment svcCtx err , connTables = tables env svcCtx err *************** *** 145,149 **** withForeignPtr envRef $ \env -> withCStringLen query $ \(query,query_len) -> ! alloca $ \pStmt -> do alloca $ \pCount -> do ociHandleAlloc env pStmt (#const OCI_HTYPE_STMT) 0 nullPtr >>= handleSqlResult err --- 149,153 ---- withForeignPtr envRef $ \env -> withCStringLen query $ \(query,query_len) -> ! alloca $ \pStmt -> alloca $ \pCount -> do ociHandleAlloc env pStmt (#const OCI_HTYPE_STMT) 0 nullPtr >>= handleSqlResult err *************** *** 156,159 **** --- 160,185 ---- return $! fromIntegral count + prepare connection envRef svcCtx err query = + withForeignPtr envRef $ \env -> + withCStringLen query $ \(query,query_len) -> + alloca $ \pStmt -> do + ociHandleAlloc env pStmt (#const OCI_HTYPE_STMT) 0 nullPtr >>= handleSqlResult err + stmt <- peek pStmt + ociStmtPrepare stmt err query (fromIntegral query_len) (#const OCI_NTV_SYNTAX) (#const OCI_DEFAULT) >>= handleSqlResult err + fields <- allocaBytes (#const (sizeof(FIELD_DEF))) (getFieldDefs err stmt 1) + let offsets_arr_size = length fields * sizeOf offsets_arr_size + buffer <- mallocBytes (foldl' (\s t -> sizeOf (undefined :: CShort) + sqlType2Size t + s) offsets_arr_size fields) + definePositions stmt err buffer 0 offsets_arr_size fields + refFalse <- newMVar False + return (Statement + { stmtConn = connection + , stmtClose = closeStatement stmt buffer err + , stmtExecute= executePrepared svcCtx stmt err + , stmtFetch = fetch stmt err + , stmtGetCol = getColValue buffer + , stmtFields = fields + , stmtClosed = refFalse + }) + query connection envRef svcCtx err query = withForeignPtr envRef $ \env -> *************** *** 164,214 **** ociStmtPrepare stmt err query (fromIntegral query_len) (#const OCI_NTV_SYNTAX) (#const OCI_DEFAULT) >>= handleSqlResult err ociStmtExecute svcCtx stmt err 0 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult err ! fields <- allocaBytes (#const (sizeof(FIELD_DEF))) (getFieldDefs stmt 1) ! let offsets_arr_size = fromIntegral (length fields * sizeOf offsets_arr_size) :: CInt ! buffer <- mallocBytes (fromIntegral (foldr ((+) . sqlType2Size) offsets_arr_size fields)) definePositions stmt err buffer 0 offsets_arr_size fields refFalse <- newMVar False ! let statement = Statement ! { stmtConn = connection ! , stmtClose = closeStatement stmt buffer err ! , stmtFetch = fetch stmt err ! , stmtGetCol = getColValue buffer ! , stmtFields = fields ! , stmtClosed = refFalse ! } ! return statement ! where ! getFieldDefs stmt counter buffer = do ! res <- ociParamGet stmt (#const OCI_HTYPE_STMT) err ((#ptr FIELD_DEF, par) buffer) counter ! if res == (#const OCI_SUCCESS) ! then do field <- getFieldDef err buffer ! fields <- getFieldDefs stmt (counter+1) buffer ! return (field:fields) ! else return [] ! sqlType2Size :: FieldDef -> CInt ! sqlType2Size (_,tp,_) = ! case tp of ! SqlVarChar n -> fromIntegral n+1 ! SqlNumeric p s -> fromIntegral (p+s+3) -- The value precision plus optional positions for '.', '-' and ! -- one position for the '\0' character at end of the string. ! SqlInteger -> 16 -- 12 digits are enough (maxBound :: Int) has 10 digits. ! -- in addition we may need one position for '-' and one ! -- for the '\0' character at end of the string. ! SqlFloat -> 100 ! SqlDate -> 100 ! SqlTime -> 100 ! SqlTimeTZ -> 100 ! SqlTimeStamp -> 100 ! SqlText -> 100 ! SqlUnknown _ -> 0 ! definePositions stmt err buffer pos offset [] = return () ! definePositions stmt err buffer pos offset (field:fields) = ! alloca $ \pDef -> do ! let size = sqlType2Size field ! poke (castPtr buffer `advancePtr` fromIntegral pos) offset ! ociDefineByPos stmt pDef err (pos+1) (buffer `plusPtr` fromIntegral offset) size (#const SQLT_STR) nullPtr nullPtr nullPtr (#const OCI_DEFAULT) ! definePositions stmt err buffer (pos+1) (offset+size) fields mkSqlType :: (#type OCITypeCode) -> (#type ub2) -> (#type ub1) -> (#type ub1) -> SqlType --- 190,282 ---- ociStmtPrepare stmt err query (fromIntegral query_len) (#const OCI_NTV_SYNTAX) (#const OCI_DEFAULT) >>= handleSqlResult err ociStmtExecute svcCtx stmt err 0 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult err ! fields <- allocaBytes (#const (sizeof(FIELD_DEF))) (getFieldDefs err stmt 1) ! let offsets_arr_size = length fields * sizeOf offsets_arr_size ! buffer <- mallocBytes (foldl' (\s t -> sizeOf (undefined :: CShort) + sqlType2Size t + s) offsets_arr_size fields) definePositions stmt err buffer 0 offsets_arr_size fields refFalse <- newMVar False ! return (Statement ! { stmtConn = connection ! , stmtClose = closeStatement stmt buffer err ! , stmtExecute= throwDyn SqlUnsupportedOperation ! , stmtFetch = fetch stmt err ! , stmtGetCol = getColValue buffer ! , stmtFields = fields ! , stmtClosed = refFalse ! }) ! executePrepared svcCtx stmt err values = ! alloca $ \pCount -> do ! bindings <- setParams stmt err 0 [] values ! res <- ociStmtExecute svcCtx stmt err 1 0 nullPtr nullPtr (#const OCI_DEFAULT) ! mapM_ free bindings ! handleSqlResult err res ! ociAttrGet stmt (#const OCI_HTYPE_STMT) pCount nullPtr (#const OCI_ATTR_ROW_COUNT) err >>= handleSqlResult err ! count <- peek (pCount :: Ptr (#type ub4)) ! return $! fromIntegral count ! setParams stmt err index bindings [] = return bindings ! setParams stmt err index bindings (SqlStringValue value : values) = ! alloca $ \pBind -> do ! cstr <- newCString value ! res <- ociBindByPos stmt pBind err (index+1) cstr (fromIntegral (length value+1)) (#const SQLT_STR) nullPtr nullPtr nullPtr (#const OCI_DEFAULT) nullPtr (#const OCI_DEFAULT) ! handleSqlResult err res ! setParams stmt err (index+1) (castPtr cstr:bindings) values ! setParams stmt err index bindings (SqlIntValue value : values) = ! alloca $ \pBind -> do ! pValue <- malloc ! poke pValue value ! res <- ociBindByPos stmt pBind err (index+1) pValue (fromIntegral (sizeOf value)) (#const SQLT_INT) nullPtr nullPtr nullPtr (#const OCI_DEFAULT) nullPtr (#const OCI_DEFAULT) ! handleSqlResult err res ! setParams stmt err (index+1) (castPtr pValue:bindings) values ! setParams stmt err index bindings (SqlDoubleValue value : values) = ! alloca $ \pBind -> do ! pValue <- malloc ! poke pValue value ! res <- ociBindByPos stmt pBind err (index+1) pValue (fromIntegral (sizeOf value)) (#const SQLT_FLT) nullPtr nullPtr nullPtr (#const OCI_DEFAULT) nullPtr (#const OCI_DEFAULT) ! handleSqlResult err res ! setParams stmt err (index+1) (castPtr pValue:bindings) values ! ! getFieldDefs err stmt counter buffer = do ! res <- ociParamGet stmt (#const OCI_HTYPE_STMT) err ((#ptr FIELD_DEF, par) buffer) counter ! if res == (#const OCI_SUCCESS) ! then do field <- getFieldDef err buffer ! fields <- getFieldDefs err stmt (counter+1) buffer ! return (field:fields) ! else return [] ! ! sqlType2Size :: FieldDef -> Int ! sqlType2Size (_,tp,_) = ! case tp of ! SqlVarChar n -> n+1 ! SqlNumeric p s -> p+s+3 -- The value precision plus optional positions for '.', '-' and ! -- one position for the '\0' character at end of the string. ! SqlInteger -> 16 -- 12 digits are enough (maxBound :: Int) has 10 digits. ! -- in addition we may need one position for '-' and one ! -- for the '\0' character at end of the string. ! SqlFloat -> 100 ! SqlDate -> 100 ! SqlTime -> 100 ! SqlTimeTZ -> 100 ! SqlTimeStamp -> 100 ! SqlText -> 100 ! SqlUnknown _ -> 0 ! ! definePositions stmt err buffer pos offset [] = return () ! definePositions stmt err buffer pos offset (field:fields) = ! alloca $ \pDef -> do ! let size = sqlType2Size field ! poke (castPtr buffer `advancePtr` pos) (fromIntegral offset :: CInt) ! ociDefineByPos stmt ! pDef ! err ! (fromIntegral pos+1) ! (buffer `plusPtr` (offset+sizeOf (undefined :: CShort))) ! (fromIntegral size) ! (#const SQLT_STR) ! (castPtr buffer `plusPtr` offset) ! nullPtr ! nullPtr ! (#const OCI_DEFAULT) ! definePositions stmt err buffer (pos+1) (offset+size) fields mkSqlType :: (#type OCITypeCode) -> (#type ub2) -> (#type ub1) -> (#type ub1) -> SqlType *************** *** 329,334 **** getColValue :: Ptr () -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a getColValue buffer colNumber fieldDef f = do ! offset <- peek (castPtr buffer `advancePtr` colNumber) ! let valuePtr = castPtr buffer `plusPtr` fromIntegral (offset :: CInt) ! valueLen <- strlen valuePtr ! f fieldDef valuePtr (fromIntegral valueLen) --- 397,406 ---- getColValue :: Ptr () -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a getColValue buffer colNumber fieldDef f = do ! offset <- peek (castPtr buffer `advancePtr` colNumber) :: IO CInt ! let nullIndPtr = castPtr buffer `plusPtr` (fromIntegral offset) ! valuePtr = castPtr buffer `plusPtr` (fromIntegral offset + sizeOf (undefined :: CShort)) ! nullInd <- peek nullIndPtr :: IO CShort ! if nullInd /= 0 ! then f fieldDef nullPtr 0 ! else do valueLen <- strlen valuePtr ! f fieldDef valuePtr (fromIntegral valueLen) |
|
From: <br...@us...> - 2006-06-08 02:20:38
|
Update of /cvsroot/htoolkit/HSQL/PostgreSQL/Database/HSQL In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv7221/Database/HSQL Modified Files: PostgreSQL.hsc Log Message: Check result of read in PostgreSQL execute. Index: PostgreSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/PostgreSQL/Database/HSQL/PostgreSQL.hsc,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** PostgreSQL.hsc 4 Jan 2006 18:39:47 -0000 1.5 --- PostgreSQL.hsc 7 Jun 2006 22:06:12 -0000 1.6 *************** *** 113,117 **** then return (-1) else do str <- peekCString cstr ! return $! read str query :: Connection -> PGconn -> String -> IO Statement --- 113,119 ---- then return (-1) else do str <- peekCString cstr ! case reads str of ! (x,_):_ -> return x ! _ -> return (-1) query :: Connection -> PGconn -> String -> IO Statement |
|
From: <br...@us...> - 2006-03-11 20:32:04
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2890/HSQL/Database Modified Files: HSQL.hsc Log Message: The current CVS version cannot convert fields of type SqlText to Haskell Int values. This fixes this problem by calling the default version of fromSqlCStringLen if the field type is such that the value cannot be converted directly. Converting from SqlText to Int is essential for the sqlite drivers, as they return all fields as SqlText. Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** HSQL.hsc 9 Jan 2006 14:49:23 -0000 1.16 --- HSQL.hsc 11 Mar 2006 20:32:00 -0000 1.17 *************** *** 240,244 **** sqlType==SqlSmallInt|| sqlType==SqlBigInt = c_atoi cstr ! | otherwise = throwDyn (SqlBadTypeCast name sqlType) fromSqlValue SqlInteger s = Just (read s) --- 240,245 ---- sqlType==SqlSmallInt|| sqlType==SqlBigInt = c_atoi cstr ! fromSqlCStringLen field cstr cstrLen ! = defaultFromSqlCStringLen field cstr cstrLen fromSqlValue SqlInteger s = Just (read s) *************** *** 266,270 **** c_strtoll cstr nullPtr 10 #endif ! | otherwise = throwDyn (SqlBadTypeCast name sqlType) fromSqlValue SqlInteger s = Just (read s) --- 267,272 ---- c_strtoll cstr nullPtr 10 #endif ! fromSqlCStringLen field cstr cstrLen ! = defaultFromSqlCStringLen field cstr cstrLen fromSqlValue SqlInteger s = Just (read s) |
|
From: <br...@us...> - 2006-03-11 20:32:04
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2890/HSQL/Database/HSQL Modified Files: Types.hs Log Message: The current CVS version cannot convert fields of type SqlText to Haskell Int values. This fixes this problem by calling the default version of fromSqlCStringLen if the field type is such that the value cannot be converted directly. Converting from SqlText to Int is essential for the sqlite drivers, as they return all fields as SqlText. Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL/Types.hs,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Types.hs 9 Jan 2006 14:49:23 -0000 1.9 --- Types.hs 11 Mar 2006 20:32:00 -0000 1.10 *************** *** 151,162 **** -- Default version uses fromSqlValue. fromSqlCStringLen :: FieldDef -> CString -> Int -> IO a ! fromSqlCStringLen (name,sqlType,_) cstr cstrLen ! | cstr == nullPtr = throwDyn (SqlFetchNull name) ! | otherwise = do ! str <- peekCStringLen (cstr, cstrLen) ! case fromSqlValue sqlType str of ! Nothing -> throwDyn (SqlBadTypeCast name sqlType) ! Just v -> return v fromSqlValue :: SqlType -> String -> Maybe a toSqlValue :: a -> String --- 151,165 ---- -- Default version uses fromSqlValue. fromSqlCStringLen :: FieldDef -> CString -> Int -> IO a ! fromSqlCStringLen = defaultFromSqlCStringLen fromSqlValue :: SqlType -> String -> Maybe a toSqlValue :: a -> String + + defaultFromSqlCStringLen :: SqlBind a => FieldDef -> CString -> Int -> IO a + defaultFromSqlCStringLen (name,sqlType,_) cstr cstrLen + | cstr == nullPtr = throwDyn (SqlFetchNull name) + | otherwise = do + str <- peekCStringLen (cstr, cstrLen) + case fromSqlValue sqlType str of + Nothing -> throwDyn (SqlBadTypeCast name sqlType) + Just v -> return v |
|
From: <kr_...@us...> - 2006-01-09 14:49:32
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14159/HSQL/Database/HSQL Modified Files: Types.hs Log Message: Change the type of stmtExecute. This time in order to make it compatible with Oracle. Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL/Types.hs,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Types.hs 9 Jan 2006 12:44:29 -0000 1.8 --- Types.hs 9 Jan 2006 14:49:23 -0000 1.9 *************** *** 133,139 **** { stmtConn :: Connection , stmtClose :: IO () ! , stmtSetParam :: Int -> SqlValue -> IO () ! , stmtExecute :: IO Integer ! , stmtReset :: IO () , stmtFetch :: IO Bool , stmtGetCol :: forall a . Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a --- 133,137 ---- { stmtConn :: Connection , stmtClose :: IO () ! , stmtExecute :: [SqlValue] -> IO Integer , stmtFetch :: IO Bool , stmtGetCol :: forall a . Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a |
|
From: <kr_...@us...> - 2006-01-09 14:49:32
|
Update of /cvsroot/htoolkit/HSQL/SQLite/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14159/SQLite/Database/HSQL Modified Files: SQLite2.hsc Log Message: Change the type of stmtExecute. This time in order to make it compatible with Oracle. Index: SQLite2.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite/Database/HSQL/SQLite2.hsc,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** SQLite2.hsc 6 Jan 2006 09:38:51 -0000 1.5 --- SQLite2.hsc 9 Jan 2006 14:49:23 -0000 1.6 *************** *** 118,122 **** , stmtClose = sqlite_free_table pResult , stmtExecute= throwDyn SqlUnsupportedOperation - , stmtSetParam=throwDyn SqlUnsupportedOperation , stmtFetch = fetch refIndex rows , stmtGetCol = getColValue pResult refIndex columns rows --- 118,121 ---- |
|
From: <kr_...@us...> - 2006-01-09 14:49:32
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14159/HSQL/Database Modified Files: HSQL.hsc Log Message: Change the type of stmtExecute. This time in order to make it compatible with Oracle. Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** HSQL.hsc 9 Jan 2006 12:44:28 -0000 1.15 --- HSQL.hsc 9 Jan 2006 14:49:23 -0000 1.16 *************** *** 170,181 **** executePrepared :: Statement -> [SqlValue] -> IO Integer executePrepared stmt values = checkHandle (stmtClosed stmt) $ do ! stmtReset stmt ! setParameters 0 values ! stmtExecute stmt ! where ! setParameters paramNum [] = return () ! setParameters paramNum (value:values) = paramNum `seq` do ! stmtSetParam stmt paramNum value ! setParameters (paramNum+1) values -- | 'fetch' fetches the next rowset of data from the result set. --- 170,174 ---- executePrepared :: Statement -> [SqlValue] -> IO Integer executePrepared stmt values = checkHandle (stmtClosed stmt) $ do ! stmtExecute stmt values -- | 'fetch' fetches the next rowset of data from the result set. |
|
From: <kr_...@us...> - 2006-01-09 14:49:32
|
Update of /cvsroot/htoolkit/HSQL/MSI/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14159/MSI/Database/HSQL Modified Files: MSI.hsc Log Message: Change the type of stmtExecute. This time in order to make it compatible with Oracle. Index: MSI.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MSI/Database/HSQL/MSI.hsc,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** MSI.hsc 6 Jan 2006 09:42:16 -0000 1.6 --- MSI.hsc 9 Jan 2006 14:49:23 -0000 1.7 *************** *** 84,88 **** , stmtClose = closeStatement hView refRecord , stmtExecute= throwDyn SqlUnsupportedOperation - , stmtSetParam=throwDyn SqlUnsupportedOperation , stmtFetch = fetch hView refRecord , stmtGetCol = getColValue refRecord --- 84,87 ---- |
|
From: <kr_...@us...> - 2006-01-09 14:49:32
|
Update of /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14159/SQLite3/Database/HSQL Modified Files: SQLite3.hsc Log Message: Change the type of stmtExecute. This time in order to make it compatible with Oracle. Index: SQLite3.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL/SQLite3.hsc,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** SQLite3.hsc 9 Jan 2006 13:53:56 -0000 1.6 --- SQLite3.hsc 9 Jan 2006 14:49:23 -0000 1.7 *************** *** 125,130 **** , stmtClose = sqlite3_finalize stmt >>= handleSqlResult sqlite , stmtExecute= executePrepared defs sqlite stmt - , stmtReset = sqlite3_reset stmt >>= handleSqlResult sqlite - , stmtSetParam=setParam sqlite stmt , stmtFetch = fetch stmt , stmtGetCol = getColValue stmt --- 125,128 ---- *************** *** 146,151 **** , stmtClose = sqlite3_finalize stmt >>= handleSqlResult sqlite , stmtExecute= throwDyn SqlUnsupportedOperation - , stmtReset = throwDyn SqlUnsupportedOperation - , stmtSetParam=throwDyn SqlUnsupportedOperation , stmtFetch = fetch stmt , stmtGetCol = getColValue stmt --- 144,147 ---- *************** *** 154,164 **** }) ! executePrepared [] sqlite stmt = do sqlite3_step stmt changes <- sqlite3_changes sqlite return $! fromIntegral changes ! executePrepared _ sqlite stmt = do return (-1) getFieldDefs :: SQLite3Stmt -> CInt -> CInt -> IO [FieldDef] getFieldDefs stmt index count --- 150,185 ---- }) ! executePrepared [] sqlite stmt values = do ! sqlite3_reset stmt >>= handleSqlResult sqlite ! setParams sqlite stmt 1 values sqlite3_step stmt changes <- sqlite3_changes sqlite return $! fromIntegral changes ! executePrepared _ sqlite stmt values = do ! sqlite3_reset stmt >>= handleSqlResult sqlite ! setParams sqlite stmt 0 values return (-1) + setParams sqlite stmt index [] = return () + setParams sqlite stmt index (SqlStringValue value : values) = do + withCStringLen value $ \(cstr,len) -> do + sqlite3_bind_text stmt index cstr (fromIntegral len) (#const SQLITE_TRANSIENT) >>= handleSqlResult sqlite + setParams sqlite stmt (index+1) values + setParams sqlite stmt index (SqlIntValue value : values) = do + sqlite3_bind_int stmt index (fromIntegral value) >>= handleSqlResult sqlite + setParams sqlite stmt (index+1) values + setParams sqlite stmt index (SqlDoubleValue value : values) = do + sqlite3_bind_double stmt index value >>= handleSqlResult sqlite + setParams sqlite stmt (index+1) values + setParams sqlite stmt index (SqlBoolValue value : values) = do + alloca $ \pchar -> do + poke pchar (castCharToCChar $! (if value then 't' else 'f')) + sqlite3_bind_text stmt index pchar 1 (#const SQLITE_TRANSIENT) >>= handleSqlResult sqlite + setParams sqlite stmt (index+1) values + setParams sqlite stmt index (SqlClockTimeValue value : values) = throwDyn SqlUnsupportedOperation + setParams sqlite stmt index (SqlNullValue : values) = do + sqlite3_bind_null stmt index >>= handleSqlResult sqlite + setParams sqlite stmt (index+1) values + getFieldDefs :: SQLite3Stmt -> CInt -> CInt -> IO [FieldDef] getFieldDefs stmt index count *************** *** 193,214 **** else do strLen <- strlen cstr f fieldDef cstr (fromIntegral strLen) - - setParam sqlite stmt index (SqlStringValue value) = - withCStringLen value $ \(cstr,len) -> do - res <- sqlite3_bind_text stmt (fromIntegral (index+1)) cstr (fromIntegral len) (#const SQLITE_TRANSIENT) - handleSqlResult sqlite res - setParam sqlite stmt index (SqlIntValue value) = do - res <- sqlite3_bind_int stmt (fromIntegral (index+1)) (fromIntegral value) - handleSqlResult sqlite res - setParam sqlite stmt index (SqlDoubleValue value) = do - res <- sqlite3_bind_double stmt (fromIntegral (index+1)) value - handleSqlResult sqlite res - setParam sqlite stmt index (SqlBoolValue value) = - alloca $ \pchar -> do - poke pchar (castCharToCChar $! (if value then 't' else 'f')) - res <- sqlite3_bind_text stmt (fromIntegral (index+1)) pchar 1 (#const SQLITE_TRANSIENT) - handleSqlResult sqlite res - setParam sqlite stmt index (SqlClockTimeValue value) = throwDyn SqlUnsupportedOperation - setParam sqlite stmt index (SqlNullValue ) = do - res <- sqlite3_bind_null stmt (fromIntegral (index+1)) - handleSqlResult sqlite res --- 214,215 ---- |
|
From: <kr_...@us...> - 2006-01-09 13:54:08
|
Update of /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1617/Database/HSQL Modified Files: SQLite3.hsc Log Message: fix the prepared statement for NON-SELECT clauses Index: SQLite3.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL/SQLite3.hsc,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** SQLite3.hsc 9 Jan 2006 12:45:04 -0000 1.5 --- SQLite3.hsc 9 Jan 2006 13:53:56 -0000 1.6 *************** *** 41,44 **** --- 41,45 ---- foreign import ccall sqlite3_column_name :: SQLite3Stmt -> CInt -> IO CString foreign import ccall sqlite3_column_text :: SQLite3Stmt -> CInt -> IO CString + foreign import ccall sqlite3_column_type :: SQLite3Stmt -> CInt -> IO CInt foreign import ccall sqlite3_bind_double :: SQLite3Stmt -> CInt -> Double -> IO CInt foreign import ccall sqlite3_bind_int :: SQLite3Stmt -> CInt -> CInt -> IO CInt *************** *** 123,127 **** { stmtConn = connection , stmtClose = sqlite3_finalize stmt >>= handleSqlResult sqlite ! , stmtExecute= return (-1) , stmtReset = sqlite3_reset stmt >>= handleSqlResult sqlite , stmtSetParam=setParam sqlite stmt --- 124,128 ---- { stmtConn = connection , stmtClose = sqlite3_finalize stmt >>= handleSqlResult sqlite ! , stmtExecute= executePrepared defs sqlite stmt , stmtReset = sqlite3_reset stmt >>= handleSqlResult sqlite , stmtSetParam=setParam sqlite stmt *************** *** 153,161 **** }) getFieldDefs :: SQLite3Stmt -> CInt -> CInt -> IO [FieldDef] getFieldDefs stmt index count | index >= count = return [] | otherwise = do name <- sqlite3_column_name stmt index >>= peekCString ! defs <- getFieldDefs stmt (index+1) count return ((name,SqlText,True):defs) --- 154,169 ---- }) + executePrepared [] sqlite stmt = do + sqlite3_step stmt + changes <- sqlite3_changes sqlite + return $! fromIntegral changes + executePrepared _ sqlite stmt = do + return (-1) + getFieldDefs :: SQLite3Stmt -> CInt -> CInt -> IO [FieldDef] getFieldDefs stmt index count | index >= count = return [] | otherwise = do name <- sqlite3_column_name stmt index >>= peekCString ! defs <- getFieldDefs stmt (index+1) count return ((name,SqlText,True):defs) |
|
From: <kr_...@us...> - 2006-01-09 12:45:12
|
Update of /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16469/SQLite3/Database/HSQL Modified Files: SQLite3.hsc Log Message: support for prepared statements in SQLite3 Index: SQLite3.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL/SQLite3.hsc,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** SQLite3.hsc 4 Jan 2006 08:23:59 -0000 1.4 --- SQLite3.hsc 9 Jan 2006 12:45:04 -0000 1.5 *************** *** 27,30 **** --- 27,31 ---- type SQLite3 = Ptr () + type SQLite3Stmt = Ptr () foreign import ccall sqlite3_open :: CString -> (Ptr SQLite3) -> IO Int *************** *** 32,36 **** --- 33,49 ---- foreign import ccall sqlite3_close :: SQLite3 -> IO () foreign import ccall sqlite3_exec :: SQLite3 -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO CInt + foreign import ccall sqlite3_prepare :: SQLite3 -> CString -> CInt -> Ptr SQLite3Stmt -> Ptr CString -> IO CInt + foreign import ccall sqlite3_finalize :: SQLite3Stmt -> IO CInt + foreign import ccall sqlite3_step :: SQLite3Stmt -> IO CInt + foreign import ccall sqlite3_reset :: SQLite3Stmt -> IO CInt foreign import ccall sqlite3_changes :: SQLite3 -> IO CInt + foreign import ccall sqlite3_column_count :: SQLite3Stmt -> IO CInt + foreign import ccall sqlite3_column_name :: SQLite3Stmt -> CInt -> IO CString + foreign import ccall sqlite3_column_text :: SQLite3Stmt -> CInt -> IO CString + foreign import ccall sqlite3_bind_double :: SQLite3Stmt -> CInt -> Double -> IO CInt + foreign import ccall sqlite3_bind_int :: SQLite3Stmt -> CInt -> CInt -> IO CInt + foreign import ccall sqlite3_bind_int64 :: SQLite3Stmt -> CInt -> Int64 -> IO CInt + foreign import ccall sqlite3_bind_null :: SQLite3Stmt -> CInt -> IO CInt + foreign import ccall sqlite3_bind_text :: SQLite3Stmt -> CInt -> CString -> CInt -> CInt -> IO CInt foreign import ccall sqlite3_get_table :: SQLite3 -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CInt -> Ptr CString -> IO CInt foreign import ccall sqlite3_free_table :: Ptr CString -> IO () *************** *** 43,54 **** ----------------------------------------------------------------------------------------- ! handleSqlResult :: CInt -> Ptr CString -> IO () ! handleSqlResult res ppMsg | res == (#const SQLITE_OK) = return () | otherwise = do ! pMsg <- peek ppMsg ! msg <- peekCString pMsg ! sqlite3_free pMsg ! throwDyn (SqlError "E" (fromIntegral res) msg) ----------------------------------------------------------------------------------------- --- 56,67 ---- ----------------------------------------------------------------------------------------- ! handleSqlResult :: SQLite3 -> CInt -> IO () ! handleSqlResult sqlite res | res == (#const SQLITE_OK) = return () | otherwise = do ! pMsg <- sqlite3_errmsg sqlite ! msg <- peekCString pMsg ! sqlite3_free pMsg ! throwDyn (SqlError "E" (fromIntegral res) msg) ----------------------------------------------------------------------------------------- *************** *** 67,71 **** throwDyn (SqlError { seState = "C" ! , seNativeError = 0 , seErrorMsg = msg }) --- 80,84 ---- throwDyn (SqlError { seState = "C" ! , seNativeError = res , seErrorMsg = msg }) *************** *** 75,78 **** --- 88,92 ---- , connClosed = refFalse , connExecute = execute sqlite + , connPrepare = prepare connection sqlite , connQuery = query connection sqlite , connTables = tables connection sqlite *************** *** 92,133 **** execute :: SQLite3 -> String -> IO Integer execute sqlite query = ! withCString query $ \pQuery -> do ! alloca $ \ppMsg -> do ! res <- sqlite3_exec sqlite pQuery nullFunPtr nullPtr ppMsg ! handleSqlResult res ppMsg ! changes <- sqlite3_changes sqlite ! return $! fromIntegral changes query :: Connection -> SQLite3 -> String -> IO Statement ! query connection sqlite query = do ! withCString query $ \pQuery -> do ! alloca $ \ppResult -> do ! alloca $ \pnRow -> do ! alloca $ \pnColumn -> do ! alloca $ \ppMsg -> do ! res <- sqlite3_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg ! handleSqlResult res ppMsg ! pResult <- peek ppResult ! rows <- fmap fromIntegral (peek pnRow) ! columns <- fmap fromIntegral (peek pnColumn) ! defs <- getFieldDefs pResult 0 columns ! refFalse <- newMVar False ! refIndex <- newMVar 0 ! return (Statement ! { stmtConn = connection ! , stmtClose = sqlite3_free_table pResult ! , stmtFetch = fetch refIndex rows ! , stmtGetCol = getColValue pResult refIndex columns rows ! , stmtFields = defs ! , stmtClosed = refFalse ! }) ! where ! getFieldDefs :: Ptr CString -> Int -> Int -> IO [FieldDef] ! getFieldDefs pResult index count ! | index >= count = return [] ! | otherwise = do ! name <- peekElemOff pResult index >>= peekCString ! defs <- getFieldDefs pResult (index+1) count ! return ((name,SqlText,True):defs) tables :: Connection -> SQLite3 -> IO [String] --- 106,162 ---- execute :: SQLite3 -> String -> IO Integer execute sqlite query = ! withCString query $ \pQuery -> do ! sqlite3_exec sqlite pQuery nullFunPtr nullPtr nullPtr >>= handleSqlResult sqlite ! changes <- sqlite3_changes sqlite ! return $! fromIntegral changes ! ! prepare :: Connection -> SQLite3 -> String -> IO Statement ! prepare connection sqlite query = ! withCString query $ \cstr -> ! alloca $ \ppStmt -> do ! sqlite3_prepare sqlite cstr (-1) ppStmt nullPtr >>= handleSqlResult sqlite ! stmt <- peek ppStmt ! count <- sqlite3_column_count stmt ! defs <- getFieldDefs stmt 0 count ! refFalse <- newMVar False ! return (Statement ! { stmtConn = connection ! , stmtClose = sqlite3_finalize stmt >>= handleSqlResult sqlite ! , stmtExecute= return (-1) ! , stmtReset = sqlite3_reset stmt >>= handleSqlResult sqlite ! , stmtSetParam=setParam sqlite stmt ! , stmtFetch = fetch stmt ! , stmtGetCol = getColValue stmt ! , stmtFields = defs ! , stmtClosed = refFalse ! }) query :: Connection -> SQLite3 -> String -> IO Statement ! query connection sqlite query = ! withCString query $ \cstr -> ! alloca $ \ppStmt -> do ! sqlite3_prepare sqlite cstr (-1) ppStmt nullPtr >>= handleSqlResult sqlite ! stmt <- peek ppStmt ! count <- sqlite3_column_count stmt ! defs <- getFieldDefs stmt 0 count ! refFalse <- newMVar False ! return (Statement ! { stmtConn = connection ! , stmtClose = sqlite3_finalize stmt >>= handleSqlResult sqlite ! , stmtExecute= throwDyn SqlUnsupportedOperation ! , stmtReset = throwDyn SqlUnsupportedOperation ! , stmtSetParam=throwDyn SqlUnsupportedOperation ! , stmtFetch = fetch stmt ! , stmtGetCol = getColValue stmt ! , stmtFields = defs ! , stmtClosed = refFalse ! }) ! ! getFieldDefs :: SQLite3Stmt -> CInt -> CInt -> IO [FieldDef] ! getFieldDefs stmt index count ! | index >= count = return [] ! | otherwise = do name <- sqlite3_column_name stmt index >>= peekCString ! defs <- getFieldDefs stmt (index+1) count ! return ((name,SqlText,True):defs) tables :: Connection -> SQLite3 -> IO [String] *************** *** 146,158 **** return (name, SqlText, notnull=="0") ! fetch tupleIndex countTuples = ! modifyMVar tupleIndex (\index -> return (index+1,index < countTuples)) ! getColValue pResult refIndex columns rows colNumber fieldDef f = do ! index <- readMVar refIndex ! when (index > rows) (throwDyn SqlNoData) ! pStr <- peekElemOff pResult (columns*index+colNumber) ! if pStr == nullPtr ! then f fieldDef pStr 0 ! else do strLen <- strlen pStr ! f fieldDef pStr (fromIntegral strLen) --- 175,206 ---- return (name, SqlText, notnull=="0") ! fetch stmt = do ! res <- sqlite3_step stmt ! return $! (res /= (#const SQLITE_DONE)) ! getColValue stmt colNumber fieldDef f = do ! cstr <- sqlite3_column_text stmt (fromIntegral colNumber) ! if cstr == nullPtr ! then f fieldDef cstr 0 ! else do strLen <- strlen cstr ! f fieldDef cstr (fromIntegral strLen) ! ! setParam sqlite stmt index (SqlStringValue value) = ! withCStringLen value $ \(cstr,len) -> do ! res <- sqlite3_bind_text stmt (fromIntegral (index+1)) cstr (fromIntegral len) (#const SQLITE_TRANSIENT) ! handleSqlResult sqlite res ! setParam sqlite stmt index (SqlIntValue value) = do ! res <- sqlite3_bind_int stmt (fromIntegral (index+1)) (fromIntegral value) ! handleSqlResult sqlite res ! setParam sqlite stmt index (SqlDoubleValue value) = do ! res <- sqlite3_bind_double stmt (fromIntegral (index+1)) value ! handleSqlResult sqlite res ! setParam sqlite stmt index (SqlBoolValue value) = ! alloca $ \pchar -> do ! poke pchar (castCharToCChar $! (if value then 't' else 'f')) ! res <- sqlite3_bind_text stmt (fromIntegral (index+1)) pchar 1 (#const SQLITE_TRANSIENT) ! handleSqlResult sqlite res ! setParam sqlite stmt index (SqlClockTimeValue value) = throwDyn SqlUnsupportedOperation ! setParam sqlite stmt index (SqlNullValue ) = do ! res <- sqlite3_bind_null stmt (fromIntegral (index+1)) ! handleSqlResult sqlite res |
|
From: <kr_...@us...> - 2006-01-09 12:44:40
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16057/Database Modified Files: HSQL.hsc Log Message: The proper implementation for prepared statements for SQLite3 requires an additional step before the actual parameter bindings. There is a new filed stmtReset in StatementThe proper implementation for prepared statements for SQLite3 requires an additional step before the actual parameter bindings. There is a new filed stmtReset in Statement,,CVS: ---------------------------------------------------------------------- Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** HSQL.hsc 9 Jan 2006 12:25:01 -0000 1.14 --- HSQL.hsc 9 Jan 2006 12:44:28 -0000 1.15 *************** *** 170,173 **** --- 170,174 ---- executePrepared :: Statement -> [SqlValue] -> IO Integer executePrepared stmt values = checkHandle (stmtClosed stmt) $ do + stmtReset stmt setParameters 0 values stmtExecute stmt |
|
From: <kr_...@us...> - 2006-01-09 12:44:40
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16057/Database/HSQL Modified Files: Types.hs Log Message: The proper implementation for prepared statements for SQLite3 requires an additional step before the actual parameter bindings. There is a new filed stmtReset in StatementThe proper implementation for prepared statements for SQLite3 requires an additional step before the actual parameter bindings. There is a new filed stmtReset in Statement,,CVS: ---------------------------------------------------------------------- Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL/Types.hs,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Types.hs 5 Jan 2006 20:14:23 -0000 1.7 --- Types.hs 9 Jan 2006 12:44:29 -0000 1.8 *************** *** 135,138 **** --- 135,139 ---- , stmtSetParam :: Int -> SqlValue -> IO () , stmtExecute :: IO Integer + , stmtReset :: IO () , stmtFetch :: IO Bool , stmtGetCol :: forall a . Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a |
|
From: <kr_...@us...> - 2006-01-09 12:25:12
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10797/Database Modified Files: HSQL.hsc Log Message: Rename getColumnValue(') to getFieldValueAt(') Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** HSQL.hsc 5 Jan 2006 20:14:23 -0000 1.13 --- HSQL.hsc 9 Jan 2006 12:25:01 -0000 1.14 *************** *** 33,38 **** , getFieldValue -- :: SqlBind a => Statement -> String -> IO a , getFieldValue' -- :: SqlBind a => Statement -> String -> a -> IO a ! , getColumnValue -- :: SqlBind a => Statement -> Int -> IO a ! , getColumnValue' -- :: SqlBind a => Statement -> Int -> a -> IO a , getFieldValueMB , getFieldValueType -- :: Statement -> String -> (SqlType, Bool) --- 33,38 ---- , getFieldValue -- :: SqlBind a => Statement -> String -> IO a , getFieldValue' -- :: SqlBind a => Statement -> String -> a -> IO a ! , getFieldValueAt -- :: SqlBind a => Statement -> Int -> IO a ! , getFieldValueAt' -- :: SqlBind a => Statement -> Int -> a -> IO a , getFieldValueMB , getFieldValueType -- :: Statement -> String -> (SqlType, Bool) *************** *** 624,644 **** return (case mb_v of { Nothing -> def; Just a -> a }) ! -- | Retrieves the value of column with the specified index. ! getColumnValue :: SqlBind a => Statement ! -> Int -- ^ Column index ! -> IO a -- ^ Column value ! getColumnValue stmt index = fieldDef `seq` stmtGetCol stmt index fieldDef fromSqlCStringLen where fieldDef = findColumnInfo (stmtFields stmt) index ! -- | Retrieves the value of column with the specified index. -- If the column value is @null@ then the function will return the default value. ! getColumnValue' :: SqlBind a => Statement ! -> Int -- ^ Column index ! -> a -- ^ Default value ! -> IO a -- ^ Column value ! getColumnValue' stmt index def = do ! mb_v <- getColumnValue stmt index return (case mb_v of { Nothing -> def; Just a -> a }) --- 624,644 ---- return (case mb_v of { Nothing -> def; Just a -> a }) ! -- | Retrieves the value of field with the specified index. ! getFieldValueAt :: SqlBind a => Statement ! -> Int -- ^ Field index ! -> IO a -- ^ Field value ! getFieldValueAt stmt index = fieldDef `seq` stmtGetCol stmt index fieldDef fromSqlCStringLen where fieldDef = findColumnInfo (stmtFields stmt) index ! -- | Retrieves the value of field with the specified index. -- If the column value is @null@ then the function will return the default value. ! getFieldValueAt' :: SqlBind a => Statement ! -> Int -- ^ Field index ! -> a -- ^ Default value ! -> IO a -- ^ Field value ! getFieldValueAt' stmt index def = do ! mb_v <- getFieldValueAt stmt index return (case mb_v of { Nothing -> def; Just a -> a }) |
|
From: <kr_...@us...> - 2006-01-06 09:42:25
|
Update of /cvsroot/htoolkit/HSQL/MSI/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16911/Database/HSQL Modified Files: MSI.hsc Log Message: MSI doesn't support prepared statements Index: MSI.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MSI/Database/HSQL/MSI.hsc,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** MSI.hsc 3 Jan 2006 22:59:46 -0000 1.5 --- MSI.hsc 6 Jan 2006 09:42:16 -0000 1.6 *************** *** 42,45 **** --- 42,46 ---- { connDisconnect = disconnect hDatabase , connExecute = execute hDatabase + , connPrepare = throwDyn SqlUnsupportedOperation , connQuery = query connection hDatabase , connTables = tables hDatabase *************** *** 82,85 **** --- 83,88 ---- { stmtConn = connection , stmtClose = closeStatement hView refRecord + , stmtExecute= throwDyn SqlUnsupportedOperation + , stmtSetParam=throwDyn SqlUnsupportedOperation , stmtFetch = fetch hView refRecord , stmtGetCol = getColValue refRecord |
|
From: <kr_...@us...> - 2006-01-06 09:38:58
|
Update of /cvsroot/htoolkit/HSQL/SQLite/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16373/Database/HSQL Modified Files: SQLite2.hsc Log Message: SQLite2 doesn't support prepared statements Index: SQLite2.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite/Database/HSQL/SQLite2.hsc,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** SQLite2.hsc 4 Jan 2006 08:22:35 -0000 1.4 --- SQLite2.hsc 6 Jan 2006 09:38:51 -0000 1.5 *************** *** 74,77 **** --- 74,78 ---- , connClosed = refFalse , connExecute = execute sqlite + , connPrepare = throwDyn SqlUnsupportedOperation , connQuery = query connection sqlite , connTables = tables connection sqlite *************** *** 116,119 **** --- 117,122 ---- { stmtConn = connection , stmtClose = sqlite_free_table pResult + , stmtExecute= throwDyn SqlUnsupportedOperation + , stmtSetParam=throwDyn SqlUnsupportedOperation , stmtFetch = fetch refIndex rows , stmtGetCol = getColValue pResult refIndex columns rows |
|
From: <kr_...@us...> - 2006-01-05 20:14:31
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21065/Database/HSQL Modified Files: Types.hs Log Message: the stmtSetParam method needs the param index. Index: Types.hs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL/Types.hs,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Types.hs 4 Jan 2006 22:19:57 -0000 1.6 --- Types.hs 5 Jan 2006 20:14:23 -0000 1.7 *************** *** 133,137 **** { stmtConn :: Connection , stmtClose :: IO () ! , stmtSetParam :: SqlValue -> IO () , stmtExecute :: IO Integer , stmtFetch :: IO Bool --- 133,137 ---- { stmtConn :: Connection , stmtClose :: IO () ! , stmtSetParam :: Int -> SqlValue -> IO () , stmtExecute :: IO Integer , stmtFetch :: IO Bool |
221 messages has been excluded from this view by a project administrator.
