BerkeleyDB 0.6 → 0.7

raw patch · 6 files changed

+1231/−173 lines, 6 filesdep +extensible-exceptionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: extensible-exceptions

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• BerkeleyDB.cabal +27/−7
• Database/Berkeley/Db.hs +361/−88
• Database/Berkeley/db_helper.c +482/−0
• Database/Berkeley/db_helper.cpp +223/−41
• Database/Berkeley/db_helper.h +53/−31
• examples/tests.hs +85/−6

@@ -1,5 +1,5 @@ name: BerkeleyDB-version: 0.6+version: 0.7 license: BSD3 license-file: LICENSE cabal-version: >= 1.4@@ -16,6 +16,12 @@     This is a work in progress: The coverage of the Berkeley DB API is not yet complete. Tested with     Berkeley DB version 4.6.     .+    /CXX flag/ (enabled by default):+    On some platforms, BerkeleyDB won't load into ghci if the CXX flag is enabled.+    The CXX flag is required if you want to use the BerkeleyDBXML package.+    You are recommended to disable this flag if you are not using BerkeleyDBXML.+    To disable it, configure with --flags=-CXX.+    .     Berkeley DB home page:     <http://www.oracle.com/database/berkeley-db/index.html>     .@@ -23,21 +29,35 @@     <http://www.haskell.org/haskellwiki/BerkeleyDBXML>     .     DARCS repository:-    <http://blacksapphire.com/BerkeleyDB>+    <http://code.haskell.org/BerkeleyDB/>  category: Database build-type: Simple homepage: http://www.haskell.org/haskellwiki/BerkeleyDBXML extra-source-files:     Database/Berkeley/db_helper.h,-    examples/tests.hs+    examples/tests.hs,     examples/capitals.hs +Flag CXX+    Default: True+    Description:+        Enable the use of the C++ library db_cxx.+        On some platforms, BerkeleyDB won't load into ghci if this flag is enabled.+        This flag is required for if you want to use the BerkeleyDBXML package.+        It is recommended to disable this flag if you are not using BerkeleyDBXML.+ Library     exposed-modules: Database.Berkeley.Db-    c-sources: Database/Berkeley/db_helper.cpp -    build-depends: base >= 4, bytestring >= 0.9+    build-depends: base, extensible-exceptions, bytestring >= 0.9     include-dirs: Database/Berkeley/-    extra-libraries: db, db_cxx-    ghc-options: -pgml c+++    if flag(CXX)+        extra-libraries: db db_cxx+        ghc-options: -pgml c+++        cc-options: -DUSE_DB_CXX+        c-sources: Database/Berkeley/db_helper.cpp+    else+        extra-libraries: db+        c-sources: Database/Berkeley/db_helper.c+

@@ -2,6 +2,9 @@ {-# CFILES Database/Berkeley/db_helper.c #-}  -- | Berkeley DB binding. All IO monad functions can throw DbException.+--+-- This documentation is not a complete description of the Berkeley DB interface.+-- You will need to refer to Berkeley DB's C or C++ API documentation for the details.  module Database.Berkeley.Db (         -- * Common@@ -34,10 +37,10 @@         dbEnv_set_lk_max_locks,         dbEnv_set_lk_max_objects,         dbEnv_set_tx_max,-        dbEnv_txn_begin,         dbEnv_txn_checkpoint,-        dbEnv_withTxn,         -- * DbTxn+        dbEnv_withTxn,+        dbEnv_txn_begin,         DbTxn,         dbTxn_abort,         dbTxn_commit,@@ -52,6 +55,18 @@         db_open,         db_put,         db_set_pagesize,+        -- * DbCursor+        db_withCursor,+        db_cursor,+        DbCursor,+        dbCursor_close,+        dbCursor_count,+        dbCursor_del,+        dbCursor_withCursor,+        dbCursor_dup,+        dbCursor_get,+        dbCursor_set,+        dbCursor_put,         -- * Private         dbToNum,       -- | Needed for BerkeleyDBXML: Binary representation of a DbFlag         dbErrFromNum,  -- | Needed for BerkeleyDBXML: Convert an error code to a DbError@@ -63,6 +78,7 @@ import Foreign.Marshal.Alloc import Foreign.Storable import Foreign.Ptr+import Control.Applicative import Control.Monad import Data.Bits import Data.Maybe@@ -73,18 +89,18 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as BSI import Data.Word-import Control.Exception+import Control.Exception.Extensible import Data.Typeable  {-    DB (user visible) error return codes.-  +    !!!    We don't want our error returns to conflict with other packages where    possible, so pick a base error value that's hopefully not common.  We    document that we own the error name space from -30,800 to -30,999.  -}-data DbError = +data DbError =     DB_BUFFER_SMALL         |    -- ^ User memory too small for return.     DB_DONOTINDEX           |    -- ^ \"Null\" return from 2ndary callbk.     DB_KEYEMPTY             |    -- ^ Key/data deleted or never created.@@ -116,6 +132,7 @@     DB_ACCESSED_DB_ENV_AFTER_CLOSE |  -- ^ Haskell binding: Attempted to use a DbEnv handle after it was closed     DB_ACCESSED_DB_AFTER_CLOSE |      -- ^ Haskell binding: Attempted to use a Db handle after it was closed     DB_ACCESSED_DB_TXN_AFTER_CLOSE |  -- ^ Haskell binding: Attempted to use a DbTxn handle after it was closed+    DB_ACCESSED_DB_CURSOR_AFTER_CLOSE | -- ^ Haskell binding: Attempted to use a DbCursor handle after it was closed     SYSTEM_ERROR Int             -- ^ An errno value returned by the operating system     deriving (Eq,Show) @@ -151,6 +168,7 @@ dbErrFromNum (-20881) = DB_ACCESSED_DB_ENV_AFTER_CLOSE dbErrFromNum (-20882) = DB_ACCESSED_DB_AFTER_CLOSE dbErrFromNum (-20883) = DB_ACCESSED_DB_TXN_AFTER_CLOSE+dbErrFromNum (-20884) = DB_ACCESSED_DB_CURSOR_AFTER_CLOSE dbErrFromNum n        = (SYSTEM_ERROR n)  -- | An exception indicating an error in a Berkeley DB operation.@@ -163,7 +181,7 @@ throwDB func code =     throwIO $ DbException func (dbErrFromNum $ fromIntegral code) -        + ------ DbEnv ------------------------------------------------------------------  data DbEnv_struct@@ -171,12 +189,13 @@ foreign import ccall "db_helper.h &_dbenv_delete" _dbenv_delete     :: FunPtr (Ptr DbEnv_struct -> IO ()) -    + foreign import ccall safe "db_helper.h _dbenv_create" _dbenv_create     :: Ptr (Ptr DbEnv_struct) -> CUInt -> IO CInt  data DbEnvCreateFlag = DB_RPCCLIENT +-- | Create a Berkeley DB environment handle. dbEnv_create :: [DbEnvCreateFlag] -> IO DbEnv dbEnv_create flags =     alloca $ \ptr -> do@@ -190,7 +209,7 @@         orFlags = foldr (.|.) 0 $ map toNum flags         toNum DB_RPCCLIENT = 0x0000002 -        + foreign import ccall safe "db_helper.h _dbenv_get_lk_max_lockers" _dbenv_get_lk_max_lockers     :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt @@ -205,7 +224,7 @@                 ci <- peek ptr                 return $ fromIntegral ci -                + foreign import ccall safe "db_helper.h _dbenv_set_lk_max_lockers" _dbenv_set_lk_max_lockers     :: Ptr DbEnv_struct -> CUInt -> IO CInt @@ -217,10 +236,10 @@             then throwDB "dbEnv_set_lk_max_lockers" ret             else return () -        + foreign import ccall safe "db_helper.h _dbenv_get_lk_max_locks" _dbenv_get_lk_max_locks     :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt-    + dbEnv_get_lk_max_locks :: DbEnv -> IO Int dbEnv_get_lk_max_locks dbenv =     withForeignPtr dbenv $ \c_dbenv ->@@ -232,7 +251,7 @@                 ci <- peek ptr                 return $ fromIntegral ci -                + foreign import ccall safe "db_helper.h _dbenv_set_lk_max_locks" _dbenv_set_lk_max_locks     :: Ptr DbEnv_struct -> CUInt -> IO CInt @@ -244,7 +263,7 @@             then throwDB "dbEnv_set_lk_max_locks" ret             else return () -            + foreign import ccall safe "db_helper.h _dbenv_get_lk_max_objects" _dbenv_get_lk_max_objects     :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt @@ -259,7 +278,7 @@                 ci <- peek ptr                 return $ fromIntegral ci -                + foreign import ccall safe "db_helper.h _dbenv_set_lk_max_objects" _dbenv_set_lk_max_objects     :: Ptr DbEnv_struct -> CUInt -> IO CInt @@ -271,7 +290,7 @@             then throwDB "dbEnv_set_lk_max_objects" ret             else return () -        + foreign import ccall safe "db_helper.h _dbenv_get_tx_max" _dbenv_get_tx_max     :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt @@ -286,7 +305,7 @@                 ci <- peek ptr                 return $ fromIntegral ci -                + foreign import ccall safe "db_helper.h _dbenv_set_tx_max" _dbenv_set_tx_max     :: Ptr DbEnv_struct -> CUInt -> IO CInt @@ -315,7 +334,7 @@                 c3 <- peek ptr3                 return $ (fromIntegral c1, fromIntegral c2, fromIntegral c3) -                + foreign import ccall safe "db_helper.h _dbenv_set_cachesize" _dbenv_set_cachesize     :: Ptr DbEnv_struct -> CUInt -> CUInt -> CInt -> IO CInt @@ -343,7 +362,7 @@                 ci <- peek ptr                 return $ fromIntegral ci -                + foreign import ccall safe "db_helper.h _dbenv_set_lg_regionmax" _dbenv_set_lg_regionmax     :: Ptr DbEnv_struct -> CUInt -> IO CInt @@ -406,8 +425,40 @@     DB_MULTIPLE |     DB_MULTIPLE_KEY |     DB_RMW |-    DB_LOCK_NOWAIT+    DB_LOCK_NOWAIT |+    DB_AFTER |+    DB_APPEND |+    DB_BEFORE |+    DB_CONSUME |+    DB_CONSUME_WAIT |+    DB_CURRENT |+    DB_FIRST |+    DB_GET_BOTH |+    DB_GET_BOTHC |+    DB_GET_BOTH_RANGE |+    DB_GET_RECNO |+    DB_JOIN_ITEM |+    DB_KEYFIRST |+    DB_KEYLAST |+    DB_LAST |+    DB_NEXT |+    DB_NEXT_DUP |+    DB_NEXT_NODUP |+    DB_NODUPDATA |+    DB_NOOVERWRITE |+    DB_NOSYNC |+    DB_POSITION |+    DB_PREV |+    DB_PREV_DUP |+    DB_PREV_NODUP |+    DB_SET |+    DB_SET_RANGE |+    DB_SET_RECNO |+    DB_UPDATE_SECONDARY |+    DB_WRITECURSOR |+    DB_WRITELOCK + dbToNum :: DbFlag -> CUInt dbToNum DB_CREATE = 0x0000001 dbToNum	DB_DURABLE_UNKNOWN = 0x0000002@@ -456,11 +507,43 @@ dbToNum DB_MULTIPLE_KEY = 0x20000000 dbToNum DB_RMW = 0x40000000 dbToNum DB_LOCK_NOWAIT = 0x002+dbToNum DB_AFTER = 1             -- Dbc.put+dbToNum DB_APPEND = 2            -- Db.put+dbToNum DB_BEFORE = 3            -- Dbc.put+dbToNum DB_CONSUME = 4           -- Db.get+dbToNum DB_CONSUME_WAIT = 5      -- Db.get+dbToNum DB_CURRENT = 6           -- Dbc.get, Dbc.put, DbLogc.get+dbToNum DB_FIRST = 7             -- Dbc.get, DbLogc->get+dbToNum DB_GET_BOTH = 8          -- Db.get, Dbc.get+dbToNum DB_GET_BOTHC = 9         -- Dbc.get (internal)+dbToNum DB_GET_BOTH_RANGE = 10   -- Db.get, Dbc.get+dbToNum DB_GET_RECNO = 11        -- Dbc.get+dbToNum DB_JOIN_ITEM = 12        -- Dbc.get; don't do primary lookup+dbToNum DB_KEYFIRST = 13         -- Dbc.put+dbToNum DB_KEYLAST = 14          -- Dbc.put+dbToNum DB_LAST = 15             -- Dbc.get, DbLogc->get+dbToNum DB_NEXT = 16             -- Dbc.get, DbLogc->get+dbToNum DB_NEXT_DUP = 17         -- Dbc.get+dbToNum DB_NEXT_NODUP = 18       -- Dbc.get+dbToNum DB_NODUPDATA = 19        -- Db.put, Dbc.put+dbToNum DB_NOOVERWRITE = 20      -- Db.put+dbToNum DB_NOSYNC = 21           -- Db.close+dbToNum DB_POSITION = 22         -- Dbc.dup+dbToNum DB_PREV = 23             -- Dbc.get, DbLogc->get+dbToNum DB_PREV_DUP = 24         -- Dbc.get+dbToNum DB_PREV_NODUP = 25       -- Dbc.get+dbToNum DB_SET = 26              -- Dbc.get, DbLogc->get+dbToNum DB_SET_RANGE = 27        -- Dbc.get+dbToNum DB_SET_RECNO = 28        -- Db.get, Dbc.get+dbToNum DB_UPDATE_SECONDARY = 29 -- Dbc.get, Dbc.del (internal)+dbToNum DB_WRITECURSOR = 30      -- Db.cursor+dbToNum DB_WRITELOCK = 31        -- Db.cursor (internal)  dbOrFlags flags = foldr (.|.) 0 $ map dbToNum flags +-- | Open the Berkeley DB environment, which must be done before 'db_open'. dbEnv_open :: [DbFlag]-           -> Int        -- ^ UNIX file creation mode, or 0, meaning "readable and writable by both owner and group"+           -> Int        -- ^ UNIX file creation mode, or 0, meaning \"readable and writable by both owner and group\"            -> DbEnv            -> FilePath   -- ^ Database environment's home directory            -> IO ()@@ -472,18 +555,67 @@             then throwDB "dbEnv_open" ret             else return () +foreign import ccall "db_helper.h _dbenv_close" _dbenv_close+    :: Ptr DbEnv_struct -> CUInt -> IO CInt ------- Db ---------------------------------------------------------------------+-- | Close the Berkeley DB environment.+dbEnv_close :: [DbFlag] -> DbEnv -> IO ()+dbEnv_close flags dbenv =+    withForeignPtr dbenv $ \c_dbenv -> do+        ret <- _dbenv_close c_dbenv (dbOrFlags flags)+        if ret /= 0+            then throwDB "dbEnv_close" ret+            else return () ++data DbLockFlag =+    DB_LOCK_NORUN |+    DB_LOCK_DEFAULT |+    DB_LOCK_EXPIRE |+    DB_LOCK_MAXLOCKS |+    DB_LOCK_MAXWRITE |+    DB_LOCK_MINLOCKS |+    DB_LOCK_MINWRITE |+    DB_LOCK_OLDEST |+    DB_LOCK_RANDOM |+    DB_LOCK_YOUNGEST++dbLockToNum DB_LOCK_NORUN = 0+dbLockToNum DB_LOCK_DEFAULT = 1+dbLockToNum DB_LOCK_EXPIRE = 2+dbLockToNum DB_LOCK_MAXLOCKS = 3+dbLockToNum DB_LOCK_MAXWRITE = 4+dbLockToNum DB_LOCK_MINLOCKS = 5+dbLockToNum DB_LOCK_MINWRITE = 6+dbLockToNum DB_LOCK_OLDEST = 7+dbLockToNum DB_LOCK_RANDOM = 8+dbLockToNum DB_LOCK_YOUNGEST = 9++foreign import ccall "db_helper.h _dbenv_set_lk_detect" _dbenv_set_lk_detect+    :: Ptr DbEnv_struct -> CUInt -> IO CInt++-- | Start the Berkeley DB lock detector.+dbEnv_set_lk_detect :: DbEnv -> DbLockFlag -> IO ()+dbEnv_set_lk_detect dbenv flag =+    withForeignPtr dbenv $ \c_dbenv -> do+        ret <- _dbenv_set_lk_detect c_dbenv (dbLockToNum flag)+        if ret /= 0+            then throwDB "dbEnv_set_lk_detect" ret+            else return ()+++------ Db ----------------------------------------------------------------------+ data Db_struct type Db = ForeignPtr Db_struct foreign import ccall "db_helper.h &_db_delete" _db_delete     :: FunPtr (Ptr Db_struct -> IO ()) -    + foreign import ccall safe "db_helper.h _db_create" _db_create     ::  Ptr (Ptr Db_struct) -> Ptr DbEnv_struct -> CUInt -> IO CInt +-- | Create a database handle. db_create :: [DbFlag] -> DbEnv -> IO Db db_create flags dbenv =     withForeignPtr dbenv $ \c_dbenv ->@@ -495,7 +627,7 @@                 p <- peek ptr                 newForeignPtr _db_delete p -                + foreign import ccall safe "db_helper.h _db_set_pagesize" _db_set_pagesize     :: Ptr Db_struct -> CUInt -> IO CInt @@ -520,13 +652,14 @@ foreign import ccall "db_helper.h &_dbtxn_delete" _dbtxn_delete     :: FunPtr (Ptr DbTxn_struct -> IO ()) -    + foreign import ccall "db_helper.h _db_open" _db_open     :: Ptr Db_struct -> Ptr DbTxn_struct -> CString -> CString -> CInt -> CUInt -> CInt -> IO CInt +-- | Open a database. db_open :: [DbFlag]         -> DbType-        -> Int          -- ^ Unix file creation mode, or 0, meaning "readable and writable by both owner and group"+        -> Int          -- ^ Unix file creation mode, or 0, meaning \"readable and writable by both owner and group\"         -> Db         -> Maybe DbTxn         -> FilePath     -- ^ Filename@@ -559,10 +692,12 @@             then throwDB ("db_open file="++(show file)++" database="++(show mDatabase)) ret             else return () -            + foreign import ccall "db_helper.h _dbenv_txn_begin" _dbenv_txn_begin     :: Ptr DbEnv_struct -> Ptr DbTxn_struct -> Ptr (Ptr DbTxn_struct) -> CUInt -> IO CInt +-- | Create a new transaction. You are recommended to use 'dbEnv_withTxn'+-- instead of this function. dbEnv_txn_begin :: [DbFlag]                 -> DbEnv                 -> Maybe DbTxn -- ^ Optional parent transaction@@ -582,24 +717,27 @@                 p <- peek ptr                 newForeignPtr _dbtxn_delete p --- | Execute a computation within a transaction.-dbEnv_withTxn :: [DbFlag]         -- ^ dbEnv_txn_begin flags-              -> [DbFlag]         -- ^ dbTxn_commit flags+-- | An exception-safe helper that runs an action inside a transaction.+-- It will commit on completion, or abort if an exception is thrown.+dbEnv_withTxn :: [DbFlag]     -- ^ 'dbEnv_txn_begin' flags+              -> [DbFlag]     -- ^ 'dbTxn_commit' flags               -> DbEnv-              -> Maybe DbTxn      -- ^ Optional parent transaction-              -> (DbTxn -> IO ()) -- ^ The computation to run within a transactional context-              -> IO ()-dbEnv_withTxn beginFlags commitFlags dbenv mParent computation = do+              -> Maybe DbTxn  -- ^ Parent transaction+              -> (DbTxn -> IO a)  -- ^ The action to run inside a transaction+              -> IO a+dbEnv_withTxn flags1 flags2 env mTxn action = do     bracketOnError-        (dbEnv_txn_begin beginFlags dbenv mParent)+        (dbEnv_txn_begin flags1 env mTxn)         dbTxn_abort-        (\txn -> do-            computation txn-            dbTxn_commit commitFlags txn)+        $ \txn -> do+            retValue <- action txn+            dbTxn_commit flags2 txn+            return retValue  foreign import ccall "db_helper.h _dbenv_txn_checkpoint" _dbenv_txn_checkpoint     :: Ptr DbEnv_struct -> CUInt -> CUInt -> CUInt -> IO CInt +-- | Checkpoint the transaction subsystem. dbEnv_txn_checkpoint :: [DbFlag]                      -> DbEnv                      -> CUInt -- ^ kbyte@@ -612,10 +750,12 @@             then throwDB "dbEnv_txn_checkpoint" ret             else return () -            + foreign import ccall "db_helper.h _dbtxn_abort" _dbtxn_abort     :: Ptr DbTxn_struct -> IO CInt +-- | Abort a transaction, rolling back any writes that were made. You are+-- recommended to use 'dbEnv_withTxn' instead of this function. dbTxn_abort :: DbTxn -> IO () dbTxn_abort dbtxn = do     withForeignPtr dbtxn $ \c_dbtxn -> do@@ -624,10 +764,12 @@             then throwDB "dbTxn_abort" ret             else return () -            + foreign import ccall "db_helper.h _dbtxn_commit" _dbtxn_commit     :: Ptr DbTxn_struct -> CUInt -> IO CInt +-- | Commit a transaction. You are recommended to use 'dbEnv_withTxn'+-- instead of this function. dbTxn_commit :: [DbFlag] -> DbTxn -> IO () dbTxn_commit flags dbtxn = do     withForeignPtr dbtxn $ \c_dbtxn -> do@@ -642,6 +784,7 @@ foreign import ccall "db_helper.h _dbtxn_id" _dbtxn_id     :: Ptr DbTxn_struct -> IO CUInt +-- | Get the locker ID for a transaction, which can be used with 'dbEnv_withLock'. dbTxn_id :: DbTxn -> DbLocker dbTxn_id dbtxn =     unsafePerformIO $@@ -661,7 +804,7 @@ foreign import ccall "db_helper.h &_dblock_delete" _dblock_delete     :: FunPtr (Ptr DbLock_struct -> IO ()) -    + foreign import ccall "db_helper.h _dbenv_lock_get" _dbenv_lock_get     :: Ptr DbEnv_struct -> CUInt -> CUInt -> Ptr Word8 -> CUInt -> CUInt -> Ptr (Ptr DbLock_struct) -> IO CInt @@ -670,7 +813,7 @@                -> DbLockMode                -> ByteString  -- ^ Object, which is a key that identifies this lock                -> DbEnv-               -> DbLocker+               -> DbLocker    -- ^ The identity of the locker.                -> IO DbLock dbEnv_lock_get flags lockMode object dbenv (DbLocker locker) =     withForeignPtr dbenv $ \c_dbenv ->@@ -704,9 +847,9 @@                -> DbLockMode                -> ByteString -- ^ Object, which is an environment-wide key that identifies this lock                -> DbEnv-               -> DbLocker-               -> IO ()      -- ^ Computation to perform under lock-               -> IO ()+               -> DbLocker   -- ^ The identity of the locker.+               -> IO a      -- ^ Computation to perform under lock+               -> IO a dbEnv_withLock flags lockMode object dbEnv locker computation = do     bracket         (dbEnv_lock_get flags lockMode object dbEnv locker)  -- acquire@@ -723,11 +866,17 @@ foreign import ccall "db_helper.h _db_get" _db_get     :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr Word8 -> CUInt -> Ptr (Ptr Word8) -> Ptr CUInt -> CUInt -> IO CInt -db_get :: [DbFlag] -> Db -> Maybe DbTxn -> ByteString -> IO (Maybe ByteString)+-- | Look the key up in the database, and return Just the stored value, or Nothing+-- if it was not found.+db_get :: [DbFlag]+       -> Db+       -> Maybe DbTxn+       -> ByteString    -- ^ Key+       -> IO (Maybe ByteString) db_get flags db mTxn key =     alloca $ \ptr1 ->     alloca $ \ptr2 ->-    withByteString key$ \c_key key_len ->+    withByteString key $ \c_key key_len ->     withForeignPtr db $ \c_db -> do         ret <- case mTxn of             Nothing ->@@ -750,6 +899,7 @@ foreign import ccall "db_helper.h _db_put" _db_put     :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr Word8 -> CUInt -> Ptr Word8 -> CUInt -> CUInt -> IO CInt +-- | Store the specified value into the database under the specified key. db_put :: [DbFlag]        -> Db        -> Maybe DbTxn@@ -757,7 +907,7 @@        -> ByteString    -- ^ Value        -> IO () db_put flags db mTxn key value =-    withByteString key$ \c_key key_len ->+    withByteString key $ \c_key key_len ->     withByteString value $ \c_value value_len ->     withForeignPtr db $ \c_db -> do         ret <- case mTxn of@@ -778,13 +928,13 @@     withForeignPtr fp $ \c_fp ->         code (c_fp `plusPtr` fp_offset) length -        + foreign import ccall "db_helper.h _db_del" _db_del     :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr Word8 -> CUInt -> CUInt -> IO CInt  db_del :: [DbFlag] -> Db -> Maybe DbTxn -> ByteString -> IO () db_del flags db mTxn key =-    withByteString key$ \c_key key_len ->+    withByteString key $ \c_key key_len ->     withForeignPtr db $ \c_db -> do         ret <- case mTxn of             Nothing ->@@ -796,10 +946,10 @@             then throwDB "db_del" ret             else return () -            + foreign import ccall "db_helper.h _db_close" _db_close     :: Ptr Db_struct -> CUInt -> IO CInt-            + db_close :: [DbFlag] -> Db -> IO () db_close flags db =     withForeignPtr db $ \c_db -> do@@ -808,50 +958,173 @@             then throwDB "db_close" ret             else return () -            -foreign import ccall "db_helper.h _dbenv_close" _dbenv_close-    :: Ptr DbEnv_struct -> CUInt -> IO CInt -dbEnv_close :: [DbFlag] -> DbEnv -> IO ()-dbEnv_close flags dbenv =-    withForeignPtr dbenv $ \c_dbenv -> do-        ret <- _dbenv_close c_dbenv (dbOrFlags flags)+------ DbCursor ----------------------------------------------------------------++data DbCursor_struct+type DbCursor = ForeignPtr DbCursor_struct+foreign import ccall "db_helper.h &_dbcursor_delete" _dbcursor_delete+    :: FunPtr (Ptr DbCursor_struct -> IO ())++-- | An exception-safe helper that creates a cursor, passes it to an action, and+-- cleans up afterwards.+db_withCursor :: [DbFlag]            -- ^ 'db_cursor' flags+              -> Db+              -> Maybe DbTxn         -- ^ Optional tansaction+              -> (DbCursor -> IO a)  -- ^ The action that operates on the cursor+              -> IO a+db_withCursor flags db mTxn action = do+    bracket+        (db_cursor flags db mTxn)+        dbCursor_close+        action++foreign import ccall "db_helper.h _db_cursor" _db_cursor+    :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr (Ptr DbCursor_struct) -> CUInt -> IO CInt++-- | Open a DbCursor.  You are recommended to use 'db_withCursor' instead of this+-- function.+db_cursor :: [DbFlag] -> Db -> Maybe DbTxn -> IO DbCursor+db_cursor flags db mTxn =+    withForeignPtr db $ \c_db ->+    alloca $ \pc_cursor -> do+        ret <- case mTxn of+            Nothing ->+                _db_cursor c_db nullPtr pc_cursor (dbOrFlags flags)+            Just txn ->+                withForeignPtr txn $ \c_txn ->+                _db_cursor c_db c_txn   pc_cursor (dbOrFlags flags)         if ret /= 0-            then throwDB "dbEnv_close" ret+            then throwDB "db_cursor" ret+            else newForeignPtr _dbcursor_delete =<< peek pc_cursor++foreign import ccall "db_helper.h _dbCursor_close" _dbCursor_close+    :: Ptr DbCursor_struct -> IO CInt++-- | Close a DBCursor. You are recommended to use 'db_withCursor' instead of this+-- function.+dbCursor_close :: DbCursor -> IO ()+dbCursor_close dbc =+    withForeignPtr dbc $ \c_dbc -> do+        ret <- _dbCursor_close c_dbc+        if ret /= 0+            then throwDB "dbCursor_close" ret             else return ()-         -data DbLockFlag =-    DB_LOCK_NORUN |-    DB_LOCK_DEFAULT |-    DB_LOCK_EXPIRE |-    DB_LOCK_MAXLOCKS |   -    DB_LOCK_MAXWRITE |-    DB_LOCK_MINLOCKS |-    DB_LOCK_MINWRITE |-    DB_LOCK_OLDEST |-    DB_LOCK_RANDOM |-    DB_LOCK_YOUNGEST+foreign import ccall "db_helper.h _dbCursor_count" _dbCursor_count+    :: Ptr DbCursor_struct -> Ptr CUInt -> CUInt -> IO CInt -dbLockToNum DB_LOCK_NORUN = 0-dbLockToNum DB_LOCK_DEFAULT = 1-dbLockToNum DB_LOCK_EXPIRE = 2-dbLockToNum DB_LOCK_MAXLOCKS = 3-dbLockToNum DB_LOCK_MAXWRITE = 4-dbLockToNum DB_LOCK_MINLOCKS = 5-dbLockToNum DB_LOCK_MINWRITE = 6-dbLockToNum DB_LOCK_OLDEST = 7-dbLockToNum DB_LOCK_RANDOM = 8-dbLockToNum DB_LOCK_YOUNGEST = 9+-- | Count the number of duplicates at the cursor position.+dbCursor_count :: [DbFlag] -> DbCursor -> IO Int+dbCursor_count flags dbc =+    withForeignPtr dbc $ \c_dbc ->+    alloca $ \p_count -> do+        ret <- _dbCursor_count c_dbc p_count (dbOrFlags flags)+        if ret /= 0+            then throwDB "dbCursor_count" ret+            else fromIntegral <$> peek p_count -foreign import ccall "db_helper.h _dbenv_set_lk_detect" _dbenv_set_lk_detect-    :: Ptr DbEnv_struct -> CUInt -> IO CInt+foreign import ccall "db_helper.h _dbCursor_del" _dbCursor_del+    :: Ptr DbCursor_struct -> CUInt -> IO CInt -dbEnv_set_lk_detect :: DbEnv -> DbLockFlag -> IO ()-dbEnv_set_lk_detect dbenv flag =-    withForeignPtr dbenv $ \c_dbenv -> do-        ret <- _dbenv_set_lk_detect c_dbenv (dbLockToNum flag)+-- | Delete the record at the cursor position.+dbCursor_del :: [DbFlag] -> DbCursor -> IO ()+dbCursor_del flags dbc =+    withForeignPtr dbc $ \c_dbc -> do+        ret <- _dbCursor_del c_dbc (dbOrFlags flags)         if ret /= 0-            then throwDB "dbEnv_set_lk_detect" ret+            then throwDB "dbCursor_del" ret             else return () +-- | An exception-safe helper that duplcates a cursor using dbCursor_dup,+-- passes it to an action, and cleans up afterwards.+dbCursor_withCursor :: [DbFlag]           -- ^ 'db_cursor' flags+                    -> DbCursor           -- ^ The source cursor+                    -> (DbCursor -> IO a) -- ^ The action that operates on the cursor+                    -> IO a+dbCursor_withCursor flags cur action = do+    bracket+        (dbCursor_dup flags cur)+        dbCursor_close+        action++foreign import ccall "db_helper.h _dbCursor_dup" _dbCursor_dup+    :: Ptr DbCursor_struct -> Ptr (Ptr DbCursor_struct) -> CUInt -> IO CInt++dbCursor_dup :: [DbFlag] -> DbCursor -> IO DbCursor+dbCursor_dup flags dbc =+    withForeignPtr dbc $ \c_dbc ->+    alloca $ \pc_cursor -> do+        ret <- _dbCursor_dup c_dbc pc_cursor (dbOrFlags flags)+        if ret /= 0+            then throwDB "dbCursor_dup" ret+            else newForeignPtr _dbcursor_delete =<< peek pc_cursor++foreign import ccall "db_helper.h _dbCursor_get" _dbCursor_get+    :: Ptr DbCursor_struct -> Ptr (Ptr Word8) -> Ptr CUInt -> Ptr (Ptr Word8) -> Ptr CUInt -> CUInt -> IO CInt++-- | Fetch the record pointed at by the cursor (modified by the flags - see the+-- Berkeley DB documentation), and return Just the (key, value) pair at the cursor+-- position, or Nothing if no record was found.+dbCursor_get :: [DbFlag] -> DbCursor -> IO (Maybe (ByteString, ByteString))+dbCursor_get flags cur =+    alloca $ \ptr1 ->+    alloca $ \ptr2 ->+    alloca $ \ptr3 ->+    alloca $ \ptr4 ->+    withForeignPtr cur $ \c_cur -> do+        ret <- _dbCursor_get c_cur ptr1 ptr2 ptr3 ptr4 (dbOrFlags flags)+        if ret /= 0+            then+                if (dbErrFromNum$ fromIntegral ret) == DB_NOTFOUND+                    then return Nothing+                    else throwDB "dbCursor_get" ret+            else do+                c_key <- peek ptr1+                key_len <- peek ptr2+                key <- newForeignPtr _freeString_finalizer c_key+                c_value <- peek ptr3+                value_len <- peek ptr4+                value <- newForeignPtr _freeString_finalizer c_value+                return $ Just+                    (BSI.fromForeignPtr key 0 (fromIntegral key_len),+                     BSI.fromForeignPtr value 0 (fromIntegral value_len))++foreign import ccall "db_helper.h _dbCursor_set" _dbCursor_set+    :: Ptr DbCursor_struct -> Ptr Word8 -> CUInt -> Ptr (Ptr Word8) -> Ptr CUInt -> CUInt -> IO CInt++-- | Move the cursor to the specified key/data pair of the database, and return+-- the datum associated with the given key, or Nothing if it wasn't matched.+-- (This is DBC->get with the DB_SET flag. The DB_SET flag is implied.)+dbCursor_set :: [DbFlag] -> DbCursor -> ByteString -> IO (Maybe ByteString)+dbCursor_set flags cur key =+    withByteString key $ \c_key key_len ->+    alloca $ \ptr1 ->+    alloca $ \ptr2 ->+    withForeignPtr cur $ \c_cur -> do+        ret <- _dbCursor_set c_cur c_key (fromIntegral key_len) ptr1 ptr2 (dbOrFlags (DB_SET:flags))+        if ret /= 0+            then+                if (dbErrFromNum$ fromIntegral ret) == DB_NOTFOUND+                    then return Nothing+                    else throwDB "dbCursor_set" ret+            else do+                c_value <- peek ptr1+                value_len <- peek ptr2+                str <- newForeignPtr _freeString_finalizer c_value+                return $ Just $ BSI.fromForeignPtr str 0 (fromIntegral value_len)++foreign import ccall "db_helper.h _dbCursor_put" _dbCursor_put+    :: Ptr DbCursor_struct -> Ptr Word8 -> CUInt -> Ptr Word8 -> CUInt -> CUInt -> IO CInt++-- | stores key/data pairs into the database in the context of the cursor.+dbCursor_put :: [DbFlag] -> DbCursor -> ByteString -> ByteString -> IO ()+dbCursor_put flags cur key value =+    withByteString key $ \c_key key_len ->+    withByteString value $ \c_value value_len ->+    withForeignPtr cur $ \c_cur -> do+        ret <- _dbCursor_put c_cur c_key (fromIntegral key_len)+            c_value (fromIntegral value_len) (dbOrFlags flags)+        if ret /= 0+            then throwDB "dbCursor_put" ret+            else return ()

@@ -0,0 +1,482 @@+#include "db_helper.h"++#include <string.h>+#include <stdlib.h>+#include <errno.h>++#if defined(USE_DB_CXX)+#define UNWRAP_DBENV() \+    DB_ENV* dbenv = dbenvp->get_DB_ENV(); \+    if (dbenv == NULL) return -20881;  /* Haskell binding-specific error code */++#define UNWRAP_DBTXN_() \+    if (dbtxnp == NULL) \+        dbtxn = NULL; \+    else { \+        if (*dbtxnp == NULL) return -20883;  /* Haskell binding-specific error code */ \+        dbtxn = (*dbtxnp)->get_DB_TXN(); \+    }+#else+#define UNWRAP_DBENV() \+    DB_ENV* dbenv; \+    if (*dbenvp == NULL) return -20881;  /* Haskell binding-specific error code */ \+    dbenv = *dbenvp;++#define UNWRAP_DBTXN_() \+    if (dbtxnp == NULL) \+        dbtxn = NULL; \+    else { \+        if (*dbtxnp == NULL) return -20883;  /* Haskell binding-specific error code */ \+        dbtxn = *dbtxnp; \+    }+#endif++#define UNWRAP_DB() \+    DB* db = *dbp; \+    if (db == NULL) return -20882;  /* Haskell binding-specific error code */++#define UNWRAP_DBCURSOR() \+    DBC* dbc = *dbcp; \+    if (dbc == NULL) return -20884;  /* Haskell binding-specific error code */++#define UNWRAP_DBTXN() \+    DB_TXN* dbtxn; \+    UNWRAP_DBTXN_()++int _dbenv_create(MY_DBENV** dbenvpp, u_int32_t flags)+{+#if defined(USE_DB_CXX)+    *dbenvpp = new DbEnv(flags);+    return 0;+#else+    int ret;+    *dbenvpp = (MY_DBENV*)malloc(sizeof(MY_DBENV*));+    ret = db_env_create(*dbenvpp, flags);+    if (ret != 0)+        free(*dbenvpp);+    return ret;+#endif+}++void _dbenv_delete(MY_DBENV* dbenvp)+{+#if defined(USE_DB_CXX)+#else+    _dbenv_close(dbenvp, 0);+    free(dbenvp);+#endif+}++int _dbenv_get_lk_max_lockers(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {+    UNWRAP_DBENV();+    return dbenv->get_lk_max_lockers(dbenv, lk_maxp);+}++int _dbenv_set_lk_max_lockers(MY_DBENV* dbenvp, u_int32_t max) {+    UNWRAP_DBENV();+    return dbenv->set_lk_max_lockers(dbenv, max);+}++int _dbenv_get_lk_max_locks(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {+    UNWRAP_DBENV();+    return dbenv->get_lk_max_locks(dbenv, lk_maxp);+}++int _dbenv_set_lk_max_locks(MY_DBENV* dbenvp, u_int32_t max) {+    UNWRAP_DBENV();+    return dbenv->set_lk_max_locks(dbenv, max);+}++int _dbenv_get_lk_max_objects(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {+    UNWRAP_DBENV();+    return dbenv->get_lk_max_objects(dbenv, lk_maxp);+}++int _dbenv_set_lk_max_objects(MY_DBENV* dbenvp, u_int32_t max) {+    UNWRAP_DBENV();+    return dbenv->set_lk_max_objects(dbenv, max);+}++int _dbenv_get_tx_max(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {+    UNWRAP_DBENV();+    return dbenv->get_tx_max(dbenv, lk_maxp);+}++int _dbenv_set_tx_max(MY_DBENV* dbenvp, u_int32_t max) {+    UNWRAP_DBENV();+    return dbenv->set_tx_max(dbenv, max);+}++int _dbenv_get_cachesize(MY_DBENV* dbenvp, u_int32_t *gbytesp, u_int32_t *bytesp, int *ncachep) {+    UNWRAP_DBENV();+    return dbenv->get_cachesize(dbenv, gbytesp, bytesp, ncachep);+}++int _dbenv_set_cachesize(MY_DBENV* dbenvp, u_int32_t gbytes, u_int32_t bytes, int ncache) {+    UNWRAP_DBENV();+    return dbenv->set_cachesize(dbenv, gbytes, bytes, ncache);+}++int _dbenv_get_lg_regionmax(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {+    UNWRAP_DBENV();+    return dbenv->get_lg_regionmax(dbenv, lk_maxp);+}++int _dbenv_set_lg_regionmax(MY_DBENV* dbenvp, u_int32_t max) {+    UNWRAP_DBENV();+    return dbenv->set_lg_regionmax(dbenv, max);+}++int _dbenv_set_lk_detect(MY_DBENV* dbenvp, u_int32_t flag)+{+    UNWRAP_DBENV();+    return dbenv->set_lk_detect(dbenv, flag);+}++int _dbenv_open(MY_DBENV* dbenvp, char *db_home, u_int32_t flags, int mode) {+    UNWRAP_DBENV();+    return dbenv->open(dbenv, db_home, flags, mode);+}++int _dbenv_close(MY_DBENV* dbenvp, u_int32_t flags)+{+    int ret;+#if defined(USE_DB_CXX)+    ret = dbenvp->close(flags);+#else+    if (*dbenvp != NULL) {+        ret = (*dbenvp)->close(*dbenvp,flags);+        *dbenvp = NULL;+    }+    else+        ret = 0;+#endif+    return ret;+}++int _db_create(DB*** dbpp, MY_DBENV* dbenvp, u_int32_t flags)+{+    int ret;+    UNWRAP_DBENV();+    *dbpp = (DB**)malloc(sizeof(DB**));+    ret = db_create(*dbpp, dbenv, flags);+    if (ret != 0)+        free(*dbpp);+    return ret;+}++void _db_delete(DB** dbp)+{+    if (*dbp != NULL)+        (*dbp)->close(*dbp, 0);+    free(dbp);+}++int _db_set_pagesize(DB** dbp, u_int32_t pagesize)+{+    UNWRAP_DB();+    return db->set_pagesize(db, pagesize);+}++int _db_open(DB** dbp, MY_DBTXN** txnp, const char* file, const char* database,+    int type, u_int32_t flags, int mode)+{+    DB_TXN* txn;+    UNWRAP_DB();+    if (txnp == NULL)+        txn = NULL;+    else {+        if (*txnp == NULL) return -20883;  /* Haskell binding-specific error code */+#if defined(USE_DB_CXX)+        txn = (*txnp)->get_DB_TXN();+#else+        txn = *txnp;+#endif+    }+    return db->open(db, txn, file, database, (DBTYPE) type, flags, mode);+}++int _dbenv_txn_begin(MY_DBENV* dbenvp, MY_DBTXN** parentp, MY_DBTXN*** txnpp, u_int32_t flags)+{+    MY_DBTXN* parent;+    UNWRAP_DBENV();+    if (parentp == NULL)+        parent = NULL;+    else {+        parent = *parentp;+        if (parent == NULL) return -20883;  /* Haskell binding-specific error code */+    }+    *txnpp = (MY_DBTXN**)malloc(sizeof(MY_DBTXN*));+#if defined(USE_DB_CXX)+    try {+        return dbenvp->txn_begin(parent, *txnpp, flags);+    }+    catch (DbException& exc) {+        free(*txnpp);+        return exc.get_errno();+    }+#else+    return dbenv->txn_begin(dbenv, parent, *txnpp, flags);+#endif+}++int _dbenv_txn_checkpoint(MY_DBENV* dbenvp, u_int32_t kbyte, u_int32_t min, u_int32_t flags)+{+    UNWRAP_DBENV();+    return dbenv->txn_checkpoint(dbenv, kbyte, min, flags);+}++int _dbtxn_abort(MY_DBTXN** dbtxnp)+{+    UNWRAP_DBTXN();+    *dbtxnp = NULL;+    dbtxn->abort(dbtxn);+}++int _dbtxn_commit(MY_DBTXN** dbtxnp, u_int32_t flags)+{+    UNWRAP_DBTXN();+    *dbtxnp = NULL;+    dbtxn->commit(dbtxn, flags);+}++void _dbtxn_delete(MY_DBTXN** dbtxnp)+{+    if (*dbtxnp != NULL)+#if defined(USE_DB_CXX)+        (*dbtxnp)->abort();+#else+        (*dbtxnp)->abort(*dbtxnp);+#endif+    free(dbtxnp);+}++u_int32_t _dbtxn_id(MY_DBTXN** dbtxnp)+{+    UNWRAP_DBTXN();+    return dbtxn->id(dbtxn);+}++int _dbenv_lock_get(MY_DBENV* dbenvp, u_int32_t lockerID, u_int32_t flags,+    const char* object, u_int32_t object_len, u_int32_t lockmode, _DB_LOCK** dblock)+{+    DBT dbt;+    UNWRAP_DBENV();++    memset(&dbt, 0, sizeof(dbt));+    dbt.flags = DB_DBT_USERMEM;+    dbt.data = (void*)object;+    dbt.size = object_len;+    *dblock = (_DB_LOCK*)malloc(sizeof(_DB_LOCK));+    (*dblock)->dbenv = dbenvp;+    int ret = dbenv->lock_get(dbenv, lockerID, flags, &dbt, (db_lockmode_t)lockmode, &(*dblock)->lock);+    if (ret != 0)+        free(*dblock);+    return ret;+}++int _dbenv_lock_put(_DB_LOCK* dblock)+{+    MY_DBENV* dbenvp = dblock->dbenv;+    UNWRAP_DBENV();+    return dbenv->lock_put(dbenv, &dblock->lock);+}++void _dblock_delete(_DB_LOCK* dblock)+{+    free(dblock);+}++void _freeString(char* str)+{+    free(str);+}++int _db_get(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags)+{+    DBT keyDbt;+    DBT valueDbt;+    int ret;+    DB_TXN* dbtxn;+    UNWRAP_DB();+    UNWRAP_DBTXN_();++    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_USERMEM;+    keyDbt.data = (void*)key;+    keyDbt.size = key_len;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_MALLOC;++    *value = NULL;+    *value_len = 0;+    ret = db->get(db, dbtxn, &keyDbt, &valueDbt, flags);+    if (ret == 0) {+        *value = (char*)valueDbt.data;+        *value_len = valueDbt.size;+    }+    return ret;+}++int _db_put(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags)+{+    DBT keyDbt;+    DBT valueDbt;+    DB_TXN* dbtxn;+    UNWRAP_DB();+    UNWRAP_DBTXN_();++    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_USERMEM;+    keyDbt.data = (void*)key;+    keyDbt.size = key_len;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_USERMEM;+    valueDbt.data = (void*)value;+    valueDbt.size = value_len;+    return db->put(db, dbtxn, &keyDbt, &valueDbt, flags);+}++int _db_del(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, u_int32_t flags)+{+    DBT keyDbt;+    DB_TXN* dbtxn;+    UNWRAP_DB();+    UNWRAP_DBTXN_();++    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_USERMEM;+    keyDbt.data = (void*)key;+    keyDbt.size = key_len;+    return db->del(db, dbtxn, &keyDbt, flags);+}++int _db_close(DB** dbp, u_int32_t flags)+{+    UNWRAP_DB();+    *dbp = NULL;+    return db->close(db, flags);+}++int _db_cursor(DB** dbp, MY_DBTXN** dbtxnp, DBC*** dbcursorpp, u_int32_t flags)+{+    DB_TXN* dbtxn;+    UNWRAP_DB();+    UNWRAP_DBTXN_();+    *dbcursorpp = (DBC**)malloc(sizeof(DBC**));+    int ret = db->cursor(db, dbtxn, *dbcursorpp, flags);+    if (ret != 0)+        free(*dbcursorpp);+    return ret;+}++void _dbcursor_delete(DBC** dbc)+{+    if (*dbc != NULL)+        (*dbc)->close(*dbc);+    free(dbc);+}++int _dbCursor_close(DBC** dbc)+{+    if (*dbc != NULL) {+        int ret = (*dbc)->close(*dbc);+        *dbc = NULL;+        return ret;+    }+    else+        return 0;+}++int _dbCursor_count(DBC** dbcp, u_int32_t* countp, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    db_recno_t countp_;+    int ret = dbc->count(dbc, &countp_, flags);+    *countp = (u_int32_t) countp_;+    return ret;+}++int _dbCursor_del(DBC** dbcp, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    return dbc->del(dbc, flags);+}++int _dbCursor_dup(DBC** dbcp, DBC*** dbcursorpp, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    *dbcursorpp = (DBC**)malloc(sizeof(DBC**));+    int ret = dbc->dup(dbc, *dbcursorpp, flags);+    if (ret != 0)+        free(*dbcursorpp);+    return ret;+}++int _dbCursor_get(DBC** dbcp, char** key, u_int32_t* key_len, char** value, u_int32_t* value_len, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    int ret;++    DBT keyDbt;+    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_MALLOC;+    *key = NULL;+    *key_len = 0;++    DBT valueDbt;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_MALLOC;+    *value = NULL;+    *value_len = 0;++    ret = dbc->get(dbc, &keyDbt, &valueDbt, flags);+    if (ret == 0) {+        *key = (char*)keyDbt.data;+        *key_len = keyDbt.size;+        *value = (char*)valueDbt.data;+        *value_len = valueDbt.size;+    }+    return ret;+}++int _dbCursor_set(DBC** dbcp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    int ret;++    DBT keyDbt;+    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_USERMEM;+    keyDbt.data = (void*)key;+    keyDbt.size = key_len;++    DBT valueDbt;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_MALLOC;+    *value = NULL;+    *value_len = 0;++    ret = dbc->get(dbc, &keyDbt, &valueDbt, flags);+    if (ret == 0) {+        *value = (char*)valueDbt.data;+        *value_len = valueDbt.size;+    }+    return ret;+}++int _dbCursor_put(DBC** dbcp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    DBT keyDbt;+    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_USERMEM;+    keyDbt.data = (void*)key;+    keyDbt.size = key_len;+    DBT valueDbt;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_USERMEM;+    valueDbt.data = (void*)value;+    valueDbt.size = value_len;+    return dbc->put(dbc, &keyDbt, &valueDbt, flags);+}

@@ -4,14 +4,11 @@ #include <stdlib.h> #include <errno.h> +#if defined(USE_DB_CXX) #define UNWRAP_DBENV() \     DB_ENV* dbenv = dbenvp->get_DB_ENV(); \     if (dbenv == NULL) return -20881;  /* Haskell binding-specific error code */ -#define UNWRAP_DB() \-    DB* db = *dbp; \-    if (db == NULL) return -20882;  /* Haskell binding-specific error code */- #define UNWRAP_DBTXN_() \     if (dbtxnp == NULL) \         dbtxn = NULL; \@@ -19,89 +16,147 @@         if (*dbtxnp == NULL) return -20883;  /* Haskell binding-specific error code */ \         dbtxn = (*dbtxnp)->get_DB_TXN(); \     }+#else+#define UNWRAP_DBENV() \+    DB_ENV* dbenv; \+    if (*dbenvp == NULL) return -20881;  /* Haskell binding-specific error code */ \+    dbenv = *dbenvp; +#define UNWRAP_DBTXN_() \+    if (dbtxnp == NULL) \+        dbtxn = NULL; \+    else { \+        if (*dbtxnp == NULL) return -20883;  /* Haskell binding-specific error code */ \+        dbtxn = *dbtxnp; \+    }+#endif++#define UNWRAP_DB() \+    DB* db = *dbp; \+    if (db == NULL) return -20882;  /* Haskell binding-specific error code */++#define UNWRAP_DBCURSOR() \+    DBC* dbc = *dbcp; \+    if (dbc == NULL) return -20884;  /* Haskell binding-specific error code */+ #define UNWRAP_DBTXN() \     DB_TXN* dbtxn; \     UNWRAP_DBTXN_() -int _dbenv_create(DbEnv** dbenvpp, u_int32_t flags)+int _dbenv_create(MY_DBENV** dbenvpp, u_int32_t flags) {+#if defined(USE_DB_CXX)     *dbenvpp = new DbEnv(flags);     return 0;+#else+    int ret;+    *dbenvpp = (MY_DBENV*)malloc(sizeof(MY_DBENV*));+    ret = db_env_create(*dbenvpp, flags);+    if (ret != 0)+        free(*dbenvpp);+    return ret;+#endif } -void _dbenv_delete(DbEnv* dbenvp)+void _dbenv_delete(MY_DBENV* dbenvp) {+#if defined(USE_DB_CXX)+#else+    _dbenv_close(dbenvp, 0);+    free(dbenvp);+#endif } -int _dbenv_get_lk_max_lockers(DbEnv* dbenvp, u_int32_t *lk_maxp) {+int _dbenv_get_lk_max_lockers(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {     UNWRAP_DBENV();     return dbenv->get_lk_max_lockers(dbenv, lk_maxp); } -int _dbenv_set_lk_max_lockers(DbEnv* dbenvp, u_int32_t max) {+int _dbenv_set_lk_max_lockers(MY_DBENV* dbenvp, u_int32_t max) {     UNWRAP_DBENV();     return dbenv->set_lk_max_lockers(dbenv, max); } -int _dbenv_get_lk_max_locks(DbEnv* dbenvp, u_int32_t *lk_maxp) {+int _dbenv_get_lk_max_locks(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {     UNWRAP_DBENV();     return dbenv->get_lk_max_locks(dbenv, lk_maxp); } -int _dbenv_set_lk_max_locks(DbEnv* dbenvp, u_int32_t max) {+int _dbenv_set_lk_max_locks(MY_DBENV* dbenvp, u_int32_t max) {     UNWRAP_DBENV();     return dbenv->set_lk_max_locks(dbenv, max); } -int _dbenv_get_lk_max_objects(DbEnv* dbenvp, u_int32_t *lk_maxp) {+int _dbenv_get_lk_max_objects(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {     UNWRAP_DBENV();     return dbenv->get_lk_max_objects(dbenv, lk_maxp); } -int _dbenv_set_lk_max_objects(DbEnv* dbenvp, u_int32_t max) {+int _dbenv_set_lk_max_objects(MY_DBENV* dbenvp, u_int32_t max) {     UNWRAP_DBENV();     return dbenv->set_lk_max_objects(dbenv, max); } -int _dbenv_get_tx_max(DbEnv* dbenvp, u_int32_t *lk_maxp) {+int _dbenv_get_tx_max(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {     UNWRAP_DBENV();     return dbenv->get_tx_max(dbenv, lk_maxp); } -int _dbenv_set_tx_max(DbEnv* dbenvp, u_int32_t max) {+int _dbenv_set_tx_max(MY_DBENV* dbenvp, u_int32_t max) {     UNWRAP_DBENV();     return dbenv->set_tx_max(dbenv, max); } -int _dbenv_get_cachesize(DbEnv* dbenvp, u_int32_t *gbytesp, u_int32_t *bytesp, int *ncachep) {+int _dbenv_get_cachesize(MY_DBENV* dbenvp, u_int32_t *gbytesp, u_int32_t *bytesp, int *ncachep) {     UNWRAP_DBENV();     return dbenv->get_cachesize(dbenv, gbytesp, bytesp, ncachep); } -int _dbenv_set_cachesize(DbEnv* dbenvp, u_int32_t gbytes, u_int32_t bytes, int ncache) {+int _dbenv_set_cachesize(MY_DBENV* dbenvp, u_int32_t gbytes, u_int32_t bytes, int ncache) {     UNWRAP_DBENV();     return dbenv->set_cachesize(dbenv, gbytes, bytes, ncache); } -int _dbenv_get_lg_regionmax(DbEnv* dbenvp, u_int32_t *lk_maxp) {+int _dbenv_get_lg_regionmax(MY_DBENV* dbenvp, u_int32_t *lk_maxp) {     UNWRAP_DBENV();     return dbenv->get_lg_regionmax(dbenv, lk_maxp); } -int _dbenv_set_lg_regionmax(DbEnv* dbenvp, u_int32_t max) {+int _dbenv_set_lg_regionmax(MY_DBENV* dbenvp, u_int32_t max) {     UNWRAP_DBENV();     return dbenv->set_lg_regionmax(dbenv, max); } -int _dbenv_open(DbEnv* dbenvp, char *db_home, u_int32_t flags, int mode) {+int _dbenv_set_lk_detect(MY_DBENV* dbenvp, u_int32_t flag)+{     UNWRAP_DBENV();+    return dbenv->set_lk_detect(dbenv, flag);+}++int _dbenv_open(MY_DBENV* dbenvp, char *db_home, u_int32_t flags, int mode) {+    UNWRAP_DBENV();     return dbenv->open(dbenv, db_home, flags, mode); } -int _db_create(DB*** dbpp, DbEnv* dbenvp, u_int32_t flags)+int _dbenv_close(MY_DBENV* dbenvp, u_int32_t flags) {     int ret;+#if defined(USE_DB_CXX)+    ret = dbenvp->close(flags);+#else+    if (*dbenvp != NULL) {+        ret = (*dbenvp)->close(*dbenvp,flags);+        *dbenvp = NULL;+    }+    else+        ret = 0;+#endif+    return ret;+}++int _db_create(DB*** dbpp, MY_DBENV* dbenvp, u_int32_t flags)+{+    int ret;     UNWRAP_DBENV();     *dbpp = (DB**)malloc(sizeof(DB**));     ret = db_create(*dbpp, dbenv, flags);@@ -123,7 +178,7 @@     return db->set_pagesize(db, pagesize); } -int _db_open(DB** dbp, DbTxn** txnp, const char* file, const char* database,+int _db_open(DB** dbp, MY_DBTXN** txnp, const char* file, const char* database,     int type, u_int32_t flags, int mode) {     DB_TXN* txn;@@ -132,21 +187,27 @@         txn = NULL;     else {         if (*txnp == NULL) return -20883;  /* Haskell binding-specific error code */+#if defined(USE_DB_CXX)         txn = (*txnp)->get_DB_TXN();+#else+        txn = *txnp;+#endif     }     return db->open(db, txn, file, database, (DBTYPE) type, flags, mode); } -int _dbenv_txn_begin(DbEnv* dbenvp, DbTxn** parentp, DbTxn*** txnpp, u_int32_t flags)+int _dbenv_txn_begin(MY_DBENV* dbenvp, MY_DBTXN** parentp, MY_DBTXN*** txnpp, u_int32_t flags) {-    DbTxn* parent;+    MY_DBTXN* parent;+    UNWRAP_DBENV();     if (parentp == NULL)         parent = NULL;     else {         parent = *parentp;         if (parent == NULL) return -20883;  /* Haskell binding-specific error code */     }-    *txnpp = (DbTxn**)malloc(sizeof(DbTxn*));+    *txnpp = (MY_DBTXN**)malloc(sizeof(MY_DBTXN*));+#if defined(USE_DB_CXX)     try {         return dbenvp->txn_begin(parent, *txnpp, flags);     }@@ -154,42 +215,49 @@         free(*txnpp);         return exc.get_errno();     }+#else+    return dbenv->txn_begin(dbenv, parent, *txnpp, flags);+#endif } -int _dbenv_txn_checkpoint(DbEnv* dbenvp, u_int32_t kbyte, u_int32_t min, u_int32_t flags)+int _dbenv_txn_checkpoint(MY_DBENV* dbenvp, u_int32_t kbyte, u_int32_t min, u_int32_t flags) {     UNWRAP_DBENV();     return dbenv->txn_checkpoint(dbenv, kbyte, min, flags); } -int _dbtxn_abort(DbTxn** dbtxnp)+int _dbtxn_abort(MY_DBTXN** dbtxnp) {     UNWRAP_DBTXN();     *dbtxnp = NULL;     dbtxn->abort(dbtxn); } -int _dbtxn_commit(DbTxn** dbtxnp, u_int32_t flags)+int _dbtxn_commit(MY_DBTXN** dbtxnp, u_int32_t flags) {     UNWRAP_DBTXN();     *dbtxnp = NULL;     dbtxn->commit(dbtxn, flags); } -void _dbtxn_delete(DbTxn** dbtxnp)+void _dbtxn_delete(MY_DBTXN** dbtxnp) {     if (*dbtxnp != NULL)+#if defined(USE_DB_CXX)         (*dbtxnp)->abort();+#else+        (*dbtxnp)->abort(*dbtxnp);+#endif     free(dbtxnp); } -u_int32_t _dbtxn_id(DbTxn** dbtxnp)+u_int32_t _dbtxn_id(MY_DBTXN** dbtxnp) {     UNWRAP_DBTXN();     return dbtxn->id(dbtxn); } -int _dbenv_lock_get(DbEnv* dbenvp, u_int32_t lockerID, u_int32_t flags,+int _dbenv_lock_get(MY_DBENV* dbenvp, u_int32_t lockerID, u_int32_t flags,     const char* object, u_int32_t object_len, u_int32_t lockmode, _DB_LOCK** dblock) {     DBT dbt;@@ -201,12 +269,15 @@     dbt.size = object_len;     *dblock = (_DB_LOCK*)malloc(sizeof(_DB_LOCK));     (*dblock)->dbenv = dbenvp;-    return dbenv->lock_get(dbenv, lockerID, flags, &dbt, (db_lockmode_t)lockmode, &(*dblock)->lock);+    int ret = dbenv->lock_get(dbenv, lockerID, flags, &dbt, (db_lockmode_t)lockmode, &(*dblock)->lock);+    if (ret != 0)+        free(*dblock);+    return ret; }  int _dbenv_lock_put(_DB_LOCK* dblock) {-    DbEnv* dbenvp = dblock->dbenv;+    MY_DBENV* dbenvp = dblock->dbenv;     UNWRAP_DBENV();     return dbenv->lock_put(dbenv, &dblock->lock); }@@ -221,7 +292,7 @@     free(str); } -int _db_get(DB** dbp, DbTxn** dbtxnp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags)+int _db_get(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags) {     DBT keyDbt;     DBT valueDbt;@@ -247,14 +318,14 @@     return ret; } -int _db_put(DB** dbp, DbTxn** dbtxnp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags)+int _db_put(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags) {     DBT keyDbt;     DBT valueDbt;     DB_TXN* dbtxn;     UNWRAP_DB();     UNWRAP_DBTXN_();-    +     memset(&keyDbt, 0, sizeof(keyDbt));     keyDbt.flags = DB_DBT_USERMEM;     keyDbt.data = (void*)key;@@ -266,7 +337,7 @@     return db->put(db, dbtxn, &keyDbt, &valueDbt, flags); } -int _db_del(DB** dbp, DbTxn** dbtxnp, const char* key, u_int32_t key_len, u_int32_t flags)+int _db_del(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, u_int32_t flags) {     DBT keyDbt;     DB_TXN* dbtxn;@@ -287,14 +358,125 @@     return db->close(db, flags); } -int _dbenv_close(DbEnv* dbenvp, u_int32_t flags)+int _db_cursor(DB** dbp, MY_DBTXN** dbtxnp, DBC*** dbcursorpp, u_int32_t flags) {-    dbenvp->close(flags);+    DB_TXN* dbtxn;+    UNWRAP_DB();+    UNWRAP_DBTXN_();+    *dbcursorpp = (DBC**)malloc(sizeof(DBC**));+    int ret = db->cursor(db, dbtxn, *dbcursorpp, flags);+    if (ret != 0)+        free(*dbcursorpp);+    return ret; } -int _dbenv_set_lk_detect(DbEnv* dbenvp, u_int32_t flag)+void _dbcursor_delete(DBC** dbc) {-    UNWRAP_DBENV();-    return dbenv->set_lk_detect(dbenv, flag);+    if (*dbc != NULL)+        (*dbc)->close(*dbc);+    free(dbc); } +int _dbCursor_close(DBC** dbc)+{+    if (*dbc != NULL) {+        int ret = (*dbc)->close(*dbc);+        *dbc = NULL;+        return ret;+    }+    else+        return 0;+}++int _dbCursor_count(DBC** dbcp, u_int32_t* countp, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    db_recno_t countp_;+    int ret = dbc->count(dbc, &countp_, flags);+    *countp = (u_int32_t) countp_;+    return ret;+}++int _dbCursor_del(DBC** dbcp, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    return dbc->del(dbc, flags);+}++int _dbCursor_dup(DBC** dbcp, DBC*** dbcursorpp, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    *dbcursorpp = (DBC**)malloc(sizeof(DBC**));+    int ret = dbc->dup(dbc, *dbcursorpp, flags);+    if (ret != 0)+        free(*dbcursorpp);+    return ret;+}++int _dbCursor_get(DBC** dbcp, char** key, u_int32_t* key_len, char** value, u_int32_t* value_len, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    int ret;++    DBT keyDbt;+    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_MALLOC;+    *key = NULL;+    *key_len = 0;++    DBT valueDbt;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_MALLOC;+    *value = NULL;+    *value_len = 0;++    ret = dbc->get(dbc, &keyDbt, &valueDbt, flags);+    if (ret == 0) {+        *key = (char*)keyDbt.data;+        *key_len = keyDbt.size;+        *value = (char*)valueDbt.data;+        *value_len = valueDbt.size;+    }+    return ret;+}++int _dbCursor_set(DBC** dbcp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    int ret;++    DBT keyDbt;+    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_USERMEM;+    keyDbt.data = (void*)key;+    keyDbt.size = key_len;++    DBT valueDbt;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_MALLOC;+    *value = NULL;+    *value_len = 0;++    ret = dbc->get(dbc, &keyDbt, &valueDbt, flags);+    if (ret == 0) {+        *value = (char*)valueDbt.data;+        *value_len = valueDbt.size;+    }+    return ret;+}++int _dbCursor_put(DBC** dbcp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags)+{+    UNWRAP_DBCURSOR();+    DBT keyDbt;+    memset(&keyDbt, 0, sizeof(keyDbt));+    keyDbt.flags = DB_DBT_USERMEM;+    keyDbt.data = (void*)key;+    keyDbt.size = key_len;+    DBT valueDbt;+    memset(&valueDbt, 0, sizeof(valueDbt));+    valueDbt.flags = DB_DBT_USERMEM;+    valueDbt.data = (void*)value;+    valueDbt.size = value_len;+    return dbc->put(dbc, &keyDbt, &valueDbt, flags);+}

@@ -1,53 +1,75 @@ #ifndef _DB_HELPER_H_ #define _DB_HELPER_H_ +#if defined(USE_DB_CXX) #include <db_cxx.h>+#define MY_DBENV DbEnv+#define MY_DBTXN DbTxn+#else+#include <db.h>+#define MY_DBENV DB_ENV*+#define MY_DBTXN DB_TXN+#endif  typedef struct _DB_LOCK {-    DbEnv* dbenv;+    MY_DBENV* dbenv;     DB_LOCK lock; } _DB_LOCK; +++#if defined(USE_DB_CXX) extern "C" {-int _dbenv_create(DbEnv** dbenvpp, u_int32_t flags);-void _dbenv_delete(DbEnv* dbenvp);-int _dbenv_get_lk_max_lockers(DbEnv* dbenvp, u_int32_t *lk_maxp);-int _dbenv_set_lk_max_lockers(DbEnv* dbenvp, u_int32_t max);-int _dbenv_get_lk_max_locks(DbEnv* dbenvp, u_int32_t *lk_maxp);-int _dbenv_set_lk_max_locks(DbEnv* dbenvp, u_int32_t max);-int _dbenv_get_lk_max_objects(DbEnv* dbenvp, u_int32_t *lk_maxp);-int _dbenv_set_lk_max_objects(DbEnv* dbenvp, u_int32_t max);-int _dbenv_get_tx_max(DbEnv* dbenvp, u_int32_t *lk_maxp);-int _dbenv_set_tx_max(DbEnv* dbenvp, u_int32_t max);-int _dbenv_get_cachesize(DbEnv* dbenvp, u_int32_t *gbytesp, u_int32_t *bytesp, int *ncachep);-int _dbenv_set_cachesize(DbEnv* dbenvp, u_int32_t gbytes, u_int32_t bytes, int ncache);-int _dbenv_get_lg_regionmax(DbEnv* dbenvp, u_int32_t *lk_maxp);-int _dbenv_set_lg_regionmax(DbEnv* dbenvp, u_int32_t max);-int _dbenv_open(DbEnv* dbenvp, char *db_home, u_int32_t flags, int mode);-int _db_create(DB*** dbpp, DbEnv* dbenvp, u_int32_t flags);+#endif+int _dbenv_create(MY_DBENV** dbenvpp, u_int32_t flags);+void _dbenv_delete(MY_DBENV* dbenvp);+int _dbenv_get_lk_max_lockers(MY_DBENV* dbenvp, u_int32_t *lk_maxp);+int _dbenv_set_lk_max_lockers(MY_DBENV* dbenvp, u_int32_t max);+int _dbenv_get_lk_max_locks(MY_DBENV* dbenvp, u_int32_t *lk_maxp);+int _dbenv_set_lk_max_locks(MY_DBENV* dbenvp, u_int32_t max);+int _dbenv_get_lk_max_objects(MY_DBENV* dbenvp, u_int32_t *lk_maxp);+int _dbenv_set_lk_max_objects(MY_DBENV* dbenvp, u_int32_t max);+int _dbenv_get_tx_max(MY_DBENV* dbenvp, u_int32_t *lk_maxp);+int _dbenv_set_tx_max(MY_DBENV* dbenvp, u_int32_t max);+int _dbenv_get_cachesize(MY_DBENV* dbenvp, u_int32_t *gbytesp, u_int32_t *bytesp, int *ncachep);+int _dbenv_set_cachesize(MY_DBENV* dbenvp, u_int32_t gbytes, u_int32_t bytes, int ncache);+int _dbenv_get_lg_regionmax(MY_DBENV* dbenvp, u_int32_t *lk_maxp);+int _dbenv_set_lg_regionmax(MY_DBENV* dbenvp, u_int32_t max);+int _dbenv_set_lk_detect(MY_DBENV* dbEnv, u_int32_t flag);+int _dbenv_open(MY_DBENV* dbenvp, char *db_home, u_int32_t flags, int mode);+int _dbenv_close(MY_DBENV* dbEnv, u_int32_t flags);+int _db_create(DB*** dbpp, MY_DBENV* dbenvp, u_int32_t flags); void _db_delete(DB** db); int _db_set_pagesize(DB** dbp, u_int32_t pagesize);-int _db_open(DB** dbp, DbTxn** txnp, const char* file, const char* database,+int _db_open(DB** dbp, MY_DBTXN** txnp, const char* file, const char* database,     int type, u_int32_t flags, int mode);-int _dbenv_txn_begin(DbEnv* dbenvp, DbTxn** parent, DbTxn*** txnpp, u_int32_t flags);-int _dbenv_txn_checkpoint(DbEnv* dbenvp, u_int32_t kbyte, u_int32_t min, u_int32_t flags);-int _dbtxn_abort(DbTxn** dbtxnp);-int _dbtxn_commit(DbTxn** dbtxnp, u_int32_t flags);-void _dbtxn_delete(DbTxn** dbtxnp);-u_int32_t _dbtxn_id(DbTxn** dbtxnp);+int _dbenv_txn_begin(MY_DBENV* dbenvp, MY_DBTXN** parent, MY_DBTXN*** txnpp, u_int32_t flags);+int _dbenv_txn_checkpoint(MY_DBENV* dbenvp, u_int32_t kbyte, u_int32_t min, u_int32_t flags);+int _dbtxn_abort(MY_DBTXN** dbtxnp);+int _dbtxn_commit(MY_DBTXN** dbtxnp, u_int32_t flags);+void _dbtxn_delete(MY_DBTXN** dbtxnp);+u_int32_t _dbtxn_id(MY_DBTXN** dbtxnp); void _dblock_delete(_DB_LOCK* dblock);-int _dbenv_lock_get(DbEnv* dbenvp, u_int32_t lockerID, u_int32_t flags,+int _dbenv_lock_get(MY_DBENV* dbenvp, u_int32_t lockerID, u_int32_t flags,     const char* object, u_int32_t object_len, u_int32_t lockmode, _DB_LOCK** dblock); int _dbenv_lock_put(_DB_LOCK* dblock); void _deleteString(char* str); void _freeString(char* str);-int _db_get(DB** dbp, DbTxn** dbtxnp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags);-int _db_put(DB** dbp, DbTxn** dbtxnp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags);-int _db_del(DB** dbp, DbTxn** dbtxnp, const char* key, u_int32_t key_len, u_int32_t flags);+int _db_get(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags);+int _db_put(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags);+int _db_del(DB** dbp, MY_DBTXN** dbtxnp, const char* key, u_int32_t key_len, u_int32_t flags); int _db_close(DB** dbp, u_int32_t flags);-int _dbenv_close(DbEnv* dbEnv, u_int32_t flags);-int _dbenv_set_lk_detect(DbEnv* dbEnv, u_int32_t flag);+int _db_cursor(DB** dbp, MY_DBTXN** dbtxnp, DBC*** dbcursorpp, u_int32_t flags);+void _dbcursor_delete(DBC** dbc);+int _dbCursor_close(DBC** dbc);+int _dbCursor_count(DBC** dbcp, u_int32_t* countp, u_int32_t flags);+int _dbCursor_del(DBC** dbcp, u_int32_t flags);+int _dbCursor_dup(DBC** dbcp, DBC*** dbcursorpp, u_int32_t flags);+int _dbCursor_get(DBC** dbcp, char** key, u_int32_t* key_len, char** value, u_int32_t* value_len, u_int32_t flags);+int _dbCursor_set(DBC** dbcp, const char* key, u_int32_t key_len, char** value, u_int32_t* value_len, u_int32_t flags);+int _dbCursor_put(DBC** dbcp, const char* key, u_int32_t key_len, const char* value, u_int32_t value_len, u_int32_t flags);+#if defined(USE_DB_CXX) }- #endif +#endif

@@ -63,12 +63,17 @@                     )         assertEqual "exception" (Just (SYSTEM_ERROR 2)) answer  -- 2 == ENOENT -test_putget = do+withCase1 action = do     cleanDb $ \dbenv db -> do-        db_put [] db Nothing (pack "car")   (pack "triumph")-        db_put [] db Nothing (pack "fruit") (pack "banana")-        db_put [] db Nothing (pack "car")   (pack "honda")-        db_put [] db Nothing (pack "tree")  (pack "poplar")+        dbEnv_withTxn [] [] dbenv Nothing $ \txn -> do+            db_put [] db (Just txn) (pack "car")   (pack "triumph")+            db_put [] db (Just txn) (pack "fruit") (pack "banana")+            db_put [] db (Just txn) (pack "car")   (pack "honda")+            db_put [] db (Just txn) (pack "tree")  (pack "poplar")+        action dbenv db++test_putget = do+    withCase1 $ \dbenv db -> do         assertEqual "putget_fruit" (Just $ pack "banana") =<< db_get [] db Nothing (pack "fruit")         assertEqual "putget_car"   (Just $ pack "honda")  =<< db_get [] db Nothing (pack "car")         assertEqual "putget_tree"  (Just $ pack "poplar") =<< db_get [] db Nothing (pack "tree")@@ -137,12 +142,86 @@             dbEnv_withLock [] DB_LOCK_WRITE (pack "my_lock") dbenv (dbTxn_id txn) $ do                 db_put [] db (Just txn) (pack "fruit") (pack "durian") +test_dbCursor_get =+    withCase1 $ \dbenv db ->+    dbEnv_withTxn [] [] dbenv Nothing $ \txn ->+    db_withCursor [] db (Just txn) $ \cur -> do+        assertEqual "dbCursor_get_car" (Just (pack "car", pack "honda")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_get_fruit" (Just (pack "fruit", pack "banana")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_get_tree" (Just (pack "tree", pack "poplar")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_get_Nothing" Nothing =<< dbCursor_get [DB_NEXT] cur++test_dbCursor_put1 =+    cleanDb $ \dbenv db ->+    dbEnv_withTxn [] [] dbenv Nothing $ \txn -> do+        db_withCursor [] db (Just txn) $ \cur -> do+            dbCursor_put [DB_KEYFIRST] cur (pack "dog") (pack "Xanthe")+            dbCursor_put [DB_KEYFIRST] cur (pack "cat") (pack "Jasper")+        db_withCursor [] db (Just txn) $ \cur -> do+            assertEqual "dbCursor_put1_cat" (Just (pack "cat", pack "Jasper")) =<< dbCursor_get [DB_NEXT] cur+            assertEqual "dbCursor_put1_dog" (Just (pack "dog", pack "Xanthe")) =<< dbCursor_get [DB_NEXT] cur++test_dbCursor_put2 =+    withCase1 $ \dbenv db ->+    dbEnv_withTxn [] [] dbenv Nothing $ \txn ->+    db_withCursor [] db (Just txn) $ \cur -> do+        assertEqual "dbCursor_put2_car" (Just (pack "car", pack "honda")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_put2_fruit" (Just (pack "fruit", pack "banana")) =<< dbCursor_get [DB_NEXT] cur+        dbCursor_put [DB_CURRENT] cur (pack "") (pack "orange")+        assertEqual "dbCursor_put2_car" (Just (pack "car", pack "honda")) =<< dbCursor_get [DB_FIRST] cur+        assertEqual "dbCursor_put2_fruit" (Just (pack "fruit", pack "orange")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_put2_tree" (Just (pack "tree", pack "poplar")) =<< dbCursor_get [DB_NEXT] cur++test_dbCursor_set =+    withCase1 $ \dbenv db ->+    dbEnv_withTxn [] [] dbenv Nothing $ \txn ->+    db_withCursor [] db (Just txn) $ \cur -> do+        assertEqual "dbCursor_set_tree" (Just $ pack "poplar") =<< dbCursor_set [] cur (pack "tree")+        assertEqual "dbCursor_set_Nothing" Nothing =<< dbCursor_get [DB_NEXT] cur++test_dbCursor_dup =+    withCase1 $ \dbenv db ->+    dbEnv_withTxn [] [] dbenv Nothing $ \txn ->+    db_withCursor [] db (Just txn) $ \cur1 -> do+        assertEqual "dbCursor_dup_car" (Just (pack "car", pack "honda")) =<< dbCursor_get [DB_NEXT] cur1+        dbCursor_withCursor [DB_POSITION] cur1 $ \cur2 -> do+            assertEqual "dbCursor_dup_2_fruit" (Just (pack "fruit", pack "banana")) =<< dbCursor_get [DB_NEXT] cur2+            assertEqual "dbCursor_dup_2_tree" (Just (pack "tree", pack "poplar")) =<< dbCursor_get [DB_NEXT] cur2+        assertEqual "dbCursor_dup_fruit" (Just (pack "fruit", pack "banana")) =<< dbCursor_get [DB_NEXT] cur1+        assertEqual "dbCursor_dup_tree" (Just (pack "tree", pack "poplar")) =<< dbCursor_get [DB_NEXT] cur1+        assertEqual "dbCursor_dup_Nothing" Nothing =<< dbCursor_get [DB_NEXT] cur1++test_dbCursor_del =+    withCase1 $ \dbenv db ->+    dbEnv_withTxn [] [] dbenv Nothing $ \txn ->+    db_withCursor [] db (Just txn) $ \cur -> do+        assertEqual "dbCursor_del_1_car" (Just (pack "car", pack "honda")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_del_1_fruit" (Just (pack "fruit", pack "banana")) =<< dbCursor_get [DB_NEXT] cur+        dbCursor_del [] cur+        assertEqual "dbCursor_del_2_car" (Just (pack "car", pack "honda")) =<< dbCursor_get [DB_FIRST] cur+        assertEqual "dbCursor_del_2_tree" (Just (pack "tree", pack "poplar")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_del_2_Nothing" Nothing =<< dbCursor_get [DB_NEXT] cur++test_dbCursor_count =+    withCase1 $ \dbenv db ->+    dbEnv_withTxn [] [] dbenv Nothing $ \txn ->+    db_withCursor [] db (Just txn) $ \cur -> do+        assertEqual "dbCursor_count_car" (Just (pack "car", pack "honda")) =<< dbCursor_get [DB_NEXT] cur+        assertEqual "dbCursor_count_val" 1 =<< dbCursor_count [] cur+ main = do     runTestTT $ TestList [             TestCase test_exception,             TestCase test_putget,             TestCase test_txn,             TestCase test_afterclose,-            TestCase test_lock+            TestCase test_lock,+            TestCase test_dbCursor_get,+            TestCase test_dbCursor_put1,+            TestCase test_dbCursor_put2,+            TestCase test_dbCursor_set,+            TestCase test_dbCursor_dup,+            TestCase test_dbCursor_del,+            TestCase test_dbCursor_count         ]