mariadb/bdb/perl/BerkeleyDB/BerkeleyDB.xs

/*

 BerkeleyDB.xs -- Perl 5 interface to Berkeley DB version 2 & 3

 written by Paul Marquess <Paul.Marquess@btinternet.com>

 All comments/suggestions/problems are welcome

     Copyright (c) 1997-2002 Paul Marquess. All rights reserved.
     This program is free software; you can redistribute it and/or
     modify it under the same terms as Perl itself.

     Please refer to the COPYRIGHT section in

 Changes:
        0.01 -  First Alpha Release
        0.02 -

*/



#ifdef __cplusplus
extern "C" {
#endif

#define PERL_POLLUTE
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"


/* XSUB.h defines a macro called abort 				*/
/* This clashes with the txn abort method in Berkeley DB 4.x	*/
/* This is a problem with ActivePerl (at least)			*/

#ifdef _WIN32
#  ifdef abort
#    undef abort
#  endif
#  ifdef fopen
#    undef fopen
#  endif
#  ifdef fclose
#    undef fclose
#  endif
#endif

/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
 * shortly #included by the <db.h>) __attribute__ to the possibly
 * already defined __attribute__, for example by GNUC or by Perl. */

#undef __attribute__

#ifdef USE_PERLIO
#    define GetFILEptr(sv) PerlIO_findFILE(IoOFP(sv_2io(sv)))
#else
#    define GetFILEptr(sv) IoOFP(sv_2io(sv))
#endif

#include <db.h>

/* Check the version of Berkeley DB */

#ifndef DB_VERSION_MAJOR
#ifdef HASHMAGIC
#error db.h is from Berkeley DB 1.x - need at least Berkeley DB 2.6.4
#else
#error db.h is not for Berkeley DB at all.
#endif
#endif

#if (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6) ||\
    (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 6 && DB_VERSION_PATCH < 4)
#  error db.h is from Berkeley DB 2.0-2.5 - need at least Berkeley DB 2.6.4
#endif


#if (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 0)
#  define IS_DB_3_0_x
#endif

#if DB_VERSION_MAJOR >= 3
#  define AT_LEAST_DB_3
#endif

#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 1)
#  define AT_LEAST_DB_3_1
#endif

#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
#  define AT_LEAST_DB_3_2
#endif

#if DB_VERSION_MAJOR > 3 || \
    (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 2) ||\
    (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 2 && DB_VERSION_PATCH >= 6)
#  define AT_LEAST_DB_3_2_6
#endif

#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)
#  define AT_LEAST_DB_3_3
#endif

#if DB_VERSION_MAJOR >= 4
#  define AT_LEAST_DB_4
#endif

#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
#  define AT_LEAST_DB_4_1
#endif

#ifdef __cplusplus
}
#endif

#define DBM_FILTERING
#define STRICT_CLOSE
/* #define ALLOW_RECNO_OFFSET */
/* #define TRACE */

#if DB_VERSION_MAJOR == 2 && ! defined(DB_LOCK_DEADLOCK)
#  define DB_LOCK_DEADLOCK	EAGAIN
#endif /* DB_VERSION_MAJOR == 2 */

#if DB_VERSION_MAJOR == 2
#  define DB_QUEUE		4
#endif /* DB_VERSION_MAJOR == 2 */

#ifdef AT_LEAST_DB_3_2
#    define DB_callback	DB * db,
#else
#    define DB_callback
#endif

#if DB_VERSION_MAJOR > 2
typedef struct {
        int              db_lorder;
        size_t           db_cachesize;
        size_t           db_pagesize;


        void *(*db_malloc) __P((size_t));
        int (*dup_compare)
            __P((DB_callback const DBT *, const DBT *));

        u_int32_t        bt_maxkey;
        u_int32_t        bt_minkey;
        int (*bt_compare)
            __P((DB_callback const DBT *, const DBT *));
        size_t (*bt_prefix)
            __P((DB_callback const DBT *, const DBT *));

        u_int32_t        h_ffactor;
        u_int32_t        h_nelem;
        u_int32_t      (*h_hash)
            __P((DB_callback const void *, u_int32_t));

        int              re_pad;
        int              re_delim;
        u_int32_t        re_len;
        char            *re_source;

#define DB_DELIMITER            0x0001
#define DB_FIXEDLEN             0x0008
#define DB_PAD                  0x0010
        u_int32_t        flags;
        u_int32_t        q_extentsize;
} DB_INFO ;

#endif /* DB_VERSION_MAJOR > 2 */

typedef struct {
	int		Status ;
	/* char		ErrBuff[1000] ; */
	SV *		ErrPrefix ;
	FILE *		ErrHandle ;
	DB_ENV *	Env ;
	int		open_dbs ;
	int		TxnMgrStatus ;
	int		active ;
	bool		txn_enabled ;
	} BerkeleyDB_ENV_type ;


typedef struct {
        DBTYPE  	type ;
	bool		recno_or_queue ;
	char *		filename ;
	BerkeleyDB_ENV_type * parent_env ;
        DB *    	dbp ;
        SV *    	compare ;
        bool    	in_compare ;
        SV *    	dup_compare ;
        bool    	in_dup_compare ;
        SV *    	prefix ;
        bool    	in_prefix ;
        SV *   	 	hash ;
        bool    	in_hash ;
#ifdef AT_LEAST_DB_3_3
        SV *   	 	associated ;
	bool		secondary_db ;
#endif
	int		Status ;
        DB_INFO *	info ;
        DBC *   	cursor ;
	DB_TXN *	txn ;
	int		open_cursors ;
	u_int32_t	partial ;
	u_int32_t	dlen ;
	u_int32_t	doff ;
	int		active ;
#ifdef ALLOW_RECNO_OFFSET
	int		array_base ;
#endif
#ifdef DBM_FILTERING
        SV *    filter_fetch_key ;
        SV *    filter_store_key ;
        SV *    filter_fetch_value ;
        SV *    filter_store_value ;
        int     filtering ;
#endif
        } BerkeleyDB_type;


typedef struct {
        DBTYPE  	type ;
	bool		recno_or_queue ;
	char *		filename ;
        DB *    	dbp ;
        SV *    	compare ;
        SV *    	dup_compare ;
        SV *    	prefix ;
        SV *   	 	hash ;
#ifdef AT_LEAST_DB_3_3
        SV *   	 	associated ;
	bool		secondary_db ;
#endif
	int		Status ;
        DB_INFO *	info ;
        DBC *   	cursor ;
	DB_TXN *	txn ;
	BerkeleyDB_type *		parent_db ;
	u_int32_t	partial ;
	u_int32_t	dlen ;
	u_int32_t	doff ;
	int		active ;
#ifdef ALLOW_RECNO_OFFSET
	int		array_base ;
#endif
#ifdef DBM_FILTERING
        SV *    filter_fetch_key ;
        SV *    filter_store_key ;
        SV *    filter_fetch_value ;
        SV *    filter_store_value ;
        int     filtering ;
#endif
        } BerkeleyDB_Cursor_type;

typedef struct {
	BerkeleyDB_ENV_type *	env ;
	} BerkeleyDB_TxnMgr_type ;

#if 1
typedef struct {
	int		Status ;
	DB_TXN *	txn ;
	int		active ;
	} BerkeleyDB_Txn_type ;
#else
typedef DB_TXN                BerkeleyDB_Txn_type ;
#endif

typedef BerkeleyDB_ENV_type *	BerkeleyDB__Env ;
typedef BerkeleyDB_ENV_type *	BerkeleyDB__Env__Raw ;
typedef BerkeleyDB_ENV_type *	BerkeleyDB__Env__Inner ;
typedef BerkeleyDB_type * 	BerkeleyDB ;
typedef void * 			BerkeleyDB__Raw ;
typedef BerkeleyDB_type *	BerkeleyDB__Common ;
typedef BerkeleyDB_type *	BerkeleyDB__Common__Raw ;
typedef BerkeleyDB_type *	BerkeleyDB__Common__Inner ;
typedef BerkeleyDB_type * 	BerkeleyDB__Hash ;
typedef BerkeleyDB_type * 	BerkeleyDB__Hash__Raw ;
typedef BerkeleyDB_type * 	BerkeleyDB__Btree ;
typedef BerkeleyDB_type * 	BerkeleyDB__Btree__Raw ;
typedef BerkeleyDB_type * 	BerkeleyDB__Recno ;
typedef BerkeleyDB_type * 	BerkeleyDB__Recno__Raw ;
typedef BerkeleyDB_type * 	BerkeleyDB__Queue ;
typedef BerkeleyDB_type * 	BerkeleyDB__Queue__Raw ;
typedef BerkeleyDB_Cursor_type   	BerkeleyDB__Cursor_type ;
typedef BerkeleyDB_Cursor_type * 	BerkeleyDB__Cursor ;
typedef BerkeleyDB_Cursor_type * 	BerkeleyDB__Cursor__Raw ;
typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr ;
typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Raw ;
typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Inner ;
typedef BerkeleyDB_Txn_type *	BerkeleyDB__Txn ;
typedef BerkeleyDB_Txn_type *	BerkeleyDB__Txn__Raw ;
typedef BerkeleyDB_Txn_type *	BerkeleyDB__Txn__Inner ;
#if 0
typedef DB_LOG *      		BerkeleyDB__Log ;
typedef DB_LOCKTAB *  		BerkeleyDB__Lock ;
#endif
typedef DBT 			DBTKEY ;
typedef DBT 			DBT_OPT ;
typedef DBT 			DBT_B ;
typedef DBT 			DBTKEY_B ;
typedef DBT 			DBTVALUE ;
typedef void *	      		PV_or_NULL ;
typedef PerlIO *      		IO_or_NULL ;
typedef int			DualType ;

static void
hash_delete(char * hash, char * key);

#ifdef TRACE
#  define Trace(x)	printf x
#else
#  define Trace(x)
#endif

#ifdef ALLOW_RECNO_OFFSET
#  define RECNO_BASE	db->array_base
#else
#  define RECNO_BASE	1
#endif

#if DB_VERSION_MAJOR == 2
#  define flagSet_DB2(i, f) i |= f
#else
#  define flagSet_DB2(i, f)
#endif

#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
#  define flagSet(bitmask)        (flags & (bitmask))
#else
#  define flagSet(bitmask)	((flags & DB_OPFLAGS_MASK) == (bitmask))
#endif

#if DB_VERSION_MAJOR == 2 
#  define BackRef	internal
#else
#  if DB_VERSION_MAJOR == 3 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0)
#    define BackRef	cj_internal
#  else
#    define BackRef	api_internal
#  endif
#endif

#define ERR_BUFF "BerkeleyDB::Error"

#define ZMALLOC(to, typ) ((to = (typ *)safemalloc(sizeof(typ))), \
				Zero(to,1,typ))

#define DBT_clear(x)	Zero(&x, 1, DBT) ;

#if 1
#define getInnerObject(x) (*av_fetch((AV*)SvRV(x), 0, FALSE))
#else
#define getInnerObject(x) ((SV*)SvRV(sv))
#endif

#define my_sv_setpvn(sv, d, s) (s ? sv_setpvn(sv, d, s) : sv_setpv(sv, "") )

#define SetValue_iv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
				i = SvIV(sv)
#define SetValue_io(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
				i = GetFILEptr(sv)
#define SetValue_sv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
				i = sv
#define SetValue_pv(i, k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
				i = (t)SvPV(sv,PL_na)
#define SetValue_pvx(i, k, t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
				i = (t)SvPVX(sv)
#define SetValue_ov(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
				IV tmp = SvIV(getInnerObject(sv)) ;	\
				i = INT2PTR(t, tmp) ;			\
			  }

#define SetValue_ovx(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
				HV * hv = (HV *)GetInternalObject(sv);		\
				SV ** svp = hv_fetch(hv, "db", 2, FALSE);\
				IV tmp = SvIV(*svp);			\
				i = INT2PTR(t, tmp) ;				\
			  }

#define SetValue_ovX(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
				IV tmp = SvIV(GetInternalObject(sv));\
				i = INT2PTR(t, tmp) ;				\
			  }

#define LastDBerror DB_RUNRECOVERY

#define setDUALerrno(var, err)					\
		sv_setnv(var, (double)err) ;			\
		sv_setpv(var, ((err) ? db_strerror(err) : "")) ;\
		SvNOK_on(var);

#define OutputValue(arg, name)                                  \
        { if (RETVAL == 0) {                                    \
              my_sv_setpvn(arg, name.data, name.size) ;         \
              DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ;            \
          }                                                     \
        }

#define OutputValue_B(arg, name)                                  \
        { if (RETVAL == 0) {                                    \
		if (db->type == DB_BTREE && 			\
			flagSet(DB_GET_RECNO)){			\
                    sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
                }                                               \
                else {                                          \
                    my_sv_setpvn(arg, name.data, name.size) ;   \
                }                                               \
                DBM_ckFilter(arg, filter_fetch_value, "filter_fetch_value");          \
          }                                                     \
        }

#define OutputKey(arg, name)                                    \
        { if (RETVAL == 0) 					\
          {                                                     \
                if (!db->recno_or_queue) {                     	\
                    my_sv_setpvn(arg, name.data, name.size);    \
                }                                               \
                else                                            \
                    sv_setiv(arg, (I32)*(I32*)name.data - RECNO_BASE);   \
                DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ;            \
          }                                                     \
        }

#define OutputKey_B(arg, name)                                  \
        { if (RETVAL == 0) 					\
          {                                                     \
                if (db->recno_or_queue ||			\
			(db->type == DB_BTREE && 		\
			    flagSet(DB_GET_RECNO))){		\
                    sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
                }                                               \
                else {                                          \
                    my_sv_setpvn(arg, name.data, name.size);    \
                }                                               \
                DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ;            \
          }                                                     \
        }

#define SetPartial(data,db) 					\
	data.flags = db->partial ;				\
	data.dlen  = db->dlen ;					\
	data.doff  = db->doff ;

#define ckActive(active, type) 					\
    {								\
	if (!active)						\
	    softCrash("%s is already closed", type) ;		\
    }

#define ckActive_Environment(a)	ckActive(a, "Environment")
#define ckActive_TxnMgr(a)	ckActive(a, "Transaction Manager")
#define ckActive_Transaction(a) ckActive(a, "Transaction")
#define ckActive_Database(a) 	ckActive(a, "Database")
#define ckActive_Cursor(a) 	ckActive(a, "Cursor")

/* Internal Global Data */
static db_recno_t Value ;
static db_recno_t zero = 0 ;
static BerkeleyDB	CurrentDB ;

static DBTKEY	empty ;
#if 0
static char	ErrBuff[1000] ;
#endif

#ifdef AT_LEAST_DB_3_3
#    if PERL_REVISION == 5 && PERL_VERSION <= 4

/* saferealloc in perl5.004 will croak if it is given a NULL pointer*/
void *
MyRealloc(void * ptr, size_t size)
{
    if (ptr == NULL ) 
        return safemalloc(size) ; 
    else
        return saferealloc(ptr, size) ;
}

#    else
#        define MyRealloc saferealloc
#    endif
#endif

static char *
my_strdup(const char *s)
{
    if (s == NULL)
        return NULL ;

    {
        MEM_SIZE l = strlen(s);
        char *s1 = (char *)safemalloc(l);

        Copy(s, s1, (MEM_SIZE)l, char);
        return s1;
    }
}

#if DB_VERSION_MAJOR == 2
static char *
db_strerror(int err)
{
    if (err == 0)
        return "" ;

    if (err > 0)
        return Strerror(err) ;

    switch (err) {
	case DB_INCOMPLETE:
		return ("DB_INCOMPLETE: Sync was unable to complete");
	case DB_KEYEMPTY:
		return ("DB_KEYEMPTY: Non-existent key/data pair");
	case DB_KEYEXIST:
		return ("DB_KEYEXIST: Key/data pair already exists");
	case DB_LOCK_DEADLOCK:
		return (
		    "DB_LOCK_DEADLOCK: Locker killed to resolve a deadlock");
	case DB_LOCK_NOTGRANTED:
		return ("DB_LOCK_NOTGRANTED: Lock not granted");
	case DB_LOCK_NOTHELD:
		return ("DB_LOCK_NOTHELD: Lock not held by locker");
	case DB_NOTFOUND:
		return ("DB_NOTFOUND: No matching key/data pair found");
	case DB_RUNRECOVERY:
		return ("DB_RUNRECOVERY: Fatal error, run database recovery");
	default:
		return "Unknown Error" ;

    }
}
#endif 	/* DB_VERSION_MAJOR == 2 */

#ifdef TRACE
#if DB_VERSION_MAJOR > 2
static char *
my_db_strerror(int err)
{
    static char buffer[1000] ;
    SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
    sprintf(buffer, "%d: %s", err, db_strerror(err)) ;
    if (err && sv) {
        strcat(buffer, ", ") ;
	strcat(buffer, SvPVX(sv)) ;
    }
    return buffer;
}
#endif
#endif

static void
close_everything(void)
{
    dTHR;
    Trace(("close_everything\n")) ;
    /* Abort All Transactions */
    {
	BerkeleyDB__Txn__Raw 	tid ;
	HE * he ;
	I32 len ;
	HV * hv = perl_get_hv("BerkeleyDB::Term::Txn", TRUE);
	int  all = 0 ;
	int  closed = 0 ;
	(void)hv_iterinit(hv) ;
	Trace(("BerkeleyDB::Term::close_all_txns dirty=%d\n", PL_dirty)) ;
	while ( (he = hv_iternext(hv)) ) {
	    tid = * (BerkeleyDB__Txn__Raw *) hv_iterkey(he, &len) ;
	    Trace(("  Aborting Transaction [%d] in [%d] Active [%d]\n", tid->txn, tid, tid->active));
	    if (tid->active) {
#ifdef AT_LEAST_DB_4
	    tid->txn->abort(tid->txn) ;
#else
	        txn_abort(tid->txn);
#endif
		++ closed ;
	    }
	    tid->active = FALSE ;
	    ++ all ;
	}
	Trace(("End of BerkeleyDB::Term::close_all_txns aborted %d of %d transactios\n",closed, all)) ;
    }

    /* Close All Cursors */
    {
	BerkeleyDB__Cursor db ;
	HE * he ;
	I32 len ;
	HV * hv = perl_get_hv("BerkeleyDB::Term::Cursor", TRUE);
	int  all = 0 ;
	int  closed = 0 ;
	(void) hv_iterinit(hv) ;
	Trace(("BerkeleyDB::Term::close_all_cursors \n")) ;
	while ( (he = hv_iternext(hv)) ) {
	    db = * (BerkeleyDB__Cursor*) hv_iterkey(he, &len) ;
	    Trace(("  Closing Cursor [%d] in [%d] Active [%d]\n", db->cursor, db, db->active));
	    if (db->active) {
    	        ((db->cursor)->c_close)(db->cursor) ;
		++ closed ;
	    }
	    db->active = FALSE ;
	    ++ all ;
	}
	Trace(("End of BerkeleyDB::Term::close_all_cursors closed %d of %d cursors\n",closed, all)) ;
    }

    /* Close All Databases */
    {
	BerkeleyDB db ;
	HE * he ;
	I32 len ;
	HV * hv = perl_get_hv("BerkeleyDB::Term::Db", TRUE);
	int  all = 0 ;
	int  closed = 0 ;
	(void)hv_iterinit(hv) ;
	Trace(("BerkeleyDB::Term::close_all_dbs\n" )) ;
	while ( (he = hv_iternext(hv)) ) {
	    db = * (BerkeleyDB*) hv_iterkey(he, &len) ;
	    Trace(("  Closing Database [%d] in [%d] Active [%d]\n", db->dbp, db, db->active));
	    if (db->active) {
	        (db->dbp->close)(db->dbp, 0) ;
		++ closed ;
	    }
	    db->active = FALSE ;
	    ++ all ;
	}
	Trace(("End of BerkeleyDB::Term::close_all_dbs closed %d of %d dbs\n",closed, all)) ;
    }

    /* Close All Environments */
    {
	BerkeleyDB__Env env ;
	HE * he ;
	I32 len ;
	HV * hv = perl_get_hv("BerkeleyDB::Term::Env", TRUE);
	int  all = 0 ;
	int  closed = 0 ;
	(void)hv_iterinit(hv) ;
	Trace(("BerkeleyDB::Term::close_all_envs\n")) ;
	while ( (he = hv_iternext(hv)) ) {
	    env = * (BerkeleyDB__Env*) hv_iterkey(he, &len) ;
	    Trace(("  Closing Environment [%d] in [%d] Active [%d]\n", env->Env, env, env->active));
	    if (env->active) {
#if DB_VERSION_MAJOR == 2
                db_appexit(env->Env) ;
#else
	        (env->Env->close)(env->Env, 0) ;
#endif
		++ closed ;
	    }
	    env->active = FALSE ;
	    ++ all ;
	}
	Trace(("End of BerkeleyDB::Term::close_all_envs closed %d of %d dbs\n",closed, all)) ;
    }

    Trace(("end close_everything\n")) ;

}

static void
destroyDB(BerkeleyDB db)
{
    dTHR;
    if (! PL_dirty && db->active) {
      	-- db->open_cursors ;
	((db->dbp)->close)(db->dbp, 0) ;
    }
    if (db->hash)
       	  SvREFCNT_dec(db->hash) ;
    if (db->compare)
       	  SvREFCNT_dec(db->compare) ;
    if (db->dup_compare)
       	  SvREFCNT_dec(db->dup_compare) ;
#ifdef AT_LEAST_DB_3_3
    if (db->associated && !db->secondary_db)
       	  SvREFCNT_dec(db->associated) ;
#endif
    if (db->prefix)
       	  SvREFCNT_dec(db->prefix) ;
#ifdef DBM_FILTERING
    if (db->filter_fetch_key)
          SvREFCNT_dec(db->filter_fetch_key) ;
    if (db->filter_store_key)
          SvREFCNT_dec(db->filter_store_key) ;
    if (db->filter_fetch_value)
          SvREFCNT_dec(db->filter_fetch_value) ;
    if (db->filter_store_value)
          SvREFCNT_dec(db->filter_store_value) ;
#endif
    hash_delete("BerkeleyDB::Term::Db", (char *)db) ;
    if (db->filename)
             Safefree(db->filename) ;
    Safefree(db) ;
}

static int
softCrash(const char *pat, ...)
{
    char buffer1 [500] ;
    char buffer2 [500] ;
    va_list args;
    va_start(args, pat);

    Trace(("softCrash: %s\n", pat)) ;

#define ABORT_PREFIX "BerkeleyDB Aborting: "

    /* buffer = (char*) safemalloc(strlen(pat) + strlen(ABORT_PREFIX) + 1) ; */
    strcpy(buffer1, ABORT_PREFIX) ;
    strcat(buffer1, pat) ;

    vsprintf(buffer2, buffer1, args) ;

    croak(buffer2);

    /* NOTREACHED */
    va_end(args);
    return 1 ;
}


static I32
GetArrayLength(BerkeleyDB db)
{
    DBT		key ;
    DBT		value ;
    int		RETVAL = 0 ;
    DBC *   	cursor ;

    DBT_clear(key) ;
    DBT_clear(value) ;
#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
    if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor) == 0 )
#else
    if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor, 0) == 0 )
#endif
    {
        RETVAL = cursor->c_get(cursor, &key, &value, DB_LAST) ;
        if (RETVAL == 0)
            RETVAL = *(I32 *)key.data ;
        else /* No key means empty file */
            RETVAL = 0 ;
        cursor->c_close(cursor) ;
    }

    Trace(("GetArrayLength got %d\n", RETVAL)) ;
    return ((I32)RETVAL) ;
}

#if 0

#define GetRecnoKey(db, value)  _GetRecnoKey(db, value)

static db_recno_t
_GetRecnoKey(BerkeleyDB db, I32 value)
{
    Trace(("GetRecnoKey start value = %d\n", value)) ;
    if (db->recno_or_queue && value < 0) {
	/* Get the length of the array */
	I32 length = GetArrayLength(db) ;

	/* check for attempt to write before start of array */
	if (length + value + RECNO_BASE <= 0)
	    softCrash("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;

	value = length + value + RECNO_BASE ;
    }
    else
        ++ value ;

    Trace(("GetRecnoKey end value = %d\n", value)) ;

    return value ;
}

#else /* ! 0 */

#if 0
#ifdef ALLOW_RECNO_OFFSET
#define GetRecnoKey(db, value) _GetRecnoKey(db, value)

static db_recno_t
_GetRecnoKey(BerkeleyDB db, I32 value)
{
    if (value + RECNO_BASE < 1)
	softCrash("key value %d < base (%d)", (value), RECNO_BASE?0:1) ;
    return value + RECNO_BASE ;
}

#else
#endif /* ALLOW_RECNO_OFFSET */
#endif /* 0 */

#define GetRecnoKey(db, value) ((value) + RECNO_BASE )

#endif /* 0 */

#if 0
static SV *
GetInternalObject(SV * sv)
{
    SV * info = (SV*) NULL ;
    SV * s ;
    MAGIC * mg ;

    Trace(("in GetInternalObject %d\n", sv)) ;
    if (sv == NULL || !SvROK(sv))
        return NULL ;

    s = SvRV(sv) ;
    if (SvMAGICAL(s))
    {
        if (SvTYPE(s) == SVt_PVHV || SvTYPE(s) == SVt_PVAV)
            mg = mg_find(s, 'P') ;
        else
            mg = mg_find(s, 'q') ;

	 /* all this testing is probably overkill, but till I know more
	    about global destruction it stays.
	 */
        /* if (mg && mg->mg_obj && SvRV(mg->mg_obj) && SvPVX(SvRV(mg->mg_obj))) */
        if (mg && mg->mg_obj && SvRV(mg->mg_obj) )
            info = SvRV(mg->mg_obj) ;
	else
	    info = s ;
    }

    Trace(("end of GetInternalObject %d\n", info)) ;
    return info ;
}
#endif

static int
btree_compare(DB_callback const DBT * key1, const DBT * key2 )
{
    dSP ;
    char * data1, * data2 ;
    int retval ;
    int count ;
    BerkeleyDB	keepDB = CurrentDB ;

    data1 = (char*) key1->data ;
    data2 = (char*) key2->data ;

#ifndef newSVpvn
    /* As newSVpv will assume that the data pointer is a null terminated C
       string if the size parameter is 0, make sure that data points to an
       empty string if the length is 0
    */
    if (key1->size == 0)
        data1 = "" ;
    if (key2->size == 0)
        data2 = "" ;
#endif

    ENTER ;
    SAVETMPS;

    PUSHMARK(SP) ;
    EXTEND(SP,2) ;
    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
    PUTBACK ;

    count = perl_call_sv(CurrentDB->compare, G_SCALAR);

    SPAGAIN ;

    if (count != 1)
        softCrash ("in btree_compare - expected 1 return value from compare sub, got %d", count) ;

    retval = POPi ;

    PUTBACK ;
    FREETMPS ;
    LEAVE ;
    CurrentDB = keepDB ;
    return (retval) ;

}

static int
dup_compare(DB_callback const DBT * key1, const DBT * key2 )
{
    dSP ;
    char * data1, * data2 ;
    int retval ;
    int count ;
    BerkeleyDB	keepDB = CurrentDB ;

    Trace(("In dup_compare \n")) ;
    if (!CurrentDB)
	softCrash("Internal Error - No CurrentDB in dup_compare") ;
    if (CurrentDB->dup_compare == NULL)
        softCrash("in dup_compare: no callback specified for database '%s'", CurrentDB->filename) ;

    data1 = (char*) key1->data ;
    data2 = (char*) key2->data ;

#ifndef newSVpvn
    /* As newSVpv will assume that the data pointer is a null terminated C
       string if the size parameter is 0, make sure that data points to an
       empty string if the length is 0
    */
    if (key1->size == 0)
        data1 = "" ;
    if (key2->size == 0)
        data2 = "" ;
#endif

    ENTER ;
    SAVETMPS;

    PUSHMARK(SP) ;
    EXTEND(SP,2) ;
    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
    PUTBACK ;

    count = perl_call_sv(CurrentDB->dup_compare, G_SCALAR);

    SPAGAIN ;

    if (count != 1)
        softCrash ("dup_compare: expected 1 return value from compare sub, got %d", count) ;

    retval = POPi ;

    PUTBACK ;
    FREETMPS ;
    LEAVE ;
    CurrentDB = keepDB ;
    return (retval) ;

}

static size_t
btree_prefix(DB_callback const DBT * key1, const DBT * key2 )
{
    dSP ;
    char * data1, * data2 ;
    int retval ;
    int count ;
    BerkeleyDB	keepDB = CurrentDB ;

    data1 = (char*) key1->data ;
    data2 = (char*) key2->data ;

#ifndef newSVpvn
    /* As newSVpv will assume that the data pointer is a null terminated C
       string if the size parameter is 0, make sure that data points to an
       empty string if the length is 0
    */
    if (key1->size == 0)
        data1 = "" ;
    if (key2->size == 0)
        data2 = "" ;
#endif

    ENTER ;
    SAVETMPS;

    PUSHMARK(SP) ;
    EXTEND(SP,2) ;
    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
    PUTBACK ;

    count = perl_call_sv(CurrentDB->prefix, G_SCALAR);

    SPAGAIN ;

    if (count != 1)
        softCrash ("btree_prefix: expected 1 return value from prefix sub, got %d", count) ;

    retval = POPi ;

    PUTBACK ;
    FREETMPS ;
    LEAVE ;
    CurrentDB = keepDB ;

    return (retval) ;
}

static u_int32_t
hash_cb(DB_callback const void * data, u_int32_t size)
{
    dSP ;
    int retval ;
    int count ;
    BerkeleyDB	keepDB = CurrentDB ;

#ifndef newSVpvn
    if (size == 0)
        data = "" ;
#endif

    ENTER ;
    SAVETMPS;

    PUSHMARK(SP) ;

    XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
    PUTBACK ;

    count = perl_call_sv(CurrentDB->hash, G_SCALAR);

    SPAGAIN ;

    if (count != 1)
        softCrash ("hash_cb: expected 1 return value from hash sub, got %d", count) ;

    retval = POPi ;

    PUTBACK ;
    FREETMPS ;
    LEAVE ;
    CurrentDB = keepDB ;

    return (retval) ;
}

#ifdef AT_LEAST_DB_3_3

static int
associate_cb(DB_callback const DBT * pkey, const DBT * pdata, DBT * skey)
{
    dSP ;
    char * pk_dat, * pd_dat, *sk_dat ;
    int retval ;
    int count ;
    SV * skey_SV ;

    Trace(("In associate_cb \n")) ;
    if (((BerkeleyDB)db->BackRef)->associated == NULL){
        Trace(("No Callback registered\n")) ;
        return EINVAL ;
    }

    skey_SV = newSVpv("",0);


    pk_dat = (char*) pkey->data ;
    pd_dat = (char*) pdata->data ;

#ifndef newSVpvn
    /* As newSVpv will assume that the data pointer is a null terminated C
       string if the size parameter is 0, make sure that data points to an
       empty string if the length is 0
    */
    if (pkey->size == 0)
        pk_dat = "" ;
    if (pdata->size == 0)
        pd_dat = "" ;
#endif

    ENTER ;
    SAVETMPS;

    PUSHMARK(SP) ;
    EXTEND(SP,2) ;
    PUSHs(sv_2mortal(newSVpvn(pk_dat,pkey->size)));
    PUSHs(sv_2mortal(newSVpvn(pd_dat,pdata->size)));
    PUSHs(sv_2mortal(skey_SV));
    PUTBACK ;

    Trace(("calling associated cb\n"));
    count = perl_call_sv(((BerkeleyDB)db->BackRef)->associated, G_SCALAR);
    Trace(("called associated cb\n"));

    SPAGAIN ;

    if (count != 1)
        softCrash ("associate: expected 1 return value from prefix sub, got %d", count) ;

    retval = POPi ;

    PUTBACK ;
    
    /* retrieve the secondary key */
    DBT_clear(*skey);
    skey->flags = DB_DBT_APPMALLOC;
    skey->size = SvCUR(skey_SV);
    skey->data = (char*)safemalloc(skey->size);
    memcpy(skey->data, SvPVX(skey_SV), skey->size);
    Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));

    FREETMPS ;
    LEAVE ;

    return (retval) ;
}

#endif /* AT_LEAST_DB_3_3 */

static void
db_errcall_cb(const char * db_errpfx, char * buffer)
{
#if 0

    if (db_errpfx == NULL)
	db_errpfx = "" ;
    if (buffer == NULL )
	buffer = "" ;
    ErrBuff[0] = '\0';
    if (strlen(db_errpfx) + strlen(buffer) + 3 <= 1000) {
	if (*db_errpfx != '\0') {
	    strcat(ErrBuff, db_errpfx) ;
	    strcat(ErrBuff, ": ") ;
	}
	strcat(ErrBuff, buffer) ;
    }

#endif

    SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
    if (sv) {
        if (db_errpfx)
	    sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ;
        else
            sv_setpv(sv, buffer) ;
    }
}

static SV *
readHash(HV * hash, char * key)
{
    SV **       svp;
    svp = hv_fetch(hash, key, strlen(key), FALSE);
    if (svp && SvOK(*svp))
        return *svp ;
    return NULL ;
}

static void
hash_delete(char * hash, char * key)
{
    HV * hv = perl_get_hv(hash, TRUE);
    (void) hv_delete(hv, (char*)&key, sizeof(key), G_DISCARD);
}

static void
hash_store_iv(char * hash, char * key, IV value)
{
    HV * hv = perl_get_hv(hash, TRUE);
    (void)hv_store(hv, (char*)&key, sizeof(key), newSViv(value), 0);
    /* printf("hv_store returned %d\n", ret) ; */
}

static void
hv_store_iv(HV * hash, char * key, IV value)
{
    hv_store(hash, key, strlen(key), newSViv(value), 0);
}

static BerkeleyDB
my_db_open(
		BerkeleyDB	db ,
		SV * 		ref,
		SV *		ref_dbenv ,
		BerkeleyDB__Env	dbenv ,
    	    	BerkeleyDB__Txn txn, 
		const char *	file,
		const char *	subname,
		DBTYPE		type,
		int		flags,
		int		mode,
		DB_INFO * 	info
	)
{
    DB_ENV *	env    = NULL ;
    BerkeleyDB 	RETVAL = NULL ;
    DB *	dbp ;
    int		Status ;
    DB_TXN* 	txnid = NULL ;

    Trace(("_db_open(dbenv[%p] ref_dbenv [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n",
		dbenv, ref_dbenv, file, subname, type, flags, mode)) ;

    CurrentDB = db ;
    if (dbenv)
	env = dbenv->Env ;

    if (txn)
        txnid = txn->txn;

    Trace(("_db_open(dbenv[%p] ref_dbenv [%p] txn [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n",
		dbenv, ref_dbenv, txn, file, subname, type, flags, mode)) ;

#if DB_VERSION_MAJOR == 2
    if (subname)
        softCrash("Subname needs Berkeley DB 3 or better") ;
#endif

#if DB_VERSION_MAJOR > 2
    Status = db_create(&dbp, env, 0) ;
    Trace(("db_create returned %s\n", my_db_strerror(Status))) ;
    if (Status)
        return RETVAL ;

#ifdef AT_LEAST_DB_3_3
    if (! env) {
	dbp->set_alloc(dbp, safemalloc, MyRealloc, safefree) ;
	dbp->set_errcall(dbp, db_errcall_cb) ;
    }
#endif

    if (info->re_source) {
        Status = dbp->set_re_source(dbp, info->re_source) ;
	Trace(("set_re_source [%s] returned %s\n",
		info->re_source, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->db_cachesize) {
        Status = dbp->set_cachesize(dbp, 0, info->db_cachesize, 0) ;
	Trace(("set_cachesize [%d] returned %s\n",
		info->db_cachesize, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->db_lorder) {
        Status = dbp->set_lorder(dbp, info->db_lorder) ;
	Trace(("set_lorder [%d] returned %s\n",
		info->db_lorder, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->db_pagesize) {
        Status = dbp->set_pagesize(dbp, info->db_pagesize) ;
	Trace(("set_pagesize [%d] returned %s\n",
		info->db_pagesize, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->h_ffactor) {
        Status = dbp->set_h_ffactor(dbp, info->h_ffactor) ;
	Trace(("set_h_ffactor [%d] returned %s\n",
		info->h_ffactor, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->h_nelem) {
        Status = dbp->set_h_nelem(dbp, info->h_nelem) ;
	Trace(("set_h_nelem [%d] returned %s\n",
		info->h_nelem, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->bt_minkey) {
        Status = dbp->set_bt_minkey(dbp, info->bt_minkey) ;
	Trace(("set_bt_minkey [%d] returned %s\n",
		info->bt_minkey, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->bt_compare) {
        Status = dbp->set_bt_compare(dbp, info->bt_compare) ;
	Trace(("set_bt_compare [%p] returned %s\n",
		info->bt_compare, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->h_hash) {
        Status = dbp->set_h_hash(dbp, info->h_hash) ;
	Trace(("set_h_hash [%d] returned %s\n",
		info->h_hash, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->dup_compare) {
        Status = dbp->set_dup_compare(dbp, info->dup_compare) ;
	Trace(("set_dup_compare [%d] returned %s\n",
		info->dup_compare, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->bt_prefix) {
        Status = dbp->set_bt_prefix(dbp, info->bt_prefix) ;
	Trace(("set_bt_prefix [%d] returned %s\n",
		info->bt_prefix, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->re_len) {
        Status = dbp->set_re_len(dbp, info->re_len) ;
	Trace(("set_re_len [%d] returned %s\n",
		info->re_len, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->re_delim) {
        Status = dbp->set_re_delim(dbp, info->re_delim) ;
	Trace(("set_re_delim [%d] returned %s\n",
		info->re_delim, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->re_pad) {
        Status = dbp->set_re_pad(dbp, info->re_pad) ;
	Trace(("set_re_pad [%d] returned %s\n",
		info->re_pad, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->flags) {
        Status = dbp->set_flags(dbp, info->flags) ;
	Trace(("set_flags [%d] returned %s\n",
		info->flags, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
    }

    if (info->q_extentsize) {
#ifdef AT_LEAST_DB_3_2
        Status = dbp->set_q_extentsize(dbp, info->q_extentsize) ;
	Trace(("set_flags [%d] returned %s\n",
		info->flags, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
#else
        softCrash("-ExtentSize needs at least Berkeley DB 3.2.x") ;
#endif
    }

#ifdef AT_LEAST_DB_4_1
    if ((Status = (dbp->open)(dbp, txnid, file, subname, type, flags, mode)) == 0) {
#else
    if ((Status = (dbp->open)(dbp, file, subname, type, flags, mode)) == 0) {
#endif /* AT_LEAST_DB_4_1 */
#else /* DB_VERSION_MAJOR == 2 */
    if ((Status = db_open(file, type, flags, mode, env, info, &dbp)) == 0) {
#endif /* DB_VERSION_MAJOR == 2 */

	Trace(("db_opened ok\n"));
#ifdef AT_LEAST_DB_3_3
	dbp->BackRef = db;
#endif
	RETVAL = db ;
	RETVAL->dbp  = dbp ;
	RETVAL->txn  = txnid ;
#if DB_VERSION_MAJOR == 2
    	RETVAL->type = dbp->type ;
#else /* DB_VERSION_MAJOR > 2 */
#ifdef AT_LEAST_DB_3_3
    	dbp->get_type(dbp, &RETVAL->type) ;
#else /* DB 3.0 -> 3.2 */
    	RETVAL->type = dbp->get_type(dbp) ;
#endif
#endif /* DB_VERSION_MAJOR > 2 */
    	RETVAL->recno_or_queue = (RETVAL->type == DB_RECNO ||
	                          RETVAL->type == DB_QUEUE) ;
	RETVAL->filename = my_strdup(file) ;
	RETVAL->Status = Status ;
	RETVAL->active = TRUE ;
	hash_store_iv("BerkeleyDB::Term::Db", (char *)RETVAL, 1) ;
	Trace(("  storing %p %p in BerkeleyDB::Term::Db\n", RETVAL, dbp)) ;
	if (dbenv) {
	    RETVAL->parent_env = dbenv ;
	    dbenv->Status = Status ;
	    ++ dbenv->open_dbs ;
	}
    }
    else {
#if DB_VERSION_MAJOR > 2
	(dbp->close)(dbp, 0) ;
#endif
	destroyDB(db) ;
        Trace(("db open returned %s\n", my_db_strerror(Status))) ;
    }

    return RETVAL ;
}


#include "constants.h"

MODULE = BerkeleyDB		PACKAGE = BerkeleyDB	PREFIX = env_

INCLUDE: constants.xs

#define env_db_version(maj, min, patch) 	db_version(&maj, &min, &patch)
char *
env_db_version(maj, min, patch)
	int  maj
	int  min
	int  patch
	OUTPUT:
	  RETVAL
	  maj
	  min
	  patch

int
db_value_set(value, which)
	int value
	int which
        NOT_IMPLEMENTED_YET


DualType
_db_remove(ref)
	SV * 		ref
	CODE:
	{
#if DB_VERSION_MAJOR == 2
	    softCrash("BerkeleyDB::db_remove needs Berkeley DB 3.x or better") ;
#else
	    HV *		hash ;
    	    DB *		dbp ;
	    SV * 		sv ;
	    const char *	db = NULL ;
	    const char *	subdb 	= NULL ;
	    BerkeleyDB__Env	env 	= NULL ;
    	    DB_ENV *		dbenv   = NULL ;
	    u_int32_t		flags	= 0 ;

	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(db,    "Filename", char *) ;
	    SetValue_pv(subdb, "Subname", char *) ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_ov(env, "Env", BerkeleyDB__Env) ;
    	    if (env)
		dbenv = env->Env ;
            RETVAL = db_create(&dbp, dbenv, 0) ;
	    if (RETVAL == 0) {
	        RETVAL = dbp->remove(dbp, db, subdb, flags) ;
	    }
#endif
	}
	OUTPUT:
	    RETVAL

DualType
_db_verify(ref)
	SV * 		ref
	CODE:
	{
#ifndef AT_LEAST_DB_3_1
	    softCrash("BerkeleyDB::db_verify needs Berkeley DB 3.1.x or better") ;
#else
	    HV *		hash ;
    	    DB *		dbp ;
	    SV * 		sv ;
	    const char *	db = NULL ;
	    const char *	subdb 	= NULL ;
	    const char *	outfile	= NULL ;
	    FILE *		ofh = NULL;
	    BerkeleyDB__Env	env 	= NULL ;
    	    DB_ENV *		dbenv   = NULL ;
	    u_int32_t		flags	= 0 ;

	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(db,    "Filename", char *) ;
	    SetValue_pv(subdb, "Subname", char *) ;
	    SetValue_pv(outfile, "Outfile", char *) ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_ov(env, "Env", BerkeleyDB__Env) ;
            RETVAL = 0;
            if (outfile){
	        ofh = fopen(outfile, "w");
                if (! ofh)
                    RETVAL = errno;
            }
            if (! RETVAL) {
    	        if (env)
		    dbenv = env->Env ;
                RETVAL = db_create(&dbp, dbenv, 0) ;
	        if (RETVAL == 0) {
	            RETVAL = dbp->verify(dbp, db, subdb, ofh, flags) ;
	        }
	        if (outfile) 
                    fclose(ofh);
            }
#endif
	}
	OUTPUT:
	    RETVAL

DualType
_db_rename(ref)
	SV * 		ref
	CODE:
	{
#ifndef AT_LEAST_DB_3_1
	    softCrash("BerkeleyDB::db_rename needs Berkeley DB 3.1.x or better") ;
#else
	    HV *		hash ;
    	    DB *		dbp ;
	    SV * 		sv ;
	    const char *	db = NULL ;
	    const char *	subdb 	= NULL ;
	    const char *	newname	= NULL ;
	    BerkeleyDB__Env	env 	= NULL ;
    	    DB_ENV *		dbenv   = NULL ;
	    u_int32_t		flags	= 0 ;

	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(db,    "Filename", char *) ;
	    SetValue_pv(subdb, "Subname", char *) ;
	    SetValue_pv(newname, "Newname", char *) ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_ov(env, "Env", BerkeleyDB__Env) ;
    	    if (env)
		dbenv = env->Env ;
            RETVAL = db_create(&dbp, dbenv, 0) ;
	    if (RETVAL == 0) {
	        RETVAL = dbp->rename(dbp, db, subdb, newname, flags) ;
	    }
#endif
	}
	OUTPUT:
	    RETVAL

MODULE = BerkeleyDB::Env		PACKAGE = BerkeleyDB::Env PREFIX = env_


BerkeleyDB::Env::Raw
_db_appinit(self, ref)
	char *		self
	SV * 		ref
	CODE:
	{
	    HV *	hash ;
	    SV *	sv ;
	    char *	home = NULL ;
	    char *	errfile = NULL ;
	    char * 	server = NULL ;
	    char **	config = NULL ;
	    int		flags = 0 ;
	    int		setflags = 0 ;
	    int		cachesize = 0 ;
	    int		lk_detect = 0 ;
	    SV *	errprefix = NULL;
	    DB_ENV *	env ;
	    int status ;

	    Trace(("in _db_appinit [%s] %d\n", self, ref)) ;
	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(home,      "Home", char *) ;
	    SetValue_pv(config,    "Config", char **) ;
	    SetValue_sv(errprefix, "ErrPrefix") ;
	    SetValue_iv(flags,     "Flags") ;
	    SetValue_iv(setflags,  "SetFlags") ;
	    SetValue_pv(server,    "Server", char *) ;
	    SetValue_iv(cachesize, "Cachesize") ;
	    SetValue_iv(lk_detect, "LockDetect") ;
#ifndef AT_LEAST_DB_3_2
	    if (setflags)
	        softCrash("-SetFlags needs Berkeley DB 3.x or better") ;
#endif /* ! AT_LEAST_DB_3 */
#ifndef AT_LEAST_DB_3_1
	    if (server)
	        softCrash("-Server needs Berkeley DB 3.1 or better") ;
#endif /* ! AT_LEAST_DB_3_1 */
	    Trace(("_db_appinit(config=[%d], home=[%s],errprefix=[%s],flags=[%d]\n",
			config, home, errprefix, flags)) ;
#ifdef TRACE
	    if (config) {
	       int i ;
	      for (i = 0 ; i < 10 ; ++ i) {
		if (config[i] == NULL) {
		    printf("    End\n") ;
		    break ;
		}
	        printf("    config = [%s]\n", config[i]) ;
	      }
	    }
#endif /* TRACE */
	    ZMALLOC(RETVAL, BerkeleyDB_ENV_type) ;
	    if (flags & DB_INIT_TXN)
	        RETVAL->txn_enabled = TRUE ;
#if DB_VERSION_MAJOR == 2
	  ZMALLOC(RETVAL->Env, DB_ENV) ;
	  env = RETVAL->Env ;
	  {
	    /* Take a copy of the error prefix */
	    if (errprefix) {
	        Trace(("copying errprefix\n" )) ;
		RETVAL->ErrPrefix = newSVsv(errprefix) ;
		SvPOK_only(RETVAL->ErrPrefix) ;
	    }
	    if (RETVAL->ErrPrefix)
	        RETVAL->Env->db_errpfx = SvPVX(RETVAL->ErrPrefix) ;

	    SetValue_pv(errfile,      "ErrFile", char *) ;
	    if (errfile) {
	    	RETVAL->ErrHandle = env->db_errfile = fopen(errfile, "w");
	    	if (RETVAL->ErrHandle == NULL)
		    croak("Cannot open file %s: %s\n", errfile,  Strerror(errno));
	    }
	    SetValue_iv(env->db_verbose, "Verbose") ;
	    env->db_errcall = db_errcall_cb ;
	    RETVAL->active = TRUE ;
	    status = db_appinit(home, config, env, flags) ;
	    Trace(("  status = %d env %d Env %d\n", status, RETVAL, env)) ;
	    if (status == 0)
	        hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ;
	    else {
                if (RETVAL->ErrHandle)
                    fclose(RETVAL->ErrHandle) ;
                if (RETVAL->ErrPrefix)
                    SvREFCNT_dec(RETVAL->ErrPrefix) ;
                Safefree(RETVAL->Env) ;
                Safefree(RETVAL) ;
		RETVAL = NULL ;
	    }
	  }
#else /* DB_VERSION_MAJOR > 2 */
#ifndef AT_LEAST_DB_3_1
#    define DB_CLIENT	0
#endif
	  status = db_env_create(&RETVAL->Env, server ? DB_CLIENT : 0) ;
	  Trace(("db_env_create flags = %d returned %s\n", flags,
	  					my_db_strerror(status))) ;
	  env = RETVAL->Env ;
#ifdef AT_LEAST_DB_3_3
	  env->set_alloc(env, safemalloc, MyRealloc, safefree) ;
#endif
	  if (status == 0 && cachesize) {
	      status = env->set_cachesize(env, 0, cachesize, 0) ;
	      Trace(("set_cachesize [%d] returned %s\n",
			cachesize, my_db_strerror(status)));
	  }
	
	  if (status == 0 && lk_detect) {
	      status = env->set_lk_detect(env, lk_detect) ;
	      Trace(("set_lk_detect [%d] returned %s\n",
	              lk_detect, my_db_strerror(status)));
	  }
#ifdef AT_LEAST_DB_4
	  /* set the server */
	  if (server && status == 0)
	  {
	      status = env->set_rpc_server(env, NULL, server, 0, 0, 0);
	      Trace(("ENV->set_rpc_server server = %s returned %s\n", server,
	  					my_db_strerror(status))) ;
	  }
#else
#  if defined(AT_LEAST_DB_3_1) && ! defined(AT_LEAST_DB_4)
	  /* set the server */
	  if (server && status == 0)
	  {
	      status = env->set_server(env, server, 0, 0, 0);
	      Trace(("ENV->set_server server = %s returned %s\n", server,
	  					my_db_strerror(status))) ;
	  }
#  endif
#endif
#ifdef AT_LEAST_DB_3_2
	  if (setflags && status == 0)
	  {
	      status = env->set_flags(env, setflags, 1);
	      Trace(("ENV->set_flags value = %d returned %s\n", setflags,
	  					my_db_strerror(status))) ;
	  }
#endif
	  if (status == 0)
	  {
	    int		mode = 0 ;
	    /* Take a copy of the error prefix */
	    if (errprefix) {
	        Trace(("copying errprefix\n" )) ;
		RETVAL->ErrPrefix = newSVsv(errprefix) ;
		SvPOK_only(RETVAL->ErrPrefix) ;
	    }
	    if (RETVAL->ErrPrefix)
	        env->set_errpfx(env, SvPVX(RETVAL->ErrPrefix)) ;

	    SetValue_pv(errfile,      "ErrFile", char *) ;
	    if (errfile) {
	    	RETVAL->ErrHandle = fopen(errfile, "w");
	    	if (RETVAL->ErrHandle == NULL)
		    croak("Cannot open file %s: %s\n", errfile,  Strerror(errno));
	    	env->set_errfile(env, RETVAL->ErrHandle) ;
	    }

	    SetValue_iv(mode, "Mode") ;
	    env->set_errcall(env, db_errcall_cb) ;
	    RETVAL->active = TRUE ;
#ifdef IS_DB_3_0_x
	    status = (env->open)(env, home, config, flags, mode) ;
#else /* > 3.0 */
	    status = (env->open)(env, home, flags, mode) ;
#endif
	    Trace(("ENV->open returned %s\n", my_db_strerror(status))) ;
	  }

	  if (status == 0)
	      hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ;
	  else {
	      (env->close)(env, 0) ;
              if (RETVAL->ErrHandle)
                  fclose(RETVAL->ErrHandle) ;
              if (RETVAL->ErrPrefix)
                  SvREFCNT_dec(RETVAL->ErrPrefix) ;
              Safefree(RETVAL) ;
	      RETVAL = NULL ;
	  }
#endif /* DB_VERSION_MAJOR > 2 */
	}
	OUTPUT:
	    RETVAL

void
log_archive(env, flags=0)
	u_int32_t		flags
	BerkeleyDB::Env		env
	PPCODE:
	{
	  char ** list;
	  char ** file;
	  AV    * av;
#ifndef AT_LEAST_DB_3
          softCrash("log_archive needs at least Berkeley DB 3.x.x");
#else
#  ifdef AT_LEAST_DB_4
	  env->Status = env->Env->log_archive(env->Env, &list, flags) ;
#  else
#    ifdef AT_LEAST_DB_3_3
	  env->Status = log_archive(env->Env, &list, flags) ;
#    else
	  env->Status = log_archive(env->Env, &list, flags, safemalloc) ;
#    endif
#  endif
	  if (env->Status == 0 && list != NULL)
          {
	      for (file = list; *file != NULL; ++file)
	      {
	        XPUSHs(sv_2mortal(newSVpv(*file, 0))) ;
	      }
	      safefree(list);
	  }
#endif
	}

BerkeleyDB::Txn::Raw
_txn_begin(env, pid=NULL, flags=0)
	u_int32_t		flags
	BerkeleyDB::Env		env
	BerkeleyDB::Txn		pid
	CODE:
	{
	    DB_TXN *txn ;
	    DB_TXN *p_id = NULL ;
	    Trace(("txn_begin pid %d, flags %d\n", pid, flags)) ;
#if DB_VERSION_MAJOR == 2
	    if (env->Env->tx_info == NULL)
		softCrash("Transaction Manager not enabled") ;
#endif
	    if (!env->txn_enabled)
		softCrash("Transaction Manager not enabled") ;
	    if (pid)
		p_id = pid->txn ;
	    env->TxnMgrStatus =
#if DB_VERSION_MAJOR == 2
	    	txn_begin(env->Env->tx_info, p_id, &txn) ;
#else
#  ifdef AT_LEAST_DB_4
	    	env->Env->txn_begin(env->Env, p_id, &txn, flags) ;
#  else
	    	txn_begin(env->Env, p_id, &txn, flags) ;
#  endif
#endif
	    if (env->TxnMgrStatus == 0) {
	      ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ;
	      RETVAL->txn  = txn ;
	      RETVAL->active = TRUE ;
	      Trace(("_txn_begin created txn [%p] in [%p]\n", txn, RETVAL));
	      hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ;
	    }
	    else
		RETVAL = NULL ;
	}
	OUTPUT:
	    RETVAL


#if DB_VERSION_MAJOR == 2
#  define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env->tx_info, k, m)
#else /* DB 3.0 or better */
#  ifdef AT_LEAST_DB_4 
#    define env_txn_checkpoint(e,k,m,f) e->Env->txn_checkpoint(e->Env, k, m, f)
#  else
#    ifdef AT_LEAST_DB_3_1
#      define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m, 0)
#    else
#      define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m)
#    endif
#  endif
#endif
DualType
env_txn_checkpoint(env, kbyte, min, flags=0)
	BerkeleyDB::Env		env
	long			kbyte
	long			min
	u_int32_t		flags

HV *
txn_stat(env)
	BerkeleyDB::Env		env
	HV *			RETVAL = NULL ;
	CODE:
	{
	    DB_TXN_STAT *	stat ;
#ifdef AT_LEAST_DB_4
	    if(env->Env->txn_stat(env->Env, &stat, 0) == 0) {
#else
#  ifdef AT_LEAST_DB_3_3
	    if(txn_stat(env->Env, &stat) == 0) {
#  else
#    if DB_VERSION_MAJOR == 2
	    if(txn_stat(env->Env->tx_info, &stat, safemalloc) == 0) {
#    else
	    if(txn_stat(env->Env, &stat, safemalloc) == 0) {
#    endif
#  endif
#endif
	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
		hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ;
		hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ;
		hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ;
		hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ;
		hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ;
		hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ;
		hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ;
#if DB_VERSION_MAJOR > 2
		hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ;
		hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ;
		hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ;
		hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ;
#endif
		safefree(stat) ;
	    }
	}
	OUTPUT:
	    RETVAL

#define EnDis(x)	((x) ? "Enabled" : "Disabled")
void
printEnv(env)
        BerkeleyDB::Env  env
	INIT:
	    ckActive_Environment(env->active) ;
	CODE:
#if 0
	  printf("env             [0x%X]\n", env) ;
	  printf("  ErrPrefix     [%s]\n", env->ErrPrefix
				           ? SvPVX(env->ErrPrefix) : 0) ;
	  printf("  DB_ENV\n") ;
	  printf("    db_lorder   [%d]\n", env->Env.db_lorder) ;
	  printf("    db_home     [%s]\n", env->Env.db_home) ;
	  printf("    db_data_dir [%s]\n", env->Env.db_data_dir) ;
	  printf("    db_log_dir  [%s]\n", env->Env.db_log_dir) ;
	  printf("    db_tmp_dir  [%s]\n", env->Env.db_tmp_dir) ;
	  printf("    lk_info     [%s]\n", EnDis(env->Env.lk_info)) ;
	  printf("    lk_max      [%d]\n", env->Env.lk_max) ;
	  printf("    lg_info     [%s]\n", EnDis(env->Env.lg_info)) ;
	  printf("    lg_max      [%d]\n", env->Env.lg_max) ;
	  printf("    mp_info     [%s]\n", EnDis(env->Env.mp_info)) ;
	  printf("    mp_size     [%d]\n", env->Env.mp_size) ;
	  printf("    tx_info     [%s]\n", EnDis(env->Env.tx_info)) ;
	  printf("    tx_max      [%d]\n", env->Env.tx_max) ;
	  printf("    flags       [%d]\n", env->Env.flags) ;
	  printf("\n") ;
#endif

SV *
errPrefix(env, prefix)
        BerkeleyDB::Env  env
	SV * 		 prefix
	INIT:
	    ckActive_Environment(env->active) ;
	CODE:
	  if (env->ErrPrefix) {
	      RETVAL = newSVsv(env->ErrPrefix) ;
              SvPOK_only(RETVAL) ;
	      sv_setsv(env->ErrPrefix, prefix) ;
	  }
	  else {
	      RETVAL = NULL ;
	      env->ErrPrefix = newSVsv(prefix) ;
	  }
	  SvPOK_only(env->ErrPrefix) ;
#if DB_VERSION_MAJOR == 2
	  env->Env->db_errpfx = SvPVX(env->ErrPrefix) ;
#else
	  env->Env->set_errpfx(env->Env, SvPVX(env->ErrPrefix)) ;
#endif
	OUTPUT:
	  RETVAL

DualType
status(env)
        BerkeleyDB::Env 	env
	CODE:
	    RETVAL =  env->Status ;
	OUTPUT:
	    RETVAL

DualType
db_appexit(env)
        BerkeleyDB::Env 	env
	ALIAS:	close =1
	INIT:
	    ckActive_Environment(env->active) ;
	CODE:
#ifdef STRICT_CLOSE
	    if (env->open_dbs)
		softCrash("attempted to close an environment with %d open database(s)",
			env->open_dbs) ;
#endif /* STRICT_CLOSE */
#if DB_VERSION_MAJOR == 2
	    RETVAL = db_appexit(env->Env) ;
#else
	    RETVAL = (env->Env->close)(env->Env, 0) ;
#endif
	    env->active = FALSE ;
	    hash_delete("BerkeleyDB::Term::Env", (char *)env) ;
	OUTPUT:
	    RETVAL


void
_DESTROY(env)
        BerkeleyDB::Env  env
	int RETVAL = 0 ;
	CODE:
	  Trace(("In BerkeleyDB::Env::DESTROY\n"));
	  Trace(("    env %ld Env %ld dirty %d\n", env, &env->Env, PL_dirty)) ;
	  if (env->active)
#if DB_VERSION_MAJOR == 2
              db_appexit(env->Env) ;
#else
	      (env->Env->close)(env->Env, 0) ;
#endif
          if (env->ErrHandle)
              fclose(env->ErrHandle) ;
          if (env->ErrPrefix)
              SvREFCNT_dec(env->ErrPrefix) ;
#if DB_VERSION_MAJOR == 2
          Safefree(env->Env) ;
#endif
          Safefree(env) ;
	  hash_delete("BerkeleyDB::Term::Env", (char *)env) ;
	  Trace(("End of BerkeleyDB::Env::DESTROY %d\n", RETVAL)) ;

BerkeleyDB::TxnMgr::Raw
_TxnMgr(env)
        BerkeleyDB::Env  env
	INIT:
	    ckActive_Environment(env->active) ;
	    if (!env->txn_enabled)
		softCrash("Transaction Manager not enabled") ;
	CODE:
	    ZMALLOC(RETVAL, BerkeleyDB_TxnMgr_type) ;
	    RETVAL->env  = env ;
	    /* hash_store_iv("BerkeleyDB::Term::TxnMgr", (char *)txn, 1) ; */
	OUTPUT:
	    RETVAL

int
set_lg_dir(env, dir)
        BerkeleyDB::Env  env
	char *		 dir
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3_1
	    softCrash("$env->set_lg_dir needs Berkeley DB 3.1 or better") ;
#else
	    RETVAL = env->Status = env->Env->set_lg_dir(env->Env, dir);
#endif
	OUTPUT:
	    RETVAL

int
set_lg_bsize(env, bsize)
        BerkeleyDB::Env  env
	u_int32_t	 bsize
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3
	    softCrash("$env->set_lg_bsize needs Berkeley DB 3.0.55 or better") ;
#else
	    RETVAL = env->Status = env->Env->set_lg_bsize(env->Env, bsize);
#endif
	OUTPUT:
	    RETVAL

int
set_lg_max(env, lg_max)
        BerkeleyDB::Env  env
	u_int32_t	 lg_max
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3
	    softCrash("$env->set_lg_max needs Berkeley DB 3.0.55 or better") ;
#else
	    RETVAL = env->Status = env->Env->set_lg_max(env->Env, lg_max);
#endif
	OUTPUT:
	    RETVAL

int
set_data_dir(env, dir)
        BerkeleyDB::Env  env
	char *		 dir
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3_1
	    softCrash("$env->set_data_dir needs Berkeley DB 3.1 or better") ;
#else
	    RETVAL = env->Status = env->Env->set_data_dir(env->Env, dir);
#endif
	OUTPUT:
	    RETVAL

int
set_tmp_dir(env, dir)
        BerkeleyDB::Env  env
	char *		 dir
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3_1
	    softCrash("$env->set_tmp_dir needs Berkeley DB 3.1 or better") ;
#else
	    RETVAL = env->Status = env->Env->set_tmp_dir(env->Env, dir);
#endif
	OUTPUT:
	    RETVAL

int
set_mutexlocks(env, do_lock)
        BerkeleyDB::Env  env
	int 		 do_lock
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3
	    softCrash("$env->set_setmutexlocks needs Berkeley DB 3.0 or better") ;
#else
#  ifdef AT_LEAST_DB_4
	    RETVAL = env->Status = env->Env->set_flags(env->Env, DB_NOLOCKING, do_lock);
#  else
#    if defined(AT_LEAST_DB_3_2_6) || defined(IS_DB_3_0_x)
	    RETVAL = env->Status = env->Env->set_mutexlocks(env->Env, do_lock);
#    else /* DB 3.1 or 3.2.3 */
	    RETVAL = env->Status = db_env_set_mutexlocks(do_lock);
#    endif
#  endif
#endif
	OUTPUT:
	    RETVAL

int
set_verbose(env, which, onoff)
        BerkeleyDB::Env  env
	u_int32_t	 which
	int	 	 onoff
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3
	    softCrash("$env->set_verbose needs Berkeley DB 3.x or better") ;
#else
	    RETVAL = env->Status = env->Env->set_verbose(env->Env, which, onoff);
#endif
	OUTPUT:
	    RETVAL

int
set_flags(env, flags, onoff)
        BerkeleyDB::Env  env
	u_int32_t	 flags
	int	 	 onoff
	INIT:
	  ckActive_Database(env->active) ;
	CODE:
#ifndef AT_LEAST_DB_3_2
	    softCrash("$env->set_flags needs Berkeley DB 3.2.x or better") ;
#else
	    RETVAL = env->Status = env->Env->set_flags(env->Env, flags, onoff);
#endif
	OUTPUT:
	    RETVAL


MODULE = BerkeleyDB::Term		PACKAGE = BerkeleyDB::Term

void
close_everything()

#define safeCroak(string)	softCrash(string)
void
safeCroak(string)
	char * string

MODULE = BerkeleyDB::Hash	PACKAGE = BerkeleyDB::Hash	PREFIX = hash_

BerkeleyDB::Hash::Raw
_db_open_hash(self, ref)
	char *		self
	SV * 		ref
	CODE:
	{
	    HV *		hash ;
	    SV * 		sv ;
	    DB_INFO 		info ;
	    BerkeleyDB__Env	dbenv = NULL;
	    SV *		ref_dbenv = NULL;
	    const char *	file = NULL ;
	    const char *	subname = NULL ;
	    int			flags = 0 ;
	    int			mode = 0 ;
    	    BerkeleyDB 		db ;
    	    BerkeleyDB__Txn 	txn = NULL ;

    	    Trace(("_db_open_hash start\n")) ;
	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(file, "Filename", char *) ;
	    SetValue_pv(subname, "Subname", char *) ;
	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
	    ref_dbenv = sv ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_iv(mode, "Mode") ;

       	    Zero(&info, 1, DB_INFO) ;
	    SetValue_iv(info.db_cachesize, "Cachesize") ;
	    SetValue_iv(info.db_lorder, "Lorder") ;
	    SetValue_iv(info.db_pagesize, "Pagesize") ;
	    SetValue_iv(info.h_ffactor, "Ffactor") ;
	    SetValue_iv(info.h_nelem, "Nelem") ;
	    SetValue_iv(info.flags, "Property") ;
	    ZMALLOC(db, BerkeleyDB_type) ;
	    if ((sv = readHash(hash, "Hash")) && sv != &PL_sv_undef) {
		info.h_hash = hash_cb ;
		db->hash = newSVsv(sv) ;
	    }
	    /* DB_DUPSORT was introduced in DB 2.5.9 */
	    if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) {
#ifdef DB_DUPSORT
		info.dup_compare = dup_compare ;
		db->dup_compare = newSVsv(sv) ;
		info.flags |= DB_DUP|DB_DUPSORT ;
#else
	        croak("DupCompare needs Berkeley DB 2.5.9 or later") ;
#endif
	    }
	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_HASH, flags, mode, &info) ;
    	    Trace(("_db_open_hash end\n")) ;
	}
	OUTPUT:
	    RETVAL


HV *
db_stat(db, flags=0)
	int			flags
	BerkeleyDB::Common	db
	HV *			RETVAL = NULL ;
	INIT:
	  ckActive_Database(db->active) ;
	CODE:
	{
#if DB_VERSION_MAJOR == 2
	    softCrash("$db->db_stat for a Hash needs Berkeley DB 3.x or better") ;
#else
	    DB_HASH_STAT *	stat ;
#ifdef AT_LEAST_DB_3_3
	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
#else
	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
#endif
	    if (db->Status == 0) {
	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
		hv_store_iv(RETVAL, "hash_magic", stat->hash_magic) ;
		hv_store_iv(RETVAL, "hash_version", stat->hash_version);
		hv_store_iv(RETVAL, "hash_pagesize", stat->hash_pagesize);
#ifdef AT_LEAST_DB_3_1
		hv_store_iv(RETVAL, "hash_nkeys", stat->hash_nkeys);
		hv_store_iv(RETVAL, "hash_ndata", stat->hash_ndata);
#else
		hv_store_iv(RETVAL, "hash_nrecs", stat->hash_nrecs);
#endif
#ifndef AT_LEAST_DB_3_1
		hv_store_iv(RETVAL, "hash_nelem", stat->hash_nelem);
#endif
		hv_store_iv(RETVAL, "hash_ffactor", stat->hash_ffactor);
		hv_store_iv(RETVAL, "hash_buckets", stat->hash_buckets);
		hv_store_iv(RETVAL, "hash_free", stat->hash_free);
		hv_store_iv(RETVAL, "hash_bfree", stat->hash_bfree);
		hv_store_iv(RETVAL, "hash_bigpages", stat->hash_bigpages);
		hv_store_iv(RETVAL, "hash_big_bfree", stat->hash_big_bfree);
		hv_store_iv(RETVAL, "hash_overflows", stat->hash_overflows);
		hv_store_iv(RETVAL, "hash_ovfl_free", stat->hash_ovfl_free);
		hv_store_iv(RETVAL, "hash_dup", stat->hash_dup);
		hv_store_iv(RETVAL, "hash_dup_free", stat->hash_dup_free);
#if DB_VERSION_MAJOR >= 3
		hv_store_iv(RETVAL, "hash_metaflags", stat->hash_metaflags);
#endif
		safefree(stat) ;
	    }
#endif
	}
	OUTPUT:
	    RETVAL


MODULE = BerkeleyDB::Unknown	PACKAGE = BerkeleyDB::Unknown	PREFIX = hash_

void
_db_open_unknown(ref)
	SV * 		ref
	PPCODE:
	{
	    HV *		hash ;
	    SV * 		sv ;
	    DB_INFO 		info ;
	    BerkeleyDB__Env	dbenv = NULL;
	    SV *		ref_dbenv = NULL;
	    const char *	file = NULL ;
	    const char *	subname = NULL ;
	    int			flags = 0 ;
	    int			mode = 0 ;
    	    BerkeleyDB 		db ;
	    BerkeleyDB		RETVAL ;
    	    BerkeleyDB__Txn 	txn = NULL ;
	    static char * 		Names[] = {"", "Btree", "Hash", "Recno"} ;

	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(file, "Filename", char *) ;
	    SetValue_pv(subname, "Subname", char *) ;
	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
	    ref_dbenv = sv ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_iv(mode, "Mode") ;

       	    Zero(&info, 1, DB_INFO) ;
	    SetValue_iv(info.db_cachesize, "Cachesize") ;
	    SetValue_iv(info.db_lorder, "Lorder") ;
	    SetValue_iv(info.db_pagesize, "Pagesize") ;
	    SetValue_iv(info.h_ffactor, "Ffactor") ;
	    SetValue_iv(info.h_nelem, "Nelem") ;
	    SetValue_iv(info.flags, "Property") ;
	    ZMALLOC(db, BerkeleyDB_type) ;

	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_UNKNOWN, flags, mode, &info) ;
	    XPUSHs(sv_2mortal(newSViv(PTR2IV(RETVAL))));
	    if (RETVAL)
	        XPUSHs(sv_2mortal(newSVpv(Names[RETVAL->type], 0))) ;
	    else
	        XPUSHs(sv_2mortal(newSViv((IV)NULL)));
	}



MODULE = BerkeleyDB::Btree	PACKAGE = BerkeleyDB::Btree	PREFIX = btree_

BerkeleyDB::Btree::Raw
_db_open_btree(self, ref)
	char *		self
	SV * 		ref
	CODE:
	{
	    HV *		hash ;
	    SV * 		sv ;
	    DB_INFO 		info ;
	    BerkeleyDB__Env	dbenv = NULL;
	    SV *		ref_dbenv = NULL;
	    const char *	file = NULL ;
	    const char *	subname = NULL ;
	    int			flags = 0 ;
	    int			mode = 0 ;
    	    BerkeleyDB  	db ;
    	    BerkeleyDB__Txn 	txn = NULL ;

	    Trace(("In _db_open_btree\n"));
	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(file, "Filename", char*) ;
	    SetValue_pv(subname, "Subname", char *) ;
	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
	    ref_dbenv = sv ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_iv(mode, "Mode") ;

       	    Zero(&info, 1, DB_INFO) ;
	    SetValue_iv(info.db_cachesize, "Cachesize") ;
	    SetValue_iv(info.db_lorder, "Lorder") ;
	    SetValue_iv(info.db_pagesize, "Pagesize") ;
	    SetValue_iv(info.bt_minkey, "Minkey") ;
	    SetValue_iv(info.flags, "Property") ;
	    ZMALLOC(db, BerkeleyDB_type) ;
	    if ((sv = readHash(hash, "Compare")) && sv != &PL_sv_undef) {
		Trace(("    Parsed Compare callback\n"));
		info.bt_compare = btree_compare ;
		db->compare = newSVsv(sv) ;
	    }
	    /* DB_DUPSORT was introduced in DB 2.5.9 */
	    if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) {
#ifdef DB_DUPSORT
		Trace(("    Parsed DupCompare callback\n"));
		info.dup_compare = dup_compare ;
		db->dup_compare = newSVsv(sv) ;
		info.flags |= DB_DUP|DB_DUPSORT ;
#else
	        softCrash("DupCompare needs Berkeley DB 2.5.9 or later") ;
#endif
	    }
	    if ((sv = readHash(hash, "Prefix")) && sv != &PL_sv_undef) {
		Trace(("    Parsed Prefix callback\n"));
		info.bt_prefix = btree_prefix ;
		db->prefix = newSVsv(sv) ;
	    }

	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_BTREE, flags, mode, &info) ;
	}
	OUTPUT:
	    RETVAL


HV *
db_stat(db, flags=0)
	int			flags
	BerkeleyDB::Common	db
	HV *			RETVAL = NULL ;
	INIT:
	  ckActive_Database(db->active) ;
	CODE:
	{
	    DB_BTREE_STAT *	stat ;
#ifdef AT_LEAST_DB_3_3
	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
#else
	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
#endif
	    if (db->Status == 0) {
	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
		hv_store_iv(RETVAL, "bt_magic", stat->bt_magic);
		hv_store_iv(RETVAL, "bt_version", stat->bt_version);
#if DB_VERSION_MAJOR > 2
		hv_store_iv(RETVAL, "bt_metaflags", stat->bt_metaflags) ;
		hv_store_iv(RETVAL, "bt_flags", stat->bt_metaflags) ;
#else
		hv_store_iv(RETVAL, "bt_flags", stat->bt_flags) ;
#endif
		hv_store_iv(RETVAL, "bt_maxkey", stat->bt_maxkey) ;
		hv_store_iv(RETVAL, "bt_minkey", stat->bt_minkey);
		hv_store_iv(RETVAL, "bt_re_len", stat->bt_re_len);
		hv_store_iv(RETVAL, "bt_re_pad", stat->bt_re_pad);
		hv_store_iv(RETVAL, "bt_pagesize", stat->bt_pagesize);
		hv_store_iv(RETVAL, "bt_levels", stat->bt_levels);
#ifdef AT_LEAST_DB_3_1
		hv_store_iv(RETVAL, "bt_nkeys", stat->bt_nkeys);
		hv_store_iv(RETVAL, "bt_ndata", stat->bt_ndata);
#else
		hv_store_iv(RETVAL, "bt_nrecs", stat->bt_nrecs);
#endif
		hv_store_iv(RETVAL, "bt_int_pg", stat->bt_int_pg);
		hv_store_iv(RETVAL, "bt_leaf_pg", stat->bt_leaf_pg);
		hv_store_iv(RETVAL, "bt_dup_pg", stat->bt_dup_pg);
		hv_store_iv(RETVAL, "bt_over_pg", stat->bt_over_pg);
		hv_store_iv(RETVAL, "bt_free", stat->bt_free);
#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
		hv_store_iv(RETVAL, "bt_freed", stat->bt_freed);
		hv_store_iv(RETVAL, "bt_pfxsaved", stat->bt_pfxsaved);
		hv_store_iv(RETVAL, "bt_split", stat->bt_split);
		hv_store_iv(RETVAL, "bt_rootsplit", stat->bt_rootsplit);
		hv_store_iv(RETVAL, "bt_fastsplit", stat->bt_fastsplit);
		hv_store_iv(RETVAL, "bt_added", stat->bt_added);
		hv_store_iv(RETVAL, "bt_deleted", stat->bt_deleted);
		hv_store_iv(RETVAL, "bt_get", stat->bt_get);
		hv_store_iv(RETVAL, "bt_cache_hit", stat->bt_cache_hit);
		hv_store_iv(RETVAL, "bt_cache_miss", stat->bt_cache_miss);
#endif
		hv_store_iv(RETVAL, "bt_int_pgfree", stat->bt_int_pgfree);
		hv_store_iv(RETVAL, "bt_leaf_pgfree", stat->bt_leaf_pgfree);
		hv_store_iv(RETVAL, "bt_dup_pgfree", stat->bt_dup_pgfree);
		hv_store_iv(RETVAL, "bt_over_pgfree", stat->bt_over_pgfree);
		safefree(stat) ;
	    }
	}
	OUTPUT:
	    RETVAL


MODULE = BerkeleyDB::Recno	PACKAGE = BerkeleyDB::Recno	PREFIX = recno_

BerkeleyDB::Recno::Raw
_db_open_recno(self, ref)
	char *		self
	SV * 		ref
	CODE:
	{
	    HV *		hash ;
	    SV * 		sv ;
	    DB_INFO 		info ;
	    BerkeleyDB__Env	dbenv = NULL;
	    SV *		ref_dbenv = NULL;
	    const char *	file = NULL ;
	    const char *	subname = NULL ;
	    int			flags = 0 ;
	    int			mode = 0 ;
    	    BerkeleyDB 		db ;
    	    BerkeleyDB__Txn 	txn = NULL ;

	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(file, "Fname", char*) ;
	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
	    ref_dbenv = sv ;
	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_iv(mode, "Mode") ;

       	    Zero(&info, 1, DB_INFO) ;
	    SetValue_iv(info.db_cachesize, "Cachesize") ;
	    SetValue_iv(info.db_lorder, "Lorder") ;
	    SetValue_iv(info.db_pagesize, "Pagesize") ;
	    SetValue_iv(info.bt_minkey, "Minkey") ;

	    SetValue_iv(info.flags, "Property") ;
	    SetValue_pv(info.re_source, "Source", char*) ;
	    if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) {
		info.re_len = SvIV(sv) ; ;
		flagSet_DB2(info.flags, DB_FIXEDLEN) ;
	    }
	    if ((sv = readHash(hash, "Delim")) && sv != &PL_sv_undef) {
		info.re_delim = SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
		flagSet_DB2(info.flags, DB_DELIMITER) ;
	    }
	    if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) {
		info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
		flagSet_DB2(info.flags, DB_PAD) ;
	    }
	    ZMALLOC(db, BerkeleyDB_type) ;
#ifdef ALLOW_RECNO_OFFSET
	    SetValue_iv(db->array_base, "ArrayBase") ;
	    db->array_base = (db->array_base == 0 ? 1 : 0) ;
#endif /* ALLOW_RECNO_OFFSET */

	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_RECNO, flags, mode, &info) ;
	}
	OUTPUT:
	    RETVAL


MODULE = BerkeleyDB::Queue	PACKAGE = BerkeleyDB::Queue	PREFIX = recno_

BerkeleyDB::Queue::Raw
_db_open_queue(self, ref)
	char *		self
	SV * 		ref
	CODE:
	{
#ifndef AT_LEAST_DB_3
            softCrash("BerkeleyDB::Queue needs Berkeley DB 3.0.x or better");
#else
	    HV *		hash ;
	    SV * 		sv ;
	    DB_INFO 		info ;
	    BerkeleyDB__Env	dbenv = NULL;
	    SV *		ref_dbenv = NULL;
	    const char *	file = NULL ;
	    const char *	subname = NULL ;
	    int			flags = 0 ;
	    int			mode = 0 ;
    	    BerkeleyDB 		db ;
    	    BerkeleyDB__Txn 	txn = NULL ;

	    hash = (HV*) SvRV(ref) ;
	    SetValue_pv(file, "Fname", char*) ;
	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
	    ref_dbenv = sv ;
	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
	    SetValue_iv(flags, "Flags") ;
	    SetValue_iv(mode, "Mode") ;

       	    Zero(&info, 1, DB_INFO) ;
	    SetValue_iv(info.db_cachesize, "Cachesize") ;
	    SetValue_iv(info.db_lorder, "Lorder") ;
	    SetValue_iv(info.db_pagesize, "Pagesize") ;
	    SetValue_iv(info.bt_minkey, "Minkey") ;
    	    SetValue_iv(info.q_extentsize, "ExtentSize") ;


	    SetValue_iv(info.flags, "Property") ;
	    if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) {
		info.re_len = SvIV(sv) ; ;
		flagSet_DB2(info.flags, DB_FIXEDLEN) ;
	    }
	    if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) {
		info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
		flagSet_DB2(info.flags, DB_PAD) ;
	    }
	    ZMALLOC(db, BerkeleyDB_type) ;
#ifdef ALLOW_RECNO_OFFSET
	    SetValue_iv(db->array_base, "ArrayBase") ;
	    db->array_base = (db->array_base == 0 ? 1 : 0) ;
#endif /* ALLOW_RECNO_OFFSET */

	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_QUEUE, flags, mode, &info) ;
#endif
	}
	OUTPUT:
	    RETVAL

HV *
db_stat(db, flags=0)
	int			flags
	BerkeleyDB::Common	db
	HV *			RETVAL = NULL ;
	INIT:
	  ckActive_Database(db->active) ;
	CODE:
	{
#if DB_VERSION_MAJOR == 2
	    softCrash("$db->db_stat for a Queue needs Berkeley DB 3.x or better") ;
#else /* Berkeley DB 3, or better */
	    DB_QUEUE_STAT *	stat ;
#ifdef AT_LEAST_DB_3_3
	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
#else
	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
#endif
	    if (db->Status == 0) {
	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
		hv_store_iv(RETVAL, "qs_magic", stat->qs_magic) ;
		hv_store_iv(RETVAL, "qs_version", stat->qs_version);
#ifdef AT_LEAST_DB_3_1
		hv_store_iv(RETVAL, "qs_nkeys", stat->qs_nkeys);
		hv_store_iv(RETVAL, "qs_ndata", stat->qs_ndata);
#else
		hv_store_iv(RETVAL, "qs_nrecs", stat->qs_nrecs);
#endif
		hv_store_iv(RETVAL, "qs_pages", stat->qs_pages);
		hv_store_iv(RETVAL, "qs_pagesize", stat->qs_pagesize);
		hv_store_iv(RETVAL, "qs_pgfree", stat->qs_pgfree);
		hv_store_iv(RETVAL, "qs_re_len", stat->qs_re_len);
		hv_store_iv(RETVAL, "qs_re_pad", stat->qs_re_pad);
#ifdef AT_LEAST_DB_3_2
#else
		hv_store_iv(RETVAL, "qs_start", stat->qs_start);
#endif
		hv_store_iv(RETVAL, "qs_first_recno", stat->qs_first_recno);
		hv_store_iv(RETVAL, "qs_cur_recno", stat->qs_cur_recno);
#if DB_VERSION_MAJOR >= 3
		hv_store_iv(RETVAL, "qs_metaflags", stat->qs_metaflags);
#endif
		safefree(stat) ;
	    }
#endif
	}
	OUTPUT:
	    RETVAL


MODULE = BerkeleyDB::Common  PACKAGE = BerkeleyDB::Common	PREFIX = dab_


DualType
db_close(db,flags=0)
	int 			flags
        BerkeleyDB::Common 	db
	INIT:
	    ckActive_Database(db->active) ;
	    CurrentDB = db ;
	CODE:
	    Trace(("BerkeleyDB::Common::db_close %d\n", db));
#ifdef STRICT_CLOSE
	    if (db->txn)
		softCrash("attempted to close a database while a transaction was still open") ;
	    if (db->open_cursors)
		softCrash("attempted to close a database with %d open cursor(s)",
				db->open_cursors) ;
#endif /* STRICT_CLOSE */
	    RETVAL =  db->Status = ((db->dbp)->close)(db->dbp, flags) ;
	    if (db->parent_env && db->parent_env->open_dbs)
		-- db->parent_env->open_dbs ;
	    db->active = FALSE ;
	    hash_delete("BerkeleyDB::Term::Db", (char *)db) ;
	    -- db->open_cursors ;
	    Trace(("end of BerkeleyDB::Common::db_close\n"));
	OUTPUT:
	    RETVAL

void
dab__DESTROY(db)
	BerkeleyDB::Common	db
	CODE:
	  CurrentDB = db ;
	  Trace(("In BerkeleyDB::Common::_DESTROY db %d dirty=%d\n", db, PL_dirty)) ;
	  destroyDB(db) ;
	  Trace(("End of BerkeleyDB::Common::DESTROY \n")) ;

#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
#define db_cursor(db, txn, cur,flags)  ((db->dbp)->cursor)(db->dbp, txn, cur)
#else
#define db_cursor(db, txn, cur,flags)  ((db->dbp)->cursor)(db->dbp, txn, cur,flags)
#endif
BerkeleyDB::Cursor::Raw
_db_cursor(db, flags=0)
	u_int32_t		flags
        BerkeleyDB::Common 	db
        BerkeleyDB::Cursor 	RETVAL = NULL ;
	INIT:
	    ckActive_Database(db->active) ;
	CODE:
	{
	  DBC *		cursor ;
	  CurrentDB = db ;
	  if ((db->Status = db_cursor(db, db->txn, &cursor, flags)) == 0){
	      ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
	      db->open_cursors ++ ;
	      RETVAL->parent_db  = db ;
	      RETVAL->cursor  = cursor ;
	      RETVAL->dbp     = db->dbp ;
	      RETVAL->txn     = db->txn ;
              RETVAL->type    = db->type ;
              RETVAL->recno_or_queue    = db->recno_or_queue ;
              RETVAL->filename    = my_strdup(db->filename) ;
              RETVAL->compare = db->compare ;
              RETVAL->dup_compare = db->dup_compare ;
#ifdef AT_LEAST_DB_3_3
              RETVAL->associated = db->associated ;
	      RETVAL->secondary_db  = db->secondary_db;
#endif
              RETVAL->prefix  = db->prefix ;
              RETVAL->hash    = db->hash ;
	      RETVAL->partial = db->partial ;
	      RETVAL->doff    = db->doff ;
	      RETVAL->dlen    = db->dlen ;
	      RETVAL->active  = TRUE ;
#ifdef ALLOW_RECNO_OFFSET
	      RETVAL->array_base  = db->array_base ;
#endif /* ALLOW_RECNO_OFFSET */
#ifdef DBM_FILTERING
	      RETVAL->filtering   = FALSE ;
	      RETVAL->filter_fetch_key    = db->filter_fetch_key ;
	      RETVAL->filter_store_key    = db->filter_store_key ;
	      RETVAL->filter_fetch_value  = db->filter_fetch_value ;
	      RETVAL->filter_store_value  = db->filter_store_value ;
#endif
              /* RETVAL->info ; */
	      hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
	  }
	}
	OUTPUT:
	  RETVAL

BerkeleyDB::Cursor::Raw
_db_join(db, cursors, flags=0)
	u_int32_t		flags
        BerkeleyDB::Common 	db
	AV *			cursors
        BerkeleyDB::Cursor 	RETVAL = NULL ;
	INIT:
	    ckActive_Database(db->active) ;
	CODE:
	{
#if DB_VERSION_MAJOR == 2 && (DB_VERSION_MINOR < 5 || (DB_VERSION_MINOR == 5 && DB_VERSION_PATCH < 2))
	    softCrash("join needs Berkeley DB 2.5.2 or later") ;
#else /* Berkeley DB >= 2.5.2 */
	  DBC *		join_cursor ;
	  DBC **	cursor_list ;
	  I32		count = av_len(cursors) + 1 ;
	  int		i ;
	  CurrentDB = db ;
	  if (count < 1 )
	      softCrash("db_join: No cursors in parameter list") ;
	  cursor_list = (DBC **)safemalloc(sizeof(DBC*) * (count + 1));
	  for (i = 0 ; i < count ; ++i) {
	      SV * obj = (SV*) * av_fetch(cursors, i, FALSE) ;
	      IV tmp = SvIV(getInnerObject(obj)) ;
	      BerkeleyDB__Cursor cur = INT2PTR(BerkeleyDB__Cursor, tmp);
	      cursor_list[i] = cur->cursor ;
	  }
	  cursor_list[i] = NULL ;
#if DB_VERSION_MAJOR == 2
	  if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, flags, &join_cursor)) == 0){
#else
	  if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, &join_cursor, flags)) == 0){
#endif
	      ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
	      db->open_cursors ++ ;
	      RETVAL->parent_db  = db ;
	      RETVAL->cursor  = join_cursor ;
	      RETVAL->dbp     = db->dbp ;
              RETVAL->type    = db->type ;
              RETVAL->filename    = my_strdup(db->filename) ;
              RETVAL->compare = db->compare ;
              RETVAL->dup_compare = db->dup_compare ;
#ifdef AT_LEAST_DB_3_3
              RETVAL->associated = db->associated ;
	      RETVAL->secondary_db  = db->secondary_db;
#endif
              RETVAL->prefix  = db->prefix ;
              RETVAL->hash    = db->hash ;
	      RETVAL->partial = db->partial ;
	      RETVAL->doff    = db->doff ;
	      RETVAL->dlen    = db->dlen ;
	      RETVAL->active  = TRUE ;
#ifdef ALLOW_RECNO_OFFSET
	      RETVAL->array_base  = db->array_base ;
#endif /* ALLOW_RECNO_OFFSET */
#ifdef DBM_FILTERING
	      RETVAL->filtering   = FALSE ;
	      RETVAL->filter_fetch_key    = db->filter_fetch_key ;
	      RETVAL->filter_store_key    = db->filter_store_key ;
	      RETVAL->filter_fetch_value  = db->filter_fetch_value ;
	      RETVAL->filter_store_value  = db->filter_store_value ;
#endif
              /* RETVAL->info ; */
	      hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
	  }
	  safefree(cursor_list) ;
#endif /* Berkeley DB >= 2.5.2 */
	}
	OUTPUT:
	  RETVAL

int
ArrayOffset(db)
        BerkeleyDB::Common 	db
	INIT:
	    ckActive_Database(db->active) ;
	CODE:
#ifdef ALLOW_RECNO_OFFSET
	    RETVAL = db->array_base ? 0 : 1 ;
#else
	    RETVAL = 0 ;
#endif /* ALLOW_RECNO_OFFSET */
	OUTPUT:
	    RETVAL

int
type(db)
        BerkeleyDB::Common 	db
	INIT:
	    ckActive_Database(db->active) ;
	CODE:
	    RETVAL = db->type ;
	OUTPUT:
	    RETVAL

int
byteswapped(db)
        BerkeleyDB::Common 	db
	INIT:
	    ckActive_Database(db->active) ;
	CODE:
#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
	    softCrash("byteswapped needs Berkeley DB 2.5 or later") ;
#else
#if DB_VERSION_MAJOR == 2
	    RETVAL = db->dbp->byteswapped ;
#else
#ifdef AT_LEAST_DB_3_3
	    db->dbp->get_byteswapped(db->dbp, &RETVAL) ;
#else
	    RETVAL = db->dbp->get_byteswapped(db->dbp) ;
#endif
#endif
#endif
	OUTPUT:
	    RETVAL

DualType
status(db)
        BerkeleyDB::Common 	db
	CODE:
	    RETVAL =  db->Status ;
	OUTPUT:
	    RETVAL

#ifdef DBM_FILTERING

#define setFilter(ftype)				\
	{						\
	    if (db->ftype)				\
	        RETVAL = sv_mortalcopy(db->ftype) ;	\
	    ST(0) = RETVAL ;				\
	    if (db->ftype && (code == &PL_sv_undef)) {	\
                SvREFCNT_dec(db->ftype) ;		\
	        db->ftype = NULL ;			\
	    }						\
	    else if (code) {				\
	        if (db->ftype)				\
	            sv_setsv(db->ftype, code) ;		\
	        else					\
	            db->ftype = newSVsv(code) ;		\
	    }	    					\
	}


SV *
filter_fetch_key(db, code)
	BerkeleyDB::Common		db
	SV *		code
	SV *		RETVAL = &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_fetch_key, code) ;

SV *
filter_store_key(db, code)
	BerkeleyDB::Common		db
	SV *		code
	SV *		RETVAL = &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_store_key, code) ;

SV *
filter_fetch_value(db, code)
	BerkeleyDB::Common		db
	SV *		code
	SV *		RETVAL = &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_fetch_value, code) ;

SV *
filter_store_value(db, code)
	BerkeleyDB::Common		db
	SV *		code
	SV *		RETVAL = &PL_sv_undef ;
	CODE:
	    DBM_setFilter(db->filter_store_value, code) ;

#endif /* DBM_FILTERING */

void
partial_set(db, offset, length)
        BerkeleyDB::Common 	db
	u_int32_t		offset
	u_int32_t		length
	INIT:
	    ckActive_Database(db->active) ;
	PPCODE:
	    if (GIMME == G_ARRAY) {
		XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ;
		XPUSHs(sv_2mortal(newSViv(db->doff))) ;
		XPUSHs(sv_2mortal(newSViv(db->dlen))) ;
	    }
	    db->partial = DB_DBT_PARTIAL ;
	    db->doff    = offset ;
	    db->dlen    = length ;


void
partial_clear(db)
        BerkeleyDB::Common 	db
	INIT:
	    ckActive_Database(db->active) ;
	PPCODE:
	    if (GIMME == G_ARRAY) {
		XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ;
		XPUSHs(sv_2mortal(newSViv(db->doff))) ;
		XPUSHs(sv_2mortal(newSViv(db->dlen))) ;
	    }
	    db->partial =
	    db->doff    =
	    db->dlen    = 0 ;


#define db_del(db, key, flags)  \
	(db->Status = ((db->dbp)->del)(db->dbp, db->txn, &key, flags))
DualType
db_del(db, key, flags=0)
	u_int		flags
	BerkeleyDB::Common	db
	DBTKEY		key
	INIT:
	    Trace(("db_del db[%p] in [%p] txn[%p] key[%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
	    ckActive_Database(db->active) ;
	    CurrentDB = db ;


#ifdef AT_LEAST_DB_3
#  ifdef AT_LEAST_DB_3_2
#    define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_CONSUME_WAIT)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
#  else
#    define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
#  endif
#else
#define writeToKey() (flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
#endif
#define db_get(db, key, data, flags)   \
	(db->Status = ((db->dbp)->get)(db->dbp, db->txn, &key, &data, flags))
DualType
db_get(db, key, data, flags=0)
	u_int		flags
	BerkeleyDB::Common	db
	DBTKEY_B	key
	DBT_OPT		data
	CODE:
	  ckActive_Database(db->active) ;
	  CurrentDB = db ;
	  SetPartial(data,db) ;
	  Trace(("db_get db[%p] in [%p] txn[%p] key [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
	  RETVAL = db_get(db, key, data, flags);
	  Trace(("  RETVAL %d\n", RETVAL));
	OUTPUT:
	  RETVAL
	  key	if (writeToKey()) OutputKey(ST(1), key) ;
	  data

#define db_pget(db, key, pkey, data, flags)   \
	(db->Status = ((db->dbp)->pget)(db->dbp, db->txn, &key, &pkey, &data, flags))
DualType
db_pget(db, key, pkey, data, flags=0)
	u_int		flags
	BerkeleyDB::Common	db
	DBTKEY_B	key
	DBTKEY_B	pkey = NO_INIT
	DBT_OPT		data
	CODE:
#ifndef AT_LEAST_DB_3_3
          softCrash("db_pget needs at least Berkeley DB 3.3");
#else
	  Trace(("db_pget db [%p] in [%p] txn [%p] flags [%d]\n", db->dbp, db, db->txn, flags)) ;
	  ckActive_Database(db->active) ;
	  CurrentDB = db ;
	  SetPartial(data,db) ;
	  DBT_clear(pkey);
	  RETVAL = db_pget(db, key, pkey, data, flags);
	  Trace(("  RETVAL %d\n", RETVAL));
#endif
	OUTPUT:
	  RETVAL
	  key	if (writeToKey()) OutputKey(ST(1), key) ;
	  pkey
	  data

#define db_put(db,key,data,flag)	\
		(db->Status = (db->dbp->put)(db->dbp,db->txn,&key,&data,flag))
DualType
db_put(db, key, data, flags=0)
	u_int			flags
	BerkeleyDB::Common	db
	DBTKEY			key
	DBT			data
	CODE:
	  ckActive_Database(db->active) ;
	  CurrentDB = db ;
	  /* SetPartial(data,db) ; */
	  Trace(("db_put db[%p] in [%p] txn[%p] key[%.*s] data [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, data.size, data.data, flags)) ;
	  RETVAL = db_put(db, key, data, flags);
	  Trace(("  RETVAL %d\n", RETVAL));
	OUTPUT:
	  RETVAL
	  key	if (flagSet(DB_APPEND)) OutputKey(ST(1), key) ;

#define db_key_range(db, key, range, flags)   \
	(db->Status = ((db->dbp)->key_range)(db->dbp, db->txn, &key, &range, flags))
DualType
db_key_range(db, key, less, equal, greater, flags=0)
	u_int32_t	flags
	BerkeleyDB::Common	db
	DBTKEY_B	key
	double          less = 0.0 ;
	double          equal = 0.0 ;
	double          greater = 0.0 ;
	CODE:
	{
#ifndef AT_LEAST_DB_3_1
          softCrash("key_range needs Berkeley DB 3.1.x or later") ;
#else
          DB_KEY_RANGE range ;
          range.less = range.equal = range.greater = 0.0 ;
	  ckActive_Database(db->active) ;
	  CurrentDB = db ;
	  RETVAL = db_key_range(db, key, range, flags);
	  if (RETVAL == 0) {
	        less = range.less ;
	        equal = range.equal;
	        greater = range.greater;
	  }
#endif
	}
	OUTPUT:
	  RETVAL
	  less
	  equal
	  greater


#define db_fd(d, x)	(db->Status = (db->dbp->fd)(db->dbp, &x))
DualType
db_fd(db)
	BerkeleyDB::Common	db
	INIT:
	  ckActive_Database(db->active) ;
	CODE:
	  CurrentDB = db ;
	  db_fd(db, RETVAL) ;
	OUTPUT:
	  RETVAL


#define db_sync(db, fl)	(db->Status = (db->dbp->sync)(db->dbp, fl))
DualType
db_sync(db, flags=0)
	u_int			flags
	BerkeleyDB::Common	db
	INIT:
	  ckActive_Database(db->active) ;
	  CurrentDB = db ;

void
_Txn(db, txn=NULL)
        BerkeleyDB::Common      db
        BerkeleyDB::Txn         txn
	INIT:
	  ckActive_Database(db->active) ;
	CODE:
	   if (txn) {
	       Trace(("_Txn[%p] in[%p] active [%d]\n", txn->txn, txn, txn->active));
	       ckActive_Transaction(txn->active) ;
	       db->txn = txn->txn ;
	   }
	   else {
	       Trace(("_Txn[undef] \n"));
	       db->txn = NULL ;
	   }


#define db_truncate(db, countp, flags)  \
	(db->Status = ((db->dbp)->truncate)(db->dbp, db->txn, &countp, flags))
DualType
truncate(db, countp, flags=0)
	BerkeleyDB::Common	db
	u_int32_t		countp
	u_int32_t		flags
	INIT:
	  ckActive_Database(db->active) ;
	CODE:
#ifndef AT_LEAST_DB_3_3
          softCrash("truncate needs Berkeley DB 3.3 or later") ;
#else
	  CurrentDB = db ;
	  RETVAL = db_truncate(db, countp, flags);
#endif
	OUTPUT:
	  RETVAL
	  countp

#ifdef AT_LEAST_DB_4_1
#  define db_associate(db, sec, cb, flags)\
	(db->Status = ((db->dbp)->associate)(db->dbp, NULL, sec->dbp, &cb, flags))
#else
#  define db_associate(db, sec, cb, flags)\
	(db->Status = ((db->dbp)->associate)(db->dbp, sec->dbp, &cb, flags))
#endif
DualType
associate(db, secondary, callback, flags=0)
	BerkeleyDB::Common	db
	BerkeleyDB::Common	secondary
	SV*			callback
	u_int32_t		flags
	INIT:
	  ckActive_Database(db->active) ;
	CODE:
#ifndef AT_LEAST_DB_3_3
          softCrash("associate needs Berkeley DB 3.3 or later") ;
#else
	  CurrentDB = db ;
	  /* db->associated = newSVsv(callback) ; */
	  secondary->associated = newSVsv(callback) ;
	  /* secondary->dbp->app_private = secondary->associated ; */
	  secondary->secondary_db = TRUE;
	  RETVAL = db_associate(db, secondary, associate_cb, flags);
#endif
	OUTPUT:
	  RETVAL


MODULE = BerkeleyDB::Cursor              PACKAGE = BerkeleyDB::Cursor	PREFIX = cu_

BerkeleyDB::Cursor::Raw
_c_dup(db, flags=0)
	u_int32_t		flags
    	BerkeleyDB::Cursor	db
        BerkeleyDB::Cursor 	RETVAL = NULL ;
	INIT:
	    CurrentDB = db->parent_db ;
	    ckActive_Database(db->active) ;
	CODE:
	{
#ifndef AT_LEAST_DB_3
          softCrash("c_dup needs at least Berkeley DB 3.0.x");
#else
	  DBC *		newcursor ;
	  db->Status = ((db->cursor)->c_dup)(db->cursor, &newcursor, flags) ;
	  if (db->Status == 0){
	      ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
	      db->parent_db->open_cursors ++ ;
	      RETVAL->parent_db  = db->parent_db ;
	      RETVAL->cursor  = newcursor ;
	      RETVAL->dbp     = db->dbp ;
              RETVAL->type    = db->type ;
              RETVAL->recno_or_queue    = db->recno_or_queue ;
              RETVAL->filename    = my_strdup(db->filename) ;
              RETVAL->compare = db->compare ;
              RETVAL->dup_compare = db->dup_compare ;
#ifdef AT_LEAST_DB_3_3
              RETVAL->associated = db->associated ;
#endif
              RETVAL->prefix  = db->prefix ;
              RETVAL->hash    = db->hash ;
	      RETVAL->partial = db->partial ;
	      RETVAL->doff    = db->doff ;
	      RETVAL->dlen    = db->dlen ;
	      RETVAL->active  = TRUE ;
#ifdef ALLOW_RECNO_OFFSET
	      RETVAL->array_base  = db->array_base ;
#endif /* ALLOW_RECNO_OFFSET */
#ifdef DBM_FILTERING
	      RETVAL->filtering   = FALSE ;
	      RETVAL->filter_fetch_key    = db->filter_fetch_key ;
	      RETVAL->filter_store_key    = db->filter_store_key ;
	      RETVAL->filter_fetch_value  = db->filter_fetch_value ;
	      RETVAL->filter_store_value  = db->filter_store_value ;
#endif /* DBM_FILTERING */
              /* RETVAL->info ; */
	      hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
	  }
#endif	
	}
	OUTPUT:
	  RETVAL

DualType
_c_close(db)
    BerkeleyDB::Cursor	db
	INIT:
	  CurrentDB = db->parent_db ;
	  ckActive_Cursor(db->active) ;
	  hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
	CODE:
	  RETVAL =  db->Status =
    	          ((db->cursor)->c_close)(db->cursor) ;
	  db->active = FALSE ;
	  if (db->parent_db->open_cursors)
	      -- db->parent_db->open_cursors ;
	OUTPUT:
	  RETVAL

void
_DESTROY(db)
    BerkeleyDB::Cursor	db
	CODE:
	  CurrentDB = db->parent_db ;
	  Trace(("In BerkeleyDB::Cursor::_DESTROY db %d dirty=%d active=%d\n", db, PL_dirty, db->active));
	  hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
	  if (db->active)
    	      ((db->cursor)->c_close)(db->cursor) ;
	  if (db->parent_db->open_cursors)
	      -- db->parent_db->open_cursors ;
          Safefree(db->filename) ;
          Safefree(db) ;
	  Trace(("End of BerkeleyDB::Cursor::_DESTROY\n")) ;

DualType
status(db)
        BerkeleyDB::Cursor 	db
	CODE:
	    RETVAL =  db->Status ;
	OUTPUT:
	    RETVAL


#define cu_c_del(c,f)	(c->Status = ((c->cursor)->c_del)(c->cursor,f))
DualType
cu_c_del(db, flags=0)
    int			flags
    BerkeleyDB::Cursor	db
	INIT:
	  CurrentDB = db->parent_db ;
	  ckActive_Cursor(db->active) ;
	OUTPUT:
	  RETVAL


#define cu_c_get(c,k,d,f) (c->Status = (c->cursor->c_get)(c->cursor,&k,&d,f))
DualType
cu_c_get(db, key, data, flags=0)
    int			flags
    BerkeleyDB::Cursor	db
    DBTKEY_B		key
    DBT_B		data
	INIT:
	  Trace(("c_get db [%p] in [%p] flags [%d]\n", db->dbp, db, flags)) ;
	  CurrentDB = db->parent_db ;
	  ckActive_Cursor(db->active) ;
	  SetPartial(data,db) ;
	  Trace(("c_get end\n")) ;
	OUTPUT:
	  RETVAL
	  key
	  data		if (! flagSet(DB_JOIN_ITEM)) OutputValue_B(ST(2), data) ;

#define cu_c_pget(c,k,p,d,f) (c->Status = (c->secondary_db ? (c->cursor->c_pget)(c->cursor,&k,&p,&d,f) : EINVAL))
DualType
cu_c_pget(db, key, pkey, data, flags=0)
    int			flags
    BerkeleyDB::Cursor	db
    DBTKEY_B		key
    DBTKEY_B		pkey = NO_INIT
    DBT_B		data
	CODE:
#ifndef AT_LEAST_DB_3_3
          softCrash("db_c_pget needs at least Berkeley DB 3.3");
#else
	  Trace(("c_pget db [%d] flags [%d]\n", db, flags)) ;
	  CurrentDB = db->parent_db ;
	  ckActive_Cursor(db->active) ;
	  SetPartial(data,db) ;
	  DBT_clear(pkey);
	  RETVAL = cu_c_pget(db, key, pkey, data, flags);
	  Trace(("c_pget end\n")) ;
#endif
	OUTPUT:
	  RETVAL
	  key
	  pkey
	  data		if (! flagSet(DB_JOIN_ITEM)) OutputValue_B(ST(2), data) ;



#define cu_c_put(c,k,d,f)  (c->Status = (c->cursor->c_put)(c->cursor,&k,&d,f))
DualType
cu_c_put(db, key, data, flags=0)
    int			flags
    BerkeleyDB::Cursor	db
    DBTKEY		key
    DBT			data
	INIT:
	  CurrentDB = db->parent_db ;
	  ckActive_Cursor(db->active) ;
	  /* SetPartial(data,db) ; */
	OUTPUT:
	  RETVAL

#define cu_c_count(c,p,f) (c->Status = (c->cursor->c_count)(c->cursor,&p,f))
DualType
cu_c_count(db, count, flags=0)
    int			flags
    BerkeleyDB::Cursor	db
    u_int32_t           count = NO_INIT
	CODE:
#ifndef AT_LEAST_DB_3_1
          softCrash("c_count needs at least Berkeley DB 3.1.x");
#else
	  Trace(("c_get count [%d] flags [%d]\n", db, flags)) ;
	  CurrentDB = db->parent_db ;
	  ckActive_Cursor(db->active) ;
	  RETVAL = cu_c_count(db, count, flags) ;
	  Trace(("    c_count got %d duplicates\n", count)) ;
#endif
	OUTPUT:
	  RETVAL
	  count

MODULE = BerkeleyDB::TxnMgr           PACKAGE = BerkeleyDB::TxnMgr	PREFIX = xx_

BerkeleyDB::Txn::Raw
_txn_begin(txnmgr, pid=NULL, flags=0)
	u_int32_t		flags
	BerkeleyDB::TxnMgr	txnmgr
	BerkeleyDB::Txn		pid
	CODE:
	{
	    DB_TXN *txn ;
	    DB_TXN *p_id = NULL ;
#if DB_VERSION_MAJOR == 2
	    if (txnmgr->env->Env->tx_info == NULL)
		softCrash("Transaction Manager not enabled") ;
#endif
	    if (pid)
		p_id = pid->txn ;
	    txnmgr->env->TxnMgrStatus =
#if DB_VERSION_MAJOR == 2
	    	txn_begin(txnmgr->env->Env->tx_info, p_id, &txn) ;
#else
#  ifdef AT_LEAST_DB_4
	    	txnmgr->env->Env->txn_begin(txnmgr->env->Env, p_id, &txn, flags) ;
#  else
	    	txn_begin(txnmgr->env->Env, p_id, &txn, flags) ;
#  endif
#endif
	    if (txnmgr->env->TxnMgrStatus == 0) {
	      ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ;
	      RETVAL->txn  = txn ;
	      RETVAL->active = TRUE ;
	      Trace(("_txn_begin created txn [%d] in [%d]\n", txn, RETVAL));
	      hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ;
	    }
	    else
		RETVAL = NULL ;
	}
	OUTPUT:
	    RETVAL


DualType
status(mgr)
        BerkeleyDB::TxnMgr 	mgr
	CODE:
	    RETVAL =  mgr->env->TxnMgrStatus ;
	OUTPUT:
	    RETVAL


void
_DESTROY(mgr)
    BerkeleyDB::TxnMgr	mgr
	CODE:
	  Trace(("In BerkeleyDB::TxnMgr::DESTROY dirty=%d\n", PL_dirty)) ;
          Safefree(mgr) ;
	  Trace(("End of BerkeleyDB::TxnMgr::DESTROY\n")) ;

DualType
txn_close(txnp)
	BerkeleyDB::TxnMgr	txnp
        NOT_IMPLEMENTED_YET


#if DB_VERSION_MAJOR == 2
#  define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env->tx_info, k, m)
#else
#  ifdef AT_LEAST_DB_4 
#    define xx_txn_checkpoint(e,k,m,f) e->env->Env->txn_checkpoint(e->env->Env, k, m, f)
#  else
#    ifdef AT_LEAST_DB_3_1
#      define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m, 0)
#    else
#      define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m)
#    endif
#  endif
#endif
DualType
xx_txn_checkpoint(txnp, kbyte, min, flags=0)
	BerkeleyDB::TxnMgr	txnp
	long			kbyte
	long			min
	u_int32_t		flags

HV *
txn_stat(txnp)
	BerkeleyDB::TxnMgr	txnp
	HV *			RETVAL = NULL ;
	CODE:
	{
	    DB_TXN_STAT *	stat ;
#ifdef AT_LEAST_DB_4
	    if(txnp->env->Env->txn_stat(txnp->env->Env, &stat, 0) == 0) {
#else
#  ifdef AT_LEAST_DB_3_3
	    if(txn_stat(txnp->env->Env, &stat) == 0) {
#  else
#    if DB_VERSION_MAJOR == 2
	    if(txn_stat(txnp->env->Env->tx_info, &stat, safemalloc) == 0) {
#    else
	    if(txn_stat(txnp->env->Env, &stat, safemalloc) == 0) {
#    endif
#  endif
#endif
	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
		hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ;
		hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ;
		hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ;
		hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ;
		hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ;
		hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ;
		hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ;
#if DB_VERSION_MAJOR > 2
		hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ;
		hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ;
		hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ;
		hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ;
#endif
		safefree(stat) ;
	    }
	}
	OUTPUT:
	    RETVAL


BerkeleyDB::TxnMgr
txn_open(dir, flags, mode, dbenv)
    int 		flags
    const char *	dir
    int 		mode
    BerkeleyDB::Env 	dbenv
        NOT_IMPLEMENTED_YET


MODULE = BerkeleyDB::Txn              PACKAGE = BerkeleyDB::Txn		PREFIX = xx_

DualType
status(tid)
        BerkeleyDB::Txn 	tid
	CODE:
	    RETVAL =  tid->Status ;
	OUTPUT:
	    RETVAL

int
_DESTROY(tid)
    BerkeleyDB::Txn	tid
	CODE:
	  Trace(("In BerkeleyDB::Txn::_DESTROY txn [%d] active [%d] dirty=%d\n", tid->txn, tid->active, PL_dirty)) ;
	  if (tid->active)
#ifdef AT_LEAST_DB_4
	    tid->txn->abort(tid->txn) ;
#else
	    txn_abort(tid->txn) ;
#endif
          RETVAL = (int)tid ;
	  hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
          Safefree(tid) ;
	  Trace(("End of BerkeleyDB::Txn::DESTROY\n")) ;
	OUTPUT:
	  RETVAL

#define xx_txn_unlink(d,f,e)	txn_unlink(d,f,&(e->Env))
DualType
xx_txn_unlink(dir, force, dbenv)
    const char *	dir
    int 		force
    BerkeleyDB::Env 	dbenv
        NOT_IMPLEMENTED_YET

#ifdef AT_LEAST_DB_4
#  define xx_txn_prepare(t) (t->Status = t->txn->prepare(t->txn, 0))
#else
#  ifdef AT_LEAST_DB_3_3
#    define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn, 0))
#  else
#    define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn))
#  endif
#endif
DualType
xx_txn_prepare(tid)
	BerkeleyDB::Txn	tid
	INIT:
	    ckActive_Transaction(tid->active) ;

#ifdef AT_LEAST_DB_4
#  define _txn_commit(t,flags) (t->Status = t->txn->commit(t->txn, flags))
#else
#  if DB_VERSION_MAJOR == 2
#    define _txn_commit(t,flags) (t->Status = txn_commit(t->txn))
#  else
#    define _txn_commit(t, flags) (t->Status = txn_commit(t->txn, flags))
#  endif
#endif
DualType
_txn_commit(tid, flags=0)
	u_int32_t	flags
	BerkeleyDB::Txn	tid
	INIT:
	    ckActive_Transaction(tid->active) ;
	    hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
	    tid->active = FALSE ;

#ifdef AT_LEAST_DB_4
#  define _txn_abort(t) (t->Status = t->txn->abort(t->txn))
#else
#  define _txn_abort(t) (t->Status = txn_abort(t->txn))
#endif
DualType
_txn_abort(tid)
	BerkeleyDB::Txn	tid
	INIT:
	    ckActive_Transaction(tid->active) ;
	    hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
	    tid->active = FALSE ;

#ifdef AT_LEAST_DB_4
#  define _txn_discard(t,f) (t->Status = t->txn->discard(t->txn, f))
#else
#  ifdef AT_LEAST_DB_3_3_4
#    define _txn_discard(t,f) (t->Status = txn_discard(t->txn, f))
#  else
#    define _txn_discard(t,f) (int)softCrash("txn_discard needs Berkeley DB 3.3.4 or better") ;
#  endif
#endif
DualType
_txn_discard(tid, flags=0)
	BerkeleyDB::Txn	tid
	u_int32_t       flags
	INIT:
	    ckActive_Transaction(tid->active) ;
	    hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
	    tid->active = FALSE ;

#ifdef AT_LEAST_DB_4
#  define xx_txn_id(t) t->txn->id(t->txn)
#else
#  define xx_txn_id(t) txn_id(t->txn)
#endif
u_int32_t
xx_txn_id(tid)
	BerkeleyDB::Txn	tid

MODULE = BerkeleyDB::_tiedHash        PACKAGE = BerkeleyDB::_tiedHash

int
FIRSTKEY(db)
        BerkeleyDB::Common         db
        CODE:
        {
            DBTKEY      key ;
            DBT         value ;
	    DBC *	cursor ;

	    /*
		TODO!
		set partial value to 0 - to eliminate the retrieval of
		the value need to store any existing partial settings &
		restore at the end.

	     */
            CurrentDB = db ;
	    DBT_clear(key) ;
	    DBT_clear(value) ;
	    /* If necessary create a cursor for FIRSTKEY/NEXTKEY use */
	    if (!db->cursor &&
		(db->Status = db_cursor(db, db->txn, &cursor, 0)) == 0 )
	            db->cursor  = cursor ;

	    if (db->cursor)
	        RETVAL = (db->Status) =
		    ((db->cursor)->c_get)(db->cursor, &key, &value, DB_FIRST);
	    else
		RETVAL = db->Status ;
	    /* check for end of cursor */
	    if (RETVAL == DB_NOTFOUND) {
	      ((db->cursor)->c_close)(db->cursor) ;
	      db->cursor = NULL ;
	    }
            ST(0) = sv_newmortal();
	    OutputKey(ST(0), key)
        }



int
NEXTKEY(db, key)
        BerkeleyDB::Common  db
        DBTKEY              key = NO_INIT
        CODE:
        {
            DBT         value ;

            CurrentDB = db ;
	    DBT_clear(key) ;
	    DBT_clear(value) ;
	    key.flags = 0 ;
	    RETVAL = (db->Status) =
		((db->cursor)->c_get)(db->cursor, &key, &value, DB_NEXT);

	    /* check for end of cursor */
	    if (RETVAL == DB_NOTFOUND) {
	      ((db->cursor)->c_close)(db->cursor) ;
	      db->cursor = NULL ;
	    }
            ST(0) = sv_newmortal();
	    OutputKey(ST(0), key)
        }

MODULE = BerkeleyDB::_tiedArray        PACKAGE = BerkeleyDB::_tiedArray

I32
FETCHSIZE(db)
        BerkeleyDB::Common         db
        CODE:
            CurrentDB = db ;
            RETVAL = GetArrayLength(db) ;
        OUTPUT:
            RETVAL


MODULE = BerkeleyDB        PACKAGE = BerkeleyDB

BOOT:
  {
    SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;
    SV * version_sv = perl_get_sv("BerkeleyDB::db_version", GV_ADD|GV_ADDMULTI) ;
    SV * ver_sv = perl_get_sv("BerkeleyDB::db_ver", GV_ADD|GV_ADDMULTI) ;
    int Major, Minor, Patch ;
    (void)db_version(&Major, &Minor, &Patch) ;
    /* Check that the versions of db.h and libdb.a are the same */
    if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR
                || Patch != DB_VERSION_PATCH)
        croak("\nBerkeleyDB needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n",
                DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH,
                Major, Minor, Patch) ;

    if (Major < 2 || (Major == 2 && Minor < 6))
    {
        croak("BerkeleyDB needs Berkeley DB 2.6 or greater. This is %d.%d.%d\n",
		Major, Minor, Patch) ;
    }
    sv_setpvf(version_sv, "%d.%d", Major, Minor) ;
    sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ;
    sv_setpv(sv_err, "");

    DBT_clear(empty) ;
    empty.data  = &zero ;
    empty.size  =  sizeof(db_recno_t) ;
    empty.flags = 0 ;

  }