Commits

Bryan O'Sullivan committed a1b7591

Add support for flags on mysql_real_connect.

  • Participants
  • Parent commits 1759329

Comments (0)

Files changed (3)

File Database/MySQL.hs

 import Data.ByteString.Unsafe
 import Database.MySQL.Types
 import System.Mem.Weak
-    
+import Data.List    
 import Control.Applicative
 import Data.Int
 import Data.Typeable (Typeable)
   forM_ connectOptions $ \opt -> do
     r <- mysql_options ptr0 opt
     unless (r == 0) $ connectionError_ "connect" ptr0
+  let flags = foldl' (+) 0 . map toConnectFlag $ connectOptions
   ptr <- withString connectHost $ \chost ->
           withString connectUser $ \cuser ->
            withString connectPassword $ \cpass ->
             withString connectDatabase $ \cdb ->
-             withRTSSignalsBlocked . withString connectPath $
-              mysql_real_connect ptr0 chost cuser cpass cdb
-                                 (fromIntegral connectPort)
+             withString connectPath $ \cpath ->
+              withRTSSignalsBlocked $
+               mysql_real_connect ptr0 chost cuser cpass cdb
+                                  (fromIntegral connectPort) cpath flags
   when (ptr == nullPtr) $
     connectionError_ "connect" ptr0
   res <- newIORef Nothing

File Database/MySQL/C.hsc

         withBool b $ go (#const MYSQL_OPT_RECONNECT)
       SSLVerifyServerCert b ->
         withBool b $ go (#const MYSQL_OPT_SSL_VERIFY_SERVER_CERT)
+      -- Other options are accepted by mysql_real_connect, so ignore them.
+      _ -> return 0
   where
     go = mysql_options_ ptr
     withBool b = with (if b then 1 else 0 :: CUInt)
     -> CString   -- ^ Database.
     -> CInt      -- ^ Port.
     -> CString   -- ^ Unix socket.
+    -> CULong    -- ^ Flags.
     -> IO (Ptr MYSQL)
 
 foreign import ccall safe mysql_ssl_set

File Database/MySQL/Types.hsc

     , flagAutoIncrement
     , flagNumeric
     , flagNoDefaultValue
+    -- * Connect flags
+    , toConnectFlag
     ) where
 
 #include "mysql.h"
               | Memory
                 deriving (Eq, Read, Show, Enum, Typeable)
 
-data Option = ConnectTimeout Seconds
+data Option =
+            -- Options accepted by mysq_options.
+              ConnectTimeout Seconds
             | Compress
             | NamedPipe
             | InitCommand ByteString
             | ReportDataTruncation Bool
             | Reconnect Bool
             | SSLVerifyServerCert Bool
+            -- Flags accepted by mysql_real_connect.
+            | FoundRows
+            | IgnoreSIGPIPE
+            | IgnoreSpace
+            | Interactive
+            | LocalFiles
+            | MultiResults
+            | MultiStatements
+            | NoSchema
               deriving (Eq, Read, Show, Typeable)
+
+toConnectFlag :: Option -> CULong
+toConnectFlag Compress  = #const CLIENT_COMPRESS
+toConnectFlag FoundRows = #const CLIENT_FOUND_ROWS
+toConnectFlag IgnoreSIGPIPE = #const CLIENT_IGNORE_SIGPIPE
+toConnectFlag IgnoreSpace = #const CLIENT_IGNORE_SPACE
+toConnectFlag Interactive = #const CLIENT_INTERACTIVE
+toConnectFlag LocalFiles = #const CLIENT_LOCAL_FILES
+toConnectFlag MultiResults = #const CLIENT_MULTI_RESULTS
+toConnectFlag MultiStatements = #const CLIENT_MULTI_STATEMENTS
+toConnectFlag NoSchema = #const CLIENT_NO_SCHEMA
+toConnectFlag _        = 0