HDBC-postgresql 2.2.3.1 → 2.2.3.2
raw patch · 7 files changed
+62/−14 lines, 7 filesdep ~HDBCdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: HDBC, base
API changes (from Hackage documentation)
Files
- Database/HDBC/PostgreSQL.hs +15/−0
- Database/HDBC/PostgreSQL/Connection.hsc +24/−4
- Database/HDBC/PostgreSQL/Statement.hsc +4/−4
- Database/HDBC/PostgreSQL/Types.hs +4/−1
- Database/HDBC/PostgreSQL/Utils.hsc +10/−2
- HDBC-postgresql.cabal +3/−2
- testsrc/TestTime.hs +2/−1
Database/HDBC/PostgreSQL.hs view
@@ -69,9 +69,24 @@ -- |When an @SqlError@ is thrown, the field @seState@ is set to one of the following -- error codes. module Database.HDBC.PostgreSQL.ErrorCodes,++ -- * Threading+ -- $threading ) where import Database.HDBC.PostgreSQL.Connection(connectPostgreSQL, Connection()) import Database.HDBC.PostgreSQL.ErrorCodes++{- $threading+ + Provided the local libpq library is thread-safe, multiple 'Connection's may be used+ to have concurrent database queries. Concurrent queries issued on a single + 'Connection' will be performed serially.++ When the local libpq library is not thread-safe (ie. it has not been compiled with + --enable-thread-safety), only a single database function will be performed at a time.+ +-}+
Database/HDBC/PostgreSQL/Connection.hsc view
@@ -37,13 +37,22 @@ import Foreign.Ptr import Data.Word import Data.Maybe-import Control.Concurrent.MVar import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BUTF8+import Control.Concurrent.MVar+import System.IO (stderr, hPutStrLn)+import System.IO.Unsafe (unsafePerformIO) + #include <libpq-fe.h> #include <pg_config.h> ++-- | A global lock only used when libpq is /not/ thread-safe. In that situation+-- this mvar is used to serialize access to the FFI calls marked as /safe/.+{-# NOINLINE globalConnLock #-}+globalConnLock = unsafePerformIO $ newMVar ()+ {- | Connect to a PostgreSQL server. See <http://www.postgresql.org/docs/8.1/static/libpq.html#LIBPQ-CONNECT> for the meaning@@ -51,11 +60,19 @@ connectPostgreSQL :: String -> IO Impl.Connection connectPostgreSQL args = B.useAsCString (BUTF8.fromString args) $ \cs -> do ptr <- pqconnectdb cs+ threadSafe <- pqisThreadSafe ptr+ connLock <- if threadSafe==0 -- Also check GHC.Conc.numCapabilities here?+ then do hPutStrLn stderr "WARNING: libpq is not threadsafe, \+ \serializing all libpq FFI calls. \+ \(Consider recompiling libpq with \+ \--enable-thread-safety.\n"+ return globalConnLock+ else newMVar () status <- pqstatus ptr wrappedptr <- wrapconn ptr nullPtr fptr <- newForeignPtr pqfinishptr wrappedptr case status of- #{const CONNECTION_OK} -> mkConn args fptr+ #{const CONNECTION_OK} -> mkConn args (connLock,fptr) _ -> raiseError "connectPostgreSQL" status ptr -- FIXME: environment vars may have changed, should use pgsql enquiries@@ -120,7 +137,7 @@ do sth <- newSth conn children "select table_name from information_schema.tables where \ \table_schema != 'pg_catalog' AND table_schema != \- \'information_schema' AND table_schema != 'system_schema'"+ \'information_schema'" execute sth [] res1 <- fetchAllRows' sth let res = map fromSql $ concat res1@@ -154,7 +171,7 @@ do closeAllChildren mchildren withRawConn conn $ pqfinish -foreign import ccall unsafe "libpq-fe.h PQconnectdb"+foreign import ccall safe "libpq-fe.h PQconnectdb" pqconnectdb :: CString -> IO (Ptr CConn) foreign import ccall unsafe "hdbc-postgresql-helper.h wrapobjpg"@@ -174,3 +191,6 @@ foreign import ccall unsafe "libpq-fe.h PQserverVersion" pqserverVersion :: Ptr CConn -> IO CInt++foreign import ccall unsafe "libpq.fe.h PQisthreadsafe"+ pqisThreadSafe :: Ptr CConn -> IO Int
Database/HDBC/PostgreSQL/Statement.hsc view
@@ -97,7 +97,7 @@ {- For now, we try to just handle things as simply as possible. FIXME lots of room for improvement here (types, etc). -} fexecute :: (Num a, Read a) => SState -> [SqlValue] -> IO a-fexecute sstate args = withConn (dbo sstate) $ \cconn ->+fexecute sstate args = withConnLocked (dbo sstate) $ \cconn -> B.useAsCString (BUTF8.fromString (squery sstate)) $ \cquery -> withCStringArr0 args $ \cargs -> -- wichSTringArr0 uses UTF-8 do l "in fexecute"@@ -111,7 +111,7 @@ is useful for issuing DDL or DML commands. -} fexecuteRaw :: SState -> IO () fexecuteRaw sstate =- withConn (dbo sstate) $ \cconn ->+ withConnLocked (dbo sstate) $ \cconn -> B.useAsCString (BUTF8.fromString (squery sstate)) $ \cquery -> do l "in fexecute" public_ffinish sstate -- Sets nextrowmv to -1@@ -239,7 +239,7 @@ foreign import ccall unsafe "libpq-fe.h PQresultStatus" pqresultStatus :: (Ptr CStmt) -> IO #{type ExecStatusType} -foreign import ccall unsafe "libpq-fe.h PQexecParams"+foreign import ccall safe "libpq-fe.h PQexecParams" pqexecParams :: (Ptr CConn) -> CString -> CInt -> (Ptr #{type Oid}) -> (Ptr CString) ->@@ -248,7 +248,7 @@ CInt -> IO (Ptr CStmt) -foreign import ccall unsafe "libpq-fe.h PQexec"+foreign import ccall safe "libpq-fe.h PQexec" pqexec :: (Ptr CConn) -> CString -> IO (Ptr CStmt) foreign import ccall unsafe "hdbc-postgresql-helper.h PQclear_app"
Database/HDBC/PostgreSQL/Types.hs view
@@ -2,10 +2,13 @@ where import Foreign+import Control.Concurrent.MVar +type ConnLock = MVar ()+ data CConn = CConn type WrappedCConn = Ptr CConn-type Conn = ForeignPtr WrappedCConn+type Conn = (ConnLock, ForeignPtr WrappedCConn) data CStmt = CStmt type WrappedCStmt = Ptr CStmt
Database/HDBC/PostgreSQL/Utils.hsc view
@@ -23,6 +23,7 @@ import Database.HDBC(throwSqlError) import Database.HDBC.Types import Database.HDBC.PostgreSQL.Types+import Control.Concurrent.MVar import Foreign.C.Types import Control.Exception import Foreign.Storable@@ -60,10 +61,17 @@ Ditto for statements. -} withConn :: Conn -> (Ptr CConn -> IO b) -> IO b-withConn = genericUnwrap+withConn (_lock,conn) = genericUnwrap conn +-- Perform the associated action with the connection lock held.+-- Care must be taken with the use of this as it is *not* re-entrant. Calling it+-- a second time in the same thread will cause dead-lock. +-- (A better approach would be to use RLock from concurrent-extra)+withConnLocked :: Conn -> (Ptr CConn -> IO b) -> IO b+withConnLocked c@(lock,_) a = withConn c (\cconn -> withMVar lock (\_ -> a cconn))+ withRawConn :: Conn -> (Ptr WrappedCConn -> IO b) -> IO b-withRawConn = withForeignPtr+withRawConn (_lock,conn) = withForeignPtr conn withStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b withStmt = genericUnwrap
HDBC-postgresql.cabal view
@@ -1,5 +1,5 @@ Name: HDBC-postgresql-Version: 2.2.3.1+Version: 2.2.3.2 License: LGPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -51,7 +51,8 @@ if flag(buildtests) Buildable: True Build-Depends: HUnit, QuickCheck, testpack, containers,- convertible, time, old-locale+ convertible, time, old-locale, parsec, utf8-string,+ bytestring, old-time, base, HDBC>=2.2.6 else Buildable: False Main-Is: runtests.hs
testsrc/TestTime.hs view
@@ -9,7 +9,8 @@ import Data.Maybe import Data.Convertible import SpecificDB-import System.Locale+import System.Locale(defaultTimeLocale)+import Database.HDBC.Locale (iso8601DateFormat) import qualified System.Time as ST instance Eq ZonedTime where