postgresql-libpq 0.9.0.2 → 0.9.1.0
raw patch · 3 files changed
+170/−33 lines, 3 files
Files
- cbits/noticehandlers.c +59/−0
- postgresql-libpq.cabal +4/−2
- src/Database/PostgreSQL/LibPQ.hsc +107/−31
+ cbits/noticehandlers.c view
@@ -0,0 +1,59 @@+#include "noticehandlers.h"+#include <libpq-fe.h>+#include <stdlib.h>++void+hs_postgresql_libpq_discard_notices(NoticeBuffer* arg, const PGresult* res) {+ return;+}++void+hs_postgresql_libpq_store_notices(NoticeBuffer* arg, const PGresult* res) {+ if (arg == NULL || res == NULL) return;+ const char* msg = PQresultErrorMessage(res);+ if (msg == NULL) return;+ size_t len = strlen(msg);+ PGnotice* notice = (PGnotice*)malloc(sizeof(PGnotice) + sizeof(char)*(len + 1));+ notice->next = NULL;+ notice->len = len;+ memcpy(notice->str, msg, len+1);+ if (arg->last == NULL) {+ arg->first = notice;+ arg->last = notice;+ } else {+ arg->last->next = notice;+ arg->last = notice;+ }+}++PGnotice *+hs_postgresql_libpq_get_notice(NoticeBuffer* arg) {+ if (arg == NULL) return NULL;+ PGnotice * res = arg->first;+ if (res == NULL) return NULL;+ PGnotice * next = res->next;+ arg->first = next;+ if (next == NULL) arg->last = NULL;+ return res;+}++NoticeBuffer *+hs_postgresql_libpq_malloc_noticebuffer (void) {+ NoticeBuffer * arg = (NoticeBuffer*)malloc(sizeof(NoticeBuffer));+ if (arg == NULL) return NULL;+ arg->first = NULL;+ arg->last = NULL;+ return arg;+}++void+hs_postgresql_libpq_free_noticebuffer (NoticeBuffer * arg) {+ if (arg == NULL) return;+ PGnotice * x = arg->first;+ PGnotice * nx;+ while (x != NULL) {+ nx = x->next;+ free(x);+ x = nx;+ }+}
postgresql-libpq.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-libpq-Version: 0.9.0.2+Version: 0.9.1.0 Synopsis: low-level binding to libpq Description: This is a binding to libpq: the C application@@ -29,6 +29,8 @@ Library hs-source-dirs: src+ c-sources: cbits/noticehandlers.c+ include-dirs: cbits Exposed-modules: Database.PostgreSQL.LibPQ Build-depends: base >= 4 && < 5@@ -52,4 +54,4 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-libpq- tag: v0.9.0.2+ tag: v0.9.1.0
src/Database/PostgreSQL/LibPQ.hsc view
@@ -43,6 +43,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-} module Database.PostgreSQL.LibPQ (@@ -185,6 +186,11 @@ , Verbosity(..) , setErrorVerbosity + -- * Nonfatal Error Reporting+ , disableNoticeReporting+ , enableNoticeReporting+ , getNotice+ -- * Large Objects -- $largeobjects , LoFd(..)@@ -206,6 +212,7 @@ #include <libpq-fe.h> #include <libpq/libpq-fs.h>+#include "noticehandlers.h" import Prelude hiding ( print ) import Foreign@@ -229,13 +236,14 @@ import qualified Data.ByteString.Internal as B ( fromForeignPtr , c_strlen , createAndTrim+ , ByteString(..) ) import qualified Data.ByteString as B -#if __GLASGOW_HASKELL__ >= 700-import Control.Concurrent (newMVar, tryTakeMVar)-#endif+import Control.Concurrent.MVar +import Data.Typeable+ #if __GLASGOW_HASKELL__ >= 700 import Control.Exception (mask_) #else@@ -254,7 +262,13 @@ -- via the connection object. -- | 'Connection' encapsulates a connection to the backend.-newtype Connection = Conn (ForeignPtr PGconn) deriving Eq+data Connection = Conn {-# UNPACK #-} !(ForeignPtr PGconn)+ {-# UNPACK #-} !(MVar NoticeBuffer)++instance Eq Connection where+ (Conn c _) == (Conn d _) = c == d+ (Conn c _) /= (Conn d _) = c /= d+ data PGconn -- | Makes a new connection to the database server.@@ -277,14 +291,10 @@ connPtr <- B.useAsCString conninfo c_PQconnectdb if connPtr == nullPtr then fail "libpq failed to allocate a PGconn structure"-#if 0--- FIXME: #if __GLASGOW_HASKELL__ >= ???- else Conn `fmap` FC.newForeignPtr connPtr (pqfinish connPtr)-#elif __GLASGOW_HASKELL__ >= 700- else Conn `fmap` newForeignPtrOnce connPtr (pqfinish connPtr)-#else- else Conn `fmap` newForeignPtr p_PQfinish connPtr-#endif+ else do+ noticeBuffer <- newMVar nullPtr+ connection <- newForeignPtrOnce connPtr (pqfinish connPtr noticeBuffer)+ return $! Conn connection noticeBuffer -- | Make a connection to the database server in a nonblocking manner. connectStart :: B.ByteString -- ^ Connection Info@@ -294,33 +304,32 @@ connPtr <- B.useAsCString connStr c_PQconnectStart if connPtr == nullPtr then fail "libpq failed to allocate a PGconn structure"-#if 0--- FIXME: #if __GLASGOW_HASKELL__ >= ???- else Conn `fmap` FC.newForeignPtr connPtr (pqfinish connPtr)-#elif __GLASGOW_HASKELL__ >= 700- else Conn `fmap` newForeignPtrOnce connPtr (pqfinish connPtr)-#else- else Conn `fmap` newForeignPtr p_PQfinish connPtr-#endif+ else do+ noticeBuffer <- newMVar nullPtr+ connection <- newForeignPtrOnce connPtr (pqfinish connPtr noticeBuffer)+ return $! Conn connection noticeBuffer +pqfinish :: Ptr PGconn -> MVar NoticeBuffer -> IO ()+pqfinish conn noticeBuffer = do #if __GLASGOW_HASKELL__ >= 700--- | This covers the case when a connection is closed while other Haskell+-- This covers the case when a connection is closed while other Haskell -- threads are using GHC's IO manager to wait on the descriptor. This is -- commonly the case with asynchronous notifications, for example. Since -- libpq is responsible for opening and closing the file descriptor, GHC's -- IO manager needs to be informed that the file descriptor has been -- closed. The IO manager will then raise an exception in those threads.-pqfinish :: Ptr PGconn -> IO ()-pqfinish conn = do mfd <- c_PQsocket conn case mfd of -1 -> -- This can happen if the connection is bad/lost -- This case may be worth investigating further c_PQfinish conn fd -> closeFdWith (\_ -> c_PQfinish conn) (Fd fd)+#else+ c_PQfinish conn #endif+ nb <- swapMVar noticeBuffer nullPtr+ c_free_noticebuffer nb -#if __GLASGOW_HASKELL__ >= 700 -- | Workaround for bug in 'FC.newForeignPtr' before base 4.6. Ensure the -- finalizer is only run once, to prevent a segfault. See GHC ticket #7170 --@@ -330,19 +339,21 @@ newForeignPtrOnce ptr fin = do mv <- newMVar fin FC.newForeignPtr ptr $ tryTakeMVar mv >>= maybe (return ()) id-#endif -- | Allocate a Null Connection, which all libpq functions -- should safely fail on. newNullConnection :: IO Connection-newNullConnection = Conn `fmap` newForeignPtr_ nullPtr+newNullConnection = do+ connection <- newForeignPtr_ nullPtr+ noticeBuffer <- newMVar nullPtr+ return $! Conn connection noticeBuffer -- | Test if a connection is the Null Connection. isNullConnection :: Connection -> Bool #if __GLASGOW_HASKELL__ >= 702-isNullConnection (Conn x) = Unsafe.unsafeForeignPtrToPtr x == nullPtr+isNullConnection (Conn x _) = Unsafe.unsafeForeignPtrToPtr x == nullPtr #else-isNullConnection (Conn x) = unsafeForeignPtrToPtr x == nullPtr+isNullConnection (Conn x _) = unsafeForeignPtrToPtr x == nullPtr #endif {-# INLINE isNullConnection #-} @@ -452,7 +463,7 @@ -- has been called. finish :: Connection -> IO ()-finish (Conn fp) =+finish (Conn fp _) = do finalizeForeignPtr fp @@ -706,7 +717,7 @@ data Format = Text | Binary deriving (Eq, Ord, Show, Enum) -newtype Oid = Oid CUInt deriving (Eq, Ord, Read, Show, Storable)+newtype Oid = Oid CUInt deriving (Eq, Ord, Read, Show, Storable, Typeable) invalidOid :: Oid invalidOid = Oid (#const InvalidOid)@@ -1993,7 +2004,7 @@ withConn :: Connection -> (Ptr PGconn -> IO b) -> IO b-withConn (Conn !fp) f = withForeignPtr fp f+withConn (Conn !fp _) f = withForeignPtr fp f enumFromConn :: (Integral a, Enum b) => Connection@@ -2075,6 +2086,50 @@ -- where -- finalizer = touchForeignPtr fp +data CNoticeBuffer+type NoticeBuffer = Ptr CNoticeBuffer++type NoticeReceiver = NoticeBuffer -> Ptr PGresult -> IO ()++data PGnotice++-- | Upon connection initialization, any notices received from the server are+-- normally written to the console. Notices are akin to warnings, and+-- are distinct from notifications. This function suppresses notices.+-- You may later call 'enableNoticeReporting' after calling this function.+disableNoticeReporting :: Connection -> IO ()+disableNoticeReporting conn@(Conn _ nbRef) = do+ _ <- withConn conn $ \c -> c_PQsetNoticeReceiver c p_discard_notices nullPtr+ nb <- swapMVar nbRef nullPtr+ c_free_noticebuffer nb++-- | Upon connection initialization, any notices received from the server are+-- normally written to the console. Notices are akin to warnings, and+-- are distinct from notifications. This function enables notices to be+-- programmatically retreived using the 'getNotice' function. You may+-- later call 'disableNoticeReporting' after calling this function.+enableNoticeReporting :: Connection -> IO ()+enableNoticeReporting conn@(Conn _ nbRef) = do+ nb' <- c_malloc_noticebuffer+ _ <- withConn conn $ \c -> c_PQsetNoticeReceiver c p_store_notices nb'+ nb <- swapMVar nbRef nb'+ c_free_noticebuffer nb++-- | This function retrieves any notices received from the backend.+-- Because multiple notices can be received at a time, you will+-- typically want to call this function in a loop until you get+-- back a 'Nothing'.+getNotice :: Connection -> IO (Maybe B.ByteString)+getNotice (Conn _ nbRef) =+ withMVar nbRef $ \nb -> do+ np <- c_get_notice nb+ if np == nullPtr+ then return Nothing+ else do+ fp <- newForeignPtr finalizerFree (castPtr np)+ len <- #{peek PGnotice, len} np+ return $! Just $! B.PS fp (#offset PGnotice, str) len+ -- $largeobjects -- | LoFd is a Large Object (pseudo) File Descriptor. It is understood by@@ -2275,6 +2330,8 @@ = withConn connection $ \c -> do negError =<< c_lo_unlink c oid ++ foreign import ccall "libpq-fe.h PQconnectdb" c_PQconnectdb :: CString ->IO (Ptr PGconn) @@ -2542,6 +2599,25 @@ foreign import ccall unsafe "libpq-fe.h PQfreemem" c_PQfreemem :: Ptr a -> IO ()++foreign import ccall unsafe "noticehandlers.h hs_postgresql_libpq_malloc_noticebuffer"+ c_malloc_noticebuffer :: IO (Ptr CNoticeBuffer)++foreign import ccall unsafe "noticehandlers.h hs_postgresql_libpq_free_noticebuffer"+ c_free_noticebuffer :: Ptr CNoticeBuffer -> IO ()++foreign import ccall unsafe "noticehandlers.h hs_postgresql_libpq_get_notice"+ c_get_notice :: Ptr CNoticeBuffer -> IO (Ptr PGnotice)++foreign import ccall unsafe "noticehandlers.h &hs_postgresql_libpq_discard_notices"+ p_discard_notices :: FunPtr NoticeReceiver++foreign import ccall unsafe "noticehandlers.h &hs_postgresql_libpq_store_notices"+ p_store_notices :: FunPtr NoticeReceiver++foreign import ccall unsafe "libpq-fe.h PQsetNoticeReceiver"+ c_PQsetNoticeReceiver :: Ptr PGconn -> FunPtr NoticeReceiver -> Ptr CNoticeBuffer -> IO (FunPtr NoticeReceiver)+ type CFd = CInt