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

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

Update of /cvsroot/htoolkit/HSQL/src/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22171/src/HSQL

Modified Files:
	ODBC.hsc 
Log Message:
Added driverConnect function


Index: ODBC.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/ODBC.hsc,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** ODBC.hsc	10 Feb 2004 11:30:52 -0000	1.7
--- ODBC.hsc	24 Feb 2004 08:45:20 -0000	1.8
***************
*** 12,16 ****
  -----------------------------------------------------------------------------------------
  
! module Database.HSQL.ODBC(connect, module Database.HSQL) where
  
  import Database.HSQL
--- 12,16 ----
  -----------------------------------------------------------------------------------------
  
! module Database.HSQL.ODBC(connect, driverConnect, module Database.HSQL) where
  
  import Database.HSQL
***************
*** 59,62 ****
--- 59,63 ----
  foreign import #{CALLCONV} "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLDriverConnect" sqlDriverConnect :: HDBC -> Ptr () -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> SQLUSMALLINT -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
  foreign import #{CALLCONV} "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
***************
*** 131,140 ****
          -> String               -- ^ Authentication string (password)
          -> IO Connection        -- ^ the returned value represents the new connection
! connect server user authentication = withForeignPtr myEnvironment $ \hEnv -> do
! 	(phDBC :: Ptr HDBC) <- malloc
! 	res <- sqlAllocConnect hEnv phDBC
! 	hDBC <- peek phDBC
! 	free phDBC
! 	handleSqlResult (#const SQL_HANDLE_ENV) hEnv res
  	pServer <- newCString server
  	pUser <- newCString user
--- 132,136 ----
          -> String               -- ^ Authentication string (password)
          -> IO Connection        -- ^ the returned value represents the new connection
! connect server user authentication = connectHelper $ \hDBC -> do
  	pServer <- newCString server
  	pUser <- newCString user
***************
*** 144,147 ****
--- 140,168 ----
  	free pUser
  	free pAuthentication
+ 	return res
+ 
+ -- | 'driverConnect' is an alternative to 'connect'. It supports data sources that 
+ -- require more connection information than the three arguments in 'connect'
+ -- and data sources that are not defined in the system information.
+ driverConnect :: String               -- ^ Connection string
+               -> IO Connection        -- ^ the returned value represents the new connection
+ driverConnect connString = connectHelper $ \hDBC -> do
+ 	pConnString <- newCString connString
+ 	pOutConnString <- mallocBytes 1024
+ 	pLen <- malloc
+ 	res <- sqlDriverConnect hDBC nullPtr pConnString (fromIntegral (length connString)) pOutConnString 1024 pLen (#const SQL_DRIVER_NOPROMPT)
+ 	free pLen
+ 	free pOutConnString
+ 	free pConnString
+ 	return res
+ 
+ connectHelper :: (HDBC -> IO SQLRETURN) -> IO Connection
+ connectHelper connectFunction = withForeignPtr myEnvironment $ \hEnv -> do
+ 	(phDBC :: Ptr HDBC) <- malloc
+ 	res <- sqlAllocConnect hEnv phDBC
+ 	hDBC <- peek phDBC
+ 	free phDBC
+ 	handleSqlResult (#const SQL_HANDLE_ENV) hEnv res
+ 	res <- connectFunction hDBC
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
  	refFalse <- newMVar False