[htoolkit-cvs] HSQL/ODBC/Database/HSQL ODBC.hsc,1.4,1.5

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

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

Modified Files:
	ODBC.hsc 
Log Message:
Another way to handle null values in HSQL. Not tested yet.


Index: ODBC.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/Database/HSQL/ODBC.hsc,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** ODBC.hsc	12 Oct 2005 14:30:05 -0000	1.4
--- ODBC.hsc	12 Dec 2005 15:21:56 -0000	1.5
***************
*** 311,315 ****
  			-- Column name     #   Type
  			-- TABLE_NAME      3   VARCHAR
! 			collectRows (\s -> getFieldValue  s 3 ("TABLE_NAME", SqlVarChar 0, False) "") stmt
  			where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
  
--- 311,315 ----
  			-- 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
  
***************
*** 320,325 ****
  			where
  				sqlColumns' table hSTMT =
! 					withCStringLen table (\(pTable,len) ->
! 						sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0)
  					-- SQLColumns returns (column names may vary):
  					-- Column name     #   Type
--- 320,325 ----
  			where
  				sqlColumns' table hSTMT =
! 				  withCStringLen table (\(pTable,len) ->
! 				        sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0)
  					-- SQLColumns returns (column names may vary):
  					-- Column name     #   Type
***************
*** 331,345 ****
  
  				getColumnInfo stmt = do
! 					column_name <- getFieldValue stmt 4 ("COLUMN_NAME", SqlVarChar 0, False) ""
! 					(data_type::Int) <- getFieldValue stmt 5 ("DATA_TYPE", SqlSmallInt, False) 0
! 					(column_size::Int) <- getFieldValue stmt 7 ("COLUMN_SIZE", SqlInteger, True) 0
! 					(decimal_digits::Int) <- getFieldValue stmt 9 ("DECIMAL_DIGITS", SqlSmallInt, True) 0
! 					(nullable::Int) <- getFieldValue stmt 11 ("NULLABLE", SqlSmallInt, False) 0
! 					let sqlType = mkSqlType (fromIntegral data_type) (fromIntegral column_size) (fromIntegral decimal_digits)
! 					return (column_name, sqlType, toBool nullable)
! 
! 		getFieldValue stmt colNumber fieldDef v = do
! 			mb_v <- stmtGetCol stmt (colNumber-1) fieldDef fromNonNullSqlCStringLen
! 			return (case mb_v of { Nothing -> v; Just a -> a })
  
  		fetch :: HSTMT -> IO Bool
--- 331,341 ----
  
  				getColumnInfo stmt = do
! 				  column_name <- getFieldValue stmt "COLUMN_NAME"
! 				  (data_type::Int) <- getFieldValue stmt "DATA_TYPE"
! 				  (column_size::Int) <- getFieldValue' stmt "COLUMN_SIZE" 0
! 				  (decimal_digits::Int) <- getFieldValue' stmt "DECIMAL_DIGITS" 0
! 				  (nullable::Int) <- getFieldValue stmt "NULLABLE"
! 				  let sqlType = mkSqlType (fromIntegral data_type) (fromIntegral column_size) (fromIntegral decimal_digits)
! 				  return (column_name, sqlType, toBool nullable)
  
  		fetch :: HSTMT -> IO Bool
***************
*** 349,364 ****
  			return (res /= (#const SQL_NO_DATA))
  
! 		getColValue :: HSTMT -> CString -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
! 		getColValue hSTMT buffer colNumber (name,sqlType,nullable) f = do
  			(res,len_or_ind) <- getData buffer (fromIntegral stmtBufferSize)
  			if len_or_ind == (#const SQL_NULL_DATA)
! 			  then return Nothing
! 			  else do
! 				mb_value <- (if res == (#const SQL_SUCCESS_WITH_INFO)
! 				                      then getLongData len_or_ind
! 				                      else f sqlType buffer (fromIntegral len_or_ind))
! 				case mb_value of
! 					Just value -> return (Just value)
! 					Nothing    -> throwDyn (SqlBadTypeCast name sqlType)
  			where
  				getData :: CString -> SQLINTEGER -> IO (SQLRETURN, SQLINTEGER)
--- 345,356 ----
  			return (res /= (#const SQL_NO_DATA))
  
! 		getColValue :: HSTMT -> CString -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a
! 		getColValue hSTMT buffer colNumber fieldDef f = do
  			(res,len_or_ind) <- getData buffer (fromIntegral stmtBufferSize)
  			if len_or_ind == (#const SQL_NULL_DATA)
! 			  then f fieldDef nullPtr 0
! 			  else if res == (#const SQL_SUCCESS_WITH_INFO)
! 				 then getLongData len_or_ind
! 				 else f fieldDef buffer (fromIntegral len_or_ind)
  			where
  				getData :: CString -> SQLINTEGER -> IO (SQLRETURN, SQLINTEGER)
***************
*** 382,386 ****
  					    newDataLen = newBufSize - (fromIntegral stmtBufferSize - 1)
  					(res,_) <- getData newDataStart newDataLen
! 					f sqlType newBuf (fromIntegral newBufSize-1)
  					where
  						newBufSize = len+1 -- to allow for terminating null character
--- 374,378 ----
  					    newDataLen = newBufSize - (fromIntegral stmtBufferSize - 1)
  					(res,_) <- getData newDataStart newDataLen
! 					f fieldDef newBuf (fromIntegral newBufSize-1)
  					where
  						newBufSize = len+1 -- to allow for terminating null character