berkeleydb.xs

BerkeleyDB源码

    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(getCurrentDB->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(getCurrentDB->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 ;
    /* char *sk_dat ; */
    int retval ;
    int count ;
    SV * skey_SV ;
    STRLEN skey_len;
    char * skey_ptr ;

    Trace(("In associate_cb \n")) ;
    if (getCurrentDB->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(getCurrentDB->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_ptr = SvPV(skey_SV, skey_len);
    skey->flags = DB_DBT_APPMALLOC;
    /* skey->size = SvCUR(skey_SV); */
    /* skey->data = (char*)safemalloc(skey->size); */
    skey->size = skey_len;
    skey->data = (char*)safemalloc(skey_len);
    memcpy(skey->data, skey_ptr, skey_len);
    Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));

    FREETMPS ;
    LEAVE ;

    return (retval) ;
}

#endif /* AT_LEAST_DB_3_3 */

static void
#ifdef AT_LEAST_DB_4_3
db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
#else
db_errcall_cb(const char * db_errpfx, char * buffer)
#endif
{
#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,
		char *		password,
		int		enc_flags
	)
{
    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

#ifndef AT_LEAST_DB_4_1
	    if (password)
	        softCrash("-Encrypt needs Berkeley DB 4.x or better") ;
#endif /* ! AT_LEAST_DB_4_1 */

#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_2
	dbp->BackRef = db;
#endif

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

#ifdef AT_LEAST_DB_4_1
    /* set encryption */
    if (password)
    {
        Status = dbp->set_encrypt(dbp, password, enc_flags);
        Trace(("DB->set_encrypt passwd = %s, flags %d returned %s\n", 
			      		password, enc_flags,
  					my_db_strerror(Status))) ;
         if (Status)
              return RETVAL ;
    }
#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_q_extentsize [%d] returned %s\n",
		info->q_extentsize, my_db_strerror(Status)));
        if (Status)
            return RETVAL ;
#else
        softCrash("-ExtentSize needs at least Berkeley DB 3.2.x") ;
#endif
    }

    /* In-memory database need DB_CREATE from 4.4 */
    if (! file)
        flags |= DB_CREATE;


#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"));
	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->primary_recno_or_queue = FALSE;
    	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->cds_enabled = dbenv->cds_enabled ;
	    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