berkeleydb.xs

File system using stacked.

    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){