Menu
▾
▴
[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.16,1.17
|
From: <br...@us...> - 2004-01-14 16:07:34
|
Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv31151
Modified Files:
HSQL.hsc
Log Message:
Fixed tables and describe to use column numbers instead of column names.
Fixed bug in long data handling where the data retrieved by the initial SQLGetData() call would be discarded.
The data buffer in the Statement object now contains only data, len_or_ind is returned in a separate temporary buffer instead.
Added support for SQL_FLOAT (treating it as SQL_DOUBLE for now, that seems to be the most common case).
Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** HSQL.hsc 5 Jan 2004 20:23:25 -0000 1.16
--- HSQL.hsc 14 Jan 2004 16:07:31 -0000 1.17
***************
*** 122,125 ****
--- 122,126 ----
| SqlInteger
| SqlReal
+ | SqlFloat
| SqlDouble
| SqlBit
***************
*** 285,289 ****
(fields, bufSize) <- getFieldDefs hSTMT pFIELD 1 count
free pFIELD
! buffer <- mallocBytes (fromIntegral (bufSize+(#const sizeof(SQLINTEGER))))
let statement = Statement {hSTMT=hSTMT, connection=conn, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufSize}
return statement
--- 286,290 ----
(fields, bufSize) <- getFieldDefs hSTMT pFIELD 1 count
free pFIELD
! buffer <- mallocBytes (fromIntegral bufSize)
let statement = Statement {hSTMT=hSTMT, connection=conn, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufSize}
return statement
***************
*** 314,317 ****
--- 315,323 ----
mkSqlType (#const SQL_INTEGER) _ _ = (SqlInteger, (#const sizeof(SQLINTEGER)))
mkSqlType (#const SQL_REAL) _ _ = (SqlReal, (#const sizeof(SQLDOUBLE)))
+ -- From: http://msdn.microsoft.com/library/en-us/odbc/htm/odappdpr_2.asp
+ -- "Depending on the implementation, the precision of SQL_FLOAT can be either 24 or 53:
+ -- if it is 24, the SQL_FLOAT data type is the same as SQL_REAL;
+ -- if it is 53, the SQL_FLOAT data type is the same as SQL_DOUBLE."
+ mkSqlType (#const SQL_FLOAT) _ _ = (SqlFloat, (#const sizeof(SQLDOUBLE)))
mkSqlType (#const SQL_DOUBLE) _ _ = (SqlDouble, (#const sizeof(SQLDOUBLE)))
mkSqlType (#const SQL_BIT) _ _ = (SqlBit, (#const sizeof(SQLINTEGER)))
***************
*** 327,331 ****
mkSqlType (#const SQL_WVARCHAR) size _ = (SqlWVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
mkSqlType (#const SQL_WLONGVARCHAR) size _ = (SqlWLongVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
!
-- | Executes the statement and returns a 'Statement' value which represents the result set
--- 333,339 ----
mkSqlType (#const SQL_WVARCHAR) size _ = (SqlWVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
mkSqlType (#const SQL_WLONGVARCHAR) size _ = (SqlWLongVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
! mkSqlType t size prec = error $ "Unsupported SQL type: " ++ show t
! ++ " (size: " ++ show size
! ++ ", precision: " ++ show prec ++ ")"
-- | Executes the statement and returns a 'Statement' value which represents the result set
***************
*** 360,367 ****
tables conn = do
stmt <- withStatement conn sqlTables'
! -- SQLTables returns:
-- Column name # Type
-- TABLE_NAME 3 VARCHAR
! collectRows (\s -> getFieldValue' s "TABLE_NAME" "") stmt
where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
--- 368,375 ----
tables conn = do
stmt <- withStatement conn sqlTables'
! -- SQLTables returns (column names may vary):
-- Column name # Type
-- TABLE_NAME 3 VARCHAR
! collectRows (\s -> getColValue s 3) stmt
where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
***************
*** 377,381 ****
withCStringLen table (\(pTable,len) ->
sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0)
! -- SQLColumns returns:
-- Column name # Type
-- COLUMN_NAME 4 Varchar not NULL
--- 385,389 ----
withCStringLen table (\(pTable,len) ->
sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0)
! -- SQLColumns returns (column names may vary):
-- Column name # Type
-- COLUMN_NAME 4 Varchar not NULL
***************
*** 386,397 ****
getColumnInfo stmt =
do
! name <- getFieldValue stmt "COLUMN_NAME"
! (t::Int) <- getFieldValue stmt "DATA_TYPE"
! (size::Int) <- getFieldValue' stmt "COLUMN_SIZE" 0
! (prec::Int) <- getFieldValue' stmt "DECIMAL_DIGITS" 0
! (n::Int) <- getFieldValue stmt "NULLABLE"
! let (sqlType,_) = mkSqlType (fromIntegral t) (fromIntegral size) (fromIntegral prec)
! nullable = n /= (#const SQL_NO_NULLS)
! return (name, sqlType, nullable)
-----------------------------------------------------------------------------------------
--- 394,424 ----
getColumnInfo stmt =
do
! column_name <- getColValue stmt 4
! (data_type::Int) <- getColValue stmt 5
! (column_size::Int) <- getColValue' stmt 7 0
! (decimal_digits::Int) <- getColValue' stmt 9 0
! (nullable::Int) <- getColValue stmt 11
! let (sqlType,_) = mkSqlType (fromIntegral data_type)
! (fromIntegral column_size)
! (fromIntegral decimal_digits)
! return (column_name, sqlType, nullable /= (#const SQL_NO_NULLS))
!
! -- | Get the name of a field given its column number. For internal use.
! getColName :: Statement -> Int -> String
! getColName stmt colNumber
! | colNumber >= 1 && colNumber <= length fs =
! let (name,_,_) = fs!!(colNumber-1) in name
! | otherwise = error $ "Bad column: " ++ show colNumber ++ " (1 - "
! ++ show (length fs) ++ ")"
! where fs = fields stmt
!
! -- | Get the value of a column by number. For internal use.
! getColValue :: SqlBind a => Statement -> Int -> IO a
! getColValue stmt colNumber = getFieldValue stmt (getColName stmt colNumber)
!
! -- | Get the value of a column by number, with a default value
! -- to return instead of NULL. For internal use.
! getColValue' :: SqlBind a => Statement -> Int -> a -> IO a
! getColValue' stmt colNumber def = getFieldValue' stmt (getColName stmt colNumber) def
-----------------------------------------------------------------------------------------
***************
*** 464,467 ****
--- 491,495 ----
fromSqlValue (SqlNumeric _ _) ptr size = fmap Just $ peek (castPtr ptr)
fromSqlValue SqlDouble ptr size = fmap Just $ peek (castPtr ptr)
+ fromSqlValue SqlFloat ptr size = fmap Just $ peek (castPtr ptr)
fromSqlValue SqlReal ptr size = fmap Just $ peek (castPtr ptr)
fromSqlValue _ _ _ = return Nothing
***************
*** 513,521 ****
-> String -- ^ Field name
-> IO (Maybe a) -- ^ Field value or Nothing
! getFieldValueMB (Statement {hSTMT=hSTMT, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufferSize}) name = do
! let dataBuffer = buffer `plusPtr` (#const sizeof(SQLINTEGER))
! res <- sqlGetData hSTMT colNumber targetType dataBuffer bufferSize (castPtr buffer)
! handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! (len_or_ind :: SQLINTEGER) <- peek (castPtr buffer)
if len_or_ind == (#const SQL_NULL_DATA)
then return Nothing
--- 541,547 ----
-> String -- ^ Field name
-> IO (Maybe a) -- ^ Field value or Nothing
! getFieldValueMB (Statement {hSTMT=hSTMT, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufferSize}) name =
! do
! (res,len_or_ind) <- getData buffer bufferSize
if len_or_ind == (#const SQL_NULL_DATA)
then return Nothing
***************
*** 523,527 ****
mb_value <- (if res == (#const SQL_SUCCESS_WITH_INFO)
then getLongData len_or_ind
! else fromSqlValue sqlType dataBuffer (fromIntegral len_or_ind))
case mb_value of
Just value -> return (Just value)
--- 549,553 ----
mb_value <- (if res == (#const SQL_SUCCESS_WITH_INFO)
then getLongData len_or_ind
! else fromSqlValue sqlType buffer (fromIntegral len_or_ind))
case mb_value of
Just value -> return (Just value)
***************
*** 529,544 ****
where
(sqlType,nullable,colNumber) = findFieldInfo name fields 1
!
! getLongData len = do
! buffer <- mallocBytes (fromIntegral (len+(#const sizeof(SQLINTEGER))+1))
! let dataBuffer = buffer `plusPtr` (#const sizeof(SQLINTEGER))
! res <- sqlGetData hSTMT colNumber targetType dataBuffer (len+1) (castPtr buffer)
! unless (sqlSuccess res) (free buffer)
! handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! (len_or_ind :: SQLINTEGER) <- peek (castPtr buffer)
! r <- fromSqlValue sqlType dataBuffer (fromIntegral len_or_ind)
! free buffer
! return r
!
targetType = case sqlType of
SqlBit -> (#const SQL_C_BIT)
--- 555,586 ----
where
(sqlType,nullable,colNumber) = findFieldInfo name fields 1
!
! -- | Get data from the current column to the given buffer
! getData :: Ptr () -> SQLINTEGER -> IO (SQLRETURN, SQLINTEGER)
! getData buffer size = alloca $ \lenP ->
! do
! res <- sqlGetData hSTMT colNumber targetType buffer size lenP
! handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! len_or_ind <- peek lenP
! return (res, len_or_ind)
!
! -- gets called only when there is more data than would
! -- fit in the normal buffer. This call to
! -- SQLGetData() will fetch the rest of the data.
! -- We create a new buffer big enough to hold the
! -- old and the new data, copy the old data into
! -- it and put the new data in buffer after the old.
! getLongData len = allocaBytes (fromIntegral newBufSize) $ \newBuf -> do
! copyBytes newBuf buffer (fromIntegral bufferSize)
! -- The last byte of the old data with always be null,
! -- so it is overwritten with the first byte of the new data.
! let newDataStart = newBuf `plusPtr` (fromIntegral bufferSize - 1)
! newDataLen = newBufSize - (bufferSize - 1)
! (res,_) <- getData newDataStart newDataLen
! fromSqlValue sqlType newBuf (fromIntegral len)
! where newBufSize = len+1 -- to allow for terminating null character
!
!
!
targetType = case sqlType of
SqlBit -> (#const SQL_C_BIT)
***************
*** 547,550 ****
--- 589,593 ----
SqlInteger -> (#const SQL_C_SLONG)
SqlReal -> (#const SQL_C_FLOAT)
+ SqlFloat -> (#const SQL_C_DOUBLE)
SqlDouble -> (#const SQL_C_DOUBLE)
SqlDate -> (#const SQL_C_TIMESTAMP)
|
