diff options
Diffstat (limited to 'bdb/perl.BerkeleyDB/BerkeleyDB.xs')
| -rw-r--r-- | bdb/perl.BerkeleyDB/BerkeleyDB.xs | 3927 |
1 files changed, 3927 insertions, 0 deletions
diff --git a/bdb/perl.BerkeleyDB/BerkeleyDB.xs b/bdb/perl.BerkeleyDB/BerkeleyDB.xs new file mode 100644 index 00000000000..19126c98b53 --- /dev/null +++ b/bdb/perl.BerkeleyDB/BerkeleyDB.xs @@ -0,0 +1,3927 @@ +/* + + 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-2001 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" + +/* 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__ + +#ifndef PERL_VERSION +# include "patchlevel.h" +# define PERL_REVISION 5 +# define PERL_VERSION PATCHLEVEL +# define PERL_SUBVERSION SUBVERSION +#endif + +#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 )) + +# define PL_sv_undef sv_undef +# define PL_na na +# define PL_dirty dirty + +#endif + +#include <db.h> + +#if (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 0) +# define IS_DB_3_0 +#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 + +/* need to define DEFSV & SAVE_DEFSV for older version of Perl */ +#ifndef DEFSV +# define DEFSV GvSV(defgv) +#endif + +#ifndef SAVE_DEFSV +# define SAVE_DEFSV SAVESPTR(GvSV(defgv)) +#endif + +#ifndef pTHX +# define pTHX +# define pTHX_ +# define aTHX +# define aTHX_ +#endif + +#ifndef dTHR +# define dTHR +#endif + +#ifndef newSVpvn +# define newSVpvn(a,b) newSVpv(a,b) +#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 ; + SV * 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 ; + SV * dup_compare ; + SV * prefix ; + SV * hash ; + 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 ; + 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, IV 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 + +#ifdef DBM_FILTERING +#define ckFilter(arg,type,name) \ + if (db->type) { \ + SV * save_defsv ; \ + /* printf("filtering %s\n", name) ;*/ \ + if (db->filtering) \ + softCrash("recursion detected in %s", name) ; \ + db->filtering = TRUE ; \ + save_defsv = newSVsv(DEFSV) ; \ + sv_setsv(DEFSV, arg) ; \ + PUSHMARK(sp) ; \ + (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \ + sv_setsv(arg, DEFSV) ; \ + sv_setsv(DEFSV, save_defsv) ; \ + SvREFCNT_dec(save_defsv) ; \ + db->filtering = FALSE ; \ + /*printf("end of filtering %s\n", name) ;*/ \ + } +#else +#define ckFilter(type, sv, name) +#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) SvIV(*av_fetch((AV*)SvRV(x), 0, FALSE)) +#else +#define getInnerObject(x) SvIV((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 = IoOFP(sv_2io(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 = getInnerObject(sv) ; \ + i = (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 = (t) tmp ; \ + } + +#define SetValue_ovX(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\ + IV tmp = SvIV(GetInternalObject(sv));\ + i = (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) ; \ + 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) ; \ + } \ + 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); \ + 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); \ + } \ + 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 ; +static char ErrBuff[1000] ; + +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 */ + +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; +} + +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); + I32 ret = hv_iterinit(hv) ; + int all = 0 ; + int closed = 0 ; + Trace(("BerkeleyDB::Term::close_all_txns dirty=%d\n", PL_dirty)) ; + while ( he = hv_iternext(hv) ) { + tid = * (BerkeleyDB__Txn__Raw *) (IV) hv_iterkey(he, &len) ; + Trace((" Aborting Transaction [%d] in [%d] Active [%d]\n", tid->txn, tid, tid->active)); + if (tid->active) { + txn_abort(tid->txn); + ++ 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); + I32 ret = hv_iterinit(hv) ; + int all = 0 ; + int closed = 0 ; + Trace(("BerkeleyDB::Term::close_all_cursors \n")) ; + while ( he = hv_iternext(hv) ) { + db = * (BerkeleyDB__Cursor*) (IV) 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); + I32 ret = hv_iterinit(hv) ; + int all = 0 ; + int closed = 0 ; + Trace(("BerkeleyDB::Term::close_all_dbs\n" )) ; + while ( he = hv_iternext(hv) ) { + db = * (BerkeleyDB*) (IV) 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); + I32 ret = hv_iterinit(hv) ; + int all = 0 ; + int closed = 0 ; + Trace(("BerkeleyDB::Term::close_all_envs\n")) ; + while ( he = hv_iternext(hv) ) { + env = * (BerkeleyDB__Env*) (IV) 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) ; + 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", (IV)db) ; + if (db->filename) + Safefree(db->filename) ; + Safefree(db) ; +} + +static void +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); +} + + +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 */ + +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 ; +} + +static int +btree_compare(DB_callback const DBT * key1, const DBT * key2 ) +{ + dSP ; + void * data1, * data2 ; + int retval ; + int count ; + + data1 = key1->data ; + data2 = 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 ; + return (retval) ; + +} + +static int +dup_compare(DB_callback const DBT * key1, const DBT * key2 ) +{ + dSP ; + void * data1, * data2 ; + int retval ; + int count ; + + 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 = key1->data ; + data2 = 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 ; + return (retval) ; + +} + +static size_t +btree_prefix(DB_callback const DBT * key1, const DBT * key2 ) +{ + dSP ; + void * data1, * data2 ; + int retval ; + int count ; + + data1 = key1->data ; + data2 = 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 ; + + return (retval) ; +} + +static u_int32_t +hash_cb(DB_callback const void * data, u_int32_t size) +{ + dSP ; + int retval ; + int count ; + +#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 ; + + return (retval) ; +} + +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, IV 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, IV key, IV value) +{ + HV * hv = perl_get_hv(hash, TRUE); + SV ** ret = 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 , + 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 ; + + Trace(("_db_open(dbenv[%lu] ref_dbenv [%lu] 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 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 ; + + 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 [%d] 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 + } + + if ((Status = (dbp->open)(dbp, file, subname, type, flags, mode)) == 0) { +#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\n")); + RETVAL = db ; + RETVAL->dbp = dbp ; +#if DB_VERSION_MAJOR == 2 + RETVAL->type = dbp->type ; +#else /* DB_VERSION_MAJOR > 2 */ + RETVAL->type = dbp->get_type(dbp) ; +#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", (IV)RETVAL, 1) ; + Trace((" storing %d %d 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 ; +} + +static double +constant(char * name, int arg) +{ + errno = 0; + switch (*name) { + case 'A': + break; + case 'B': + break; + case 'C': + break; + case 'D': + if (strEQ(name, "DB_AFTER")) +#ifdef DB_AFTER + return DB_AFTER; +#else + goto not_there; +#endif + if (strEQ(name, "DB_APPEND")) +#ifdef DB_APPEND + return DB_APPEND; +#else + goto not_there; +#endif + if (strEQ(name, "DB_ARCH_ABS")) +#ifdef DB_ARCH_ABS + return DB_ARCH_ABS; +#else + goto not_there; +#endif + if (strEQ(name, "DB_ARCH_DATA")) +#ifdef DB_ARCH_DATA + return DB_ARCH_DATA; +#else + goto not_there; +#endif + if (strEQ(name, "DB_ARCH_LOG")) +#ifdef DB_ARCH_LOG + return DB_ARCH_LOG; +#else + goto not_there; +#endif + if (strEQ(name, "DB_BEFORE")) +#ifdef DB_BEFORE + return DB_BEFORE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_BTREE")) + return DB_BTREE; + if (strEQ(name, "DB_BTREEMAGIC")) +#ifdef DB_BTREEMAGIC + return DB_BTREEMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_BTREEOLDVER")) +#ifdef DB_BTREEOLDVER + return DB_BTREEOLDVER; +#else + goto not_there; +#endif + if (strEQ(name, "DB_BTREEVERSION")) +#ifdef DB_BTREEVERSION + return DB_BTREEVERSION; +#else + goto not_there; +#endif + if (strEQ(name, "DB_CHECKPOINT")) +#ifdef DB_CHECKPOINT + return DB_CHECKPOINT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_CONSUME")) +#ifdef DB_CONSUME + return DB_CONSUME; +#else + goto not_there; +#endif + if (strEQ(name, "DB_CREATE")) +#ifdef DB_CREATE + return DB_CREATE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_CURLSN")) +#ifdef DB_CURLSN + return DB_CURLSN; +#else + goto not_there; +#endif + if (strEQ(name, "DB_CURRENT")) +#ifdef DB_CURRENT + return DB_CURRENT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_DBT_MALLOC")) +#ifdef DB_DBT_MALLOC + return DB_DBT_MALLOC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_DBT_PARTIAL")) +#ifdef DB_DBT_PARTIAL + return DB_DBT_PARTIAL; +#else + goto not_there; +#endif + if (strEQ(name, "DB_DBT_USERMEM")) +#ifdef DB_DBT_USERMEM + return DB_DBT_USERMEM; +#else + goto not_there; +#endif + if (strEQ(name, "DB_DELETED")) +#ifdef DB_DELETED + return DB_DELETED; +#else + goto not_there; +#endif + if (strEQ(name, "DB_DELIMITER")) +#ifdef DB_DELIMITER + return DB_DELIMITER; +#else + goto not_there; +#endif + if (strEQ(name, "DB_DUP")) +#ifdef DB_DUP + return DB_DUP; +#else + goto not_there; +#endif + if (strEQ(name, "DB_DUPSORT")) +#ifdef DB_DUPSORT + return DB_DUPSORT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_ENV_APPINIT")) +#ifdef DB_ENV_APPINIT + return DB_ENV_APPINIT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_ENV_STANDALONE")) +#ifdef DB_ENV_STANDALONE + return DB_ENV_STANDALONE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_ENV_THREAD")) +#ifdef DB_ENV_THREAD + return DB_ENV_THREAD; +#else + goto not_there; +#endif + if (strEQ(name, "DB_EXCL")) +#ifdef DB_EXCL + return DB_EXCL; +#else + goto not_there; +#endif + if (strEQ(name, "DB_FILE_ID_LEN")) +#ifdef DB_FILE_ID_LEN + return DB_FILE_ID_LEN; +#else + goto not_there; +#endif + if (strEQ(name, "DB_FIRST")) +#ifdef DB_FIRST + return DB_FIRST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_FIXEDLEN")) +#ifdef DB_FIXEDLEN + return DB_FIXEDLEN; +#else + goto not_there; +#endif + if (strEQ(name, "DB_FLUSH")) +#ifdef DB_FLUSH + return DB_FLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "DB_FORCE")) +#ifdef DB_FORCE + return DB_FORCE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_GET_BOTH")) +#ifdef DB_GET_BOTH + return DB_GET_BOTH; +#else + goto not_there; +#endif + if (strEQ(name, "DB_GET_RECNO")) +#ifdef DB_GET_RECNO + return DB_GET_RECNO; +#else + goto not_there; +#endif + if (strEQ(name, "DB_HASH")) + return DB_HASH; + if (strEQ(name, "DB_HASHMAGIC")) +#ifdef DB_HASHMAGIC + return DB_HASHMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_HASHOLDVER")) +#ifdef DB_HASHOLDVER + return DB_HASHOLDVER; +#else + goto not_there; +#endif + if (strEQ(name, "DB_HASHVERSION")) +#ifdef DB_HASHVERSION + return DB_HASHVERSION; +#else + goto not_there; +#endif + if (strEQ(name, "DB_INCOMPLETE")) +#ifdef DB_INCOMPLETE + return DB_INCOMPLETE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_INIT_CDB")) +#ifdef DB_INIT_CDB + return DB_INIT_CDB; +#else + goto not_there; +#endif + if (strEQ(name, "DB_INIT_LOCK")) +#ifdef DB_INIT_LOCK + return DB_INIT_LOCK; +#else + goto not_there; +#endif + if (strEQ(name, "DB_INIT_LOG")) +#ifdef DB_INIT_LOG + return DB_INIT_LOG; +#else + goto not_there; +#endif + if (strEQ(name, "DB_INIT_MPOOL")) +#ifdef DB_INIT_MPOOL + return DB_INIT_MPOOL; +#else + goto not_there; +#endif + if (strEQ(name, "DB_INIT_TXN")) +#ifdef DB_INIT_TXN + return DB_INIT_TXN; +#else + goto not_there; +#endif + if (strEQ(name, "DB_JOIN_ITEM")) +#ifdef DB_JOIN_ITEM + return DB_JOIN_ITEM; +#else + goto not_there; +#endif + if (strEQ(name, "DB_KEYEMPTY")) +#ifdef DB_KEYEMPTY + return DB_KEYEMPTY; +#else + goto not_there; +#endif + if (strEQ(name, "DB_KEYEXIST")) +#ifdef DB_KEYEXIST + return DB_KEYEXIST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_KEYFIRST")) +#ifdef DB_KEYFIRST + return DB_KEYFIRST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_KEYLAST")) +#ifdef DB_KEYLAST + return DB_KEYLAST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LAST")) +#ifdef DB_LAST + return DB_LAST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCKMAGIC")) +#ifdef DB_LOCKMAGIC + return DB_LOCKMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCKVERSION")) +#ifdef DB_LOCKVERSION + return DB_LOCKVERSION; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_CONFLICT")) +#ifdef DB_LOCK_CONFLICT + return DB_LOCK_CONFLICT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_DEADLOCK")) +#ifdef DB_LOCK_DEADLOCK + return DB_LOCK_DEADLOCK; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_DEFAULT")) +#ifdef DB_LOCK_DEFAULT + return DB_LOCK_DEFAULT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_GET")) + return DB_LOCK_GET; + if (strEQ(name, "DB_LOCK_NORUN")) +#ifdef DB_LOCK_NORUN + return DB_LOCK_NORUN; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_NOTGRANTED")) +#ifdef DB_LOCK_NOTGRANTED + return DB_LOCK_NOTGRANTED; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_NOTHELD")) +#ifdef DB_LOCK_NOTHELD + return DB_LOCK_NOTHELD; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_NOWAIT")) +#ifdef DB_LOCK_NOWAIT + return DB_LOCK_NOWAIT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_OLDEST")) +#ifdef DB_LOCK_OLDEST + return DB_LOCK_OLDEST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_RANDOM")) +#ifdef DB_LOCK_RANDOM + return DB_LOCK_RANDOM; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_RIW_N")) +#ifdef DB_LOCK_RIW_N + return DB_LOCK_RIW_N; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_RW_N")) +#ifdef DB_LOCK_RW_N + return DB_LOCK_RW_N; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOCK_YOUNGEST")) +#ifdef DB_LOCK_YOUNGEST + return DB_LOCK_YOUNGEST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOGMAGIC")) +#ifdef DB_LOGMAGIC + return DB_LOGMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_LOGOLDVER")) +#ifdef DB_LOGOLDVER + return DB_LOGOLDVER; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MAX_PAGES")) +#ifdef DB_MAX_PAGES + return DB_MAX_PAGES; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MAX_RECORDS")) +#ifdef DB_MAX_RECORDS + return DB_MAX_RECORDS; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MPOOL_CLEAN")) +#ifdef DB_MPOOL_CLEAN + return DB_MPOOL_CLEAN; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MPOOL_CREATE")) +#ifdef DB_MPOOL_CREATE + return DB_MPOOL_CREATE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MPOOL_DIRTY")) +#ifdef DB_MPOOL_DIRTY + return DB_MPOOL_DIRTY; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MPOOL_DISCARD")) +#ifdef DB_MPOOL_DISCARD + return DB_MPOOL_DISCARD; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MPOOL_LAST")) +#ifdef DB_MPOOL_LAST + return DB_MPOOL_LAST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MPOOL_NEW")) +#ifdef DB_MPOOL_NEW + return DB_MPOOL_NEW; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MPOOL_PRIVATE")) +#ifdef DB_MPOOL_PRIVATE + return DB_MPOOL_PRIVATE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MUTEXDEBUG")) +#ifdef DB_MUTEXDEBUG + return DB_MUTEXDEBUG; +#else + goto not_there; +#endif + if (strEQ(name, "DB_MUTEXLOCKS")) +#ifdef DB_MUTEXLOCKS + return DB_MUTEXLOCKS; +#else + goto not_there; +#endif + if (strEQ(name, "DB_NEEDSPLIT")) +#ifdef DB_NEEDSPLIT + return DB_NEEDSPLIT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_NEXT")) +#ifdef DB_NEXT + return DB_NEXT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_NEXT_DUP")) +#ifdef DB_NEXT_DUP + return DB_NEXT_DUP; +#else + goto not_there; +#endif + if (strEQ(name, "DB_NOMMAP")) +#ifdef DB_NOMMAP + return DB_NOMMAP; +#else + goto not_there; +#endif + if (strEQ(name, "DB_NOOVERWRITE")) +#ifdef DB_NOOVERWRITE + return DB_NOOVERWRITE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_NOSYNC")) +#ifdef DB_NOSYNC + return DB_NOSYNC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_NOTFOUND")) +#ifdef DB_NOTFOUND + return DB_NOTFOUND; +#else + goto not_there; +#endif + if (strEQ(name, "DB_PAD")) +#ifdef DB_PAD + return DB_PAD; +#else + goto not_there; +#endif + if (strEQ(name, "DB_PAGEYIELD")) +#ifdef DB_PAGEYIELD + return DB_PAGEYIELD; +#else + goto not_there; +#endif + if (strEQ(name, "DB_POSITION")) +#ifdef DB_POSITION + return DB_POSITION; +#else + goto not_there; +#endif + if (strEQ(name, "DB_PREV")) +#ifdef DB_PREV + return DB_PREV; +#else + goto not_there; +#endif + if (strEQ(name, "DB_PRIVATE")) +#ifdef DB_PRIVATE + return DB_PRIVATE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_QUEUE")) + return DB_QUEUE; + if (strEQ(name, "DB_RDONLY")) +#ifdef DB_RDONLY + return DB_RDONLY; +#else + goto not_there; +#endif + if (strEQ(name, "DB_RECNO")) + return DB_RECNO; + if (strEQ(name, "DB_RECNUM")) +#ifdef DB_RECNUM + return DB_RECNUM; +#else + goto not_there; +#endif + if (strEQ(name, "DB_RECORDCOUNT")) +#ifdef DB_RECORDCOUNT + return DB_RECORDCOUNT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_RECOVER")) +#ifdef DB_RECOVER + return DB_RECOVER; +#else + goto not_there; +#endif + if (strEQ(name, "DB_RECOVER_FATAL")) +#ifdef DB_RECOVER_FATAL + return DB_RECOVER_FATAL; +#else + goto not_there; +#endif + if (strEQ(name, "DB_REGISTERED")) +#ifdef DB_REGISTERED + return DB_REGISTERED; +#else + goto not_there; +#endif + if (strEQ(name, "DB_RENUMBER")) +#ifdef DB_RENUMBER + return DB_RENUMBER; +#else + goto not_there; +#endif + if (strEQ(name, "DB_RMW")) +#ifdef DB_RMW + return DB_RMW; +#else + goto not_there; +#endif + if (strEQ(name, "DB_RUNRECOVERY")) +#ifdef DB_RUNRECOVERY + return DB_RUNRECOVERY; +#else + goto not_there; +#endif + if (strEQ(name, "DB_SEQUENTIAL")) +#ifdef DB_SEQUENTIAL + return DB_SEQUENTIAL; +#else + goto not_there; +#endif + if (strEQ(name, "DB_SET")) +#ifdef DB_SET + return DB_SET; +#else + goto not_there; +#endif + if (strEQ(name, "DB_SET_RANGE")) +#ifdef DB_SET_RANGE + return DB_SET_RANGE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_SET_RECNO")) +#ifdef DB_SET_RECNO + return DB_SET_RECNO; +#else + goto not_there; +#endif + if (strEQ(name, "DB_SNAPSHOT")) +#ifdef DB_SNAPSHOT + return DB_SNAPSHOT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_SWAPBYTES")) +#ifdef DB_SWAPBYTES + return DB_SWAPBYTES; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TEMPORARY")) +#ifdef DB_TEMPORARY + return DB_TEMPORARY; +#else + goto not_there; +#endif + if (strEQ(name, "DB_THREAD")) +#ifdef DB_THREAD + return DB_THREAD; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TRUNCATE")) +#ifdef DB_TRUNCATE + return DB_TRUNCATE; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXNMAGIC")) +#ifdef DB_TXNMAGIC + return DB_TXNMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXNVERSION")) +#ifdef DB_TXNVERSION + return DB_TXNVERSION; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_BACKWARD_ROLL")) + return DB_TXN_BACKWARD_ROLL; + if (strEQ(name, "DB_TXN_CKP")) +#ifdef DB_TXN_CKP + return DB_TXN_CKP; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_FORWARD_ROLL")) + return DB_TXN_FORWARD_ROLL; + if (strEQ(name, "DB_TXN_LOCK_2PL")) +#ifdef DB_TXN_LOCK_2PL + return DB_TXN_LOCK_2PL; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_LOCK_MASK")) +#ifdef DB_TXN_LOCK_MASK + return DB_TXN_LOCK_MASK; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_LOCK_OPTIMIST")) +#ifdef DB_TXN_LOCK_OPTIMIST + return DB_TXN_LOCK_OPTIMIST; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_LOCK_OPTIMISTIC")) +#ifdef DB_TXN_LOCK_OPTIMISTIC + return DB_TXN_LOCK_OPTIMISTIC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_LOG_MASK")) +#ifdef DB_TXN_LOG_MASK + return DB_TXN_LOG_MASK; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_LOG_REDO")) +#ifdef DB_TXN_LOG_REDO + return DB_TXN_LOG_REDO; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_LOG_UNDO")) +#ifdef DB_TXN_LOG_UNDO + return DB_TXN_LOG_UNDO; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_LOG_UNDOREDO")) +#ifdef DB_TXN_LOG_UNDOREDO + return DB_TXN_LOG_UNDOREDO; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_NOSYNC")) +#ifdef DB_TXN_NOSYNC + return DB_TXN_NOSYNC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_NOWAIT")) +#ifdef DB_TXN_NOWAIT + return DB_TXN_NOWAIT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_OPENFILES")) + return DB_TXN_OPENFILES; + if (strEQ(name, "DB_TXN_REDO")) +#ifdef DB_TXN_REDO + return DB_TXN_REDO; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_SYNC")) +#ifdef DB_TXN_SYNC + return DB_TXN_SYNC; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN_UNDO")) +#ifdef DB_TXN_UNDO + return DB_TXN_UNDO; +#else + goto not_there; +#endif + if (strEQ(name, "DB_UNKNOWN")) + return DB_UNKNOWN; + if (strEQ(name, "DB_USE_ENVIRON")) +#ifdef DB_USE_ENVIRON + return DB_USE_ENVIRON; +#else + goto not_there; +#endif + if (strEQ(name, "DB_USE_ENVIRON_ROOT")) +#ifdef DB_USE_ENVIRON_ROOT + return DB_USE_ENVIRON_ROOT; +#else + goto not_there; +#endif + if (strEQ(name, "DB_VERSION_MAJOR")) +#ifdef DB_VERSION_MAJOR + return DB_VERSION_MAJOR; +#else + goto not_there; +#endif + if (strEQ(name, "DB_VERSION_MINOR")) +#ifdef DB_VERSION_MINOR + return DB_VERSION_MINOR; +#else + goto not_there; +#endif + if (strEQ(name, "DB_VERSION_PATCH")) +#ifdef DB_VERSION_PATCH + return DB_VERSION_PATCH; +#else + goto not_there; +#endif + if (strEQ(name, "DB_WRITECURSOR")) +#ifdef DB_WRITECURSOR + return DB_WRITECURSOR; +#else + goto not_there; +#endif + break; + case 'E': + break; + case 'F': + break; + case 'G': + break; + case 'H': + break; + case 'I': + break; + case 'J': + break; + case 'K': + break; + case 'L': + break; + case 'M': + break; + case 'N': + break; + case 'O': + break; + case 'P': + break; + case 'Q': + break; + case 'R': + break; + case 'S': + break; + case 'T': + break; + case 'U': + break; + case 'V': + break; + case 'W': + break; + case 'X': + break; + case 'Y': + break; + case 'Z': + break; + case 'a': + break; + case 'b': + break; + case 'c': + break; + case 'd': + break; + case 'e': + break; + case 'f': + break; + case 'g': + break; + case 'h': + break; + case 'i': + break; + case 'j': + break; + case 'k': + break; + case 'l': + break; + case 'm': + break; + case 'n': + break; + case 'o': + break; + case 'p': + break; + case 'q': + break; + case 'r': + break; + case 's': + break; + case 't': + break; + case 'u': + break; + case 'v': + break; + case 'w': + break; + case 'x': + break; + case 'y': + break; + case 'z': + break; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + + +MODULE = BerkeleyDB PACKAGE = BerkeleyDB PREFIX = env_ + +char * +DB_VERSION_STRING() + CODE: + RETVAL = DB_VERSION_STRING ; + OUTPUT: + RETVAL + + +double +constant(name,arg) + char * name + int arg + +#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 ; + 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 + +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 * server = NULL ; + char ** config = NULL ; + int flags = 0 ; + int cachesize = 0 ; + int lk_detect = 0 ; + int mode = 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_pv(server, "Server", char *) ; + SetValue_iv(cachesize, "Cachesize") ; + SetValue_iv(lk_detect, "LockDetect") ; +#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) ; + + if ((sv = readHash(hash, "ErrFile")) && sv != &PL_sv_undef) { + env->db_errfile = IoOFP(sv_2io(sv)) ; + RETVAL->ErrHandle = newRV(sv) ; + } + /* SetValue_io(RETVAL->Env.db_errfile, "ErrFile") ; */ + SetValue_iv(env->db_verbose, "Verbose") ; + /* env->db_errbuf = RETVAL->ErrBuff ; */ + 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", (IV)RETVAL, 1) ; + else { + if (RETVAL->ErrHandle) + SvREFCNT_dec(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 ; + 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_3_1 + /* 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 + if (status == 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)) ; + + if ((sv = readHash(hash, "ErrFile")) && sv != &PL_sv_undef) { + env->set_errfile(env, IoOFP(sv_2io(sv))) ; + RETVAL->ErrHandle = newRV(sv) ; + } + /* SetValue_iv(RETVAL->Env.db_verbose, "Verbose") ; */ /* TODO */ + SetValue_iv(mode, "Mode") ; + /* RETVAL->Env.db_errbuf = RETVAL->ErrBuff ; */ + env->set_errcall(env, db_errcall_cb) ; + RETVAL->active = TRUE ; +#ifdef IS_DB_3_0 + 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", (IV)RETVAL, 1) ; + else { + (env->close)(env, 0) ; + if (RETVAL->ErrHandle) + SvREFCNT_dec(RETVAL->ErrHandle) ; + if (RETVAL->ErrPrefix) + SvREFCNT_dec(RETVAL->ErrPrefix) ; + Safefree(RETVAL) ; + RETVAL = NULL ; + } +#endif /* DB_VERSION_MAJOR > 2 */ + } + OUTPUT: + RETVAL + +BerkeleyDB::Txn::Raw +_txn_begin(env, pid=NULL, flags=0) + BerkeleyDB::Env env + BerkeleyDB::Txn pid + u_int32_t flags + 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 + txn_begin(env->Env, p_id, &txn, flags) ; +#endif + if (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", (IV)RETVAL, 1) ; + } + else + RETVAL = NULL ; + } + OUTPUT: + RETVAL + + +#if DB_VERSION_MAJOR == 2 +# define env_txn_checkpoint(e,k,m) txn_checkpoint(e->Env->tx_info, k, m) +#else /* DB 3.0 or better */ +# ifdef AT_LEAST_DB_3_1 +# define env_txn_checkpoint(e,k,m) txn_checkpoint(e->Env, k, m, 0) +# else +# define env_txn_checkpoint(e,k,m) txn_checkpoint(e->Env, k, m) +# endif +#endif +DualType +env_txn_checkpoint(env, kbyte, min) + BerkeleyDB::Env env + long kbyte + long min + +HV * +txn_stat(env) + BerkeleyDB::Env env + HV * RETVAL = NULL ; + CODE: + { + DB_TXN_STAT * stat ; +#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 + 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 + 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", (IV)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) + SvREFCNT_dec(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", (IV)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", (IV)txn, 1) ; */ + 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_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_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 +#if defined(IS_DB_3_0) || defined(AT_LEAST_DB_3_2) + RETVAL = env->Status = env->Env->set_mutexlocks(env->Env, do_lock); +#else /* DB 3.1 */ + RETVAL = env->Status = db_env_set_mutexlocks(do_lock); +#endif +#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 ; + + Trace(("_db_open_hash start\n")) ; + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Filename", char *) ; + SetValue_pv(subname, "Subname", char *) ; + 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, file, subname, DB_HASH, flags, mode, &info) ; + Trace(("_db_open_hash end\n")) ; + } + OUTPUT: + RETVAL + + +HV * +db_stat(db, flags=0) + BerkeleyDB::Common db + int flags + 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 ; + db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ; + 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 + hv_store_iv(RETVAL, "hash_nelem", stat->hash_nelem); + 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 ; + static char * Names[] = {"", "Btree", "Hash", "Recno"} ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Filename", char *) ; + SetValue_pv(subname, "Subname", char *) ; + 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, file, subname, DB_UNKNOWN, flags, mode, &info) ; + XPUSHs(sv_2mortal(newSViv((IV)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 ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Filename", char*) ; + SetValue_pv(subname, "Subname", char *) ; + 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) { + 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 + 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) { + info.bt_prefix = btree_prefix ; + db->prefix = newSVsv(sv) ; + } + + RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, file, subname, DB_BTREE, flags, mode, &info) ; + } + OUTPUT: + RETVAL + + +HV * +db_stat(db, flags=0) + BerkeleyDB::Common db + int flags + HV * RETVAL = NULL ; + INIT: + ckActive_Database(db->active) ; + CODE: + { + DB_BTREE_STAT * stat ; + db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ; + 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 ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Fname", char*) ; + 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") ; + 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, 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 ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Fname", char*) ; + 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.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_PAD) ; + } + 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, file, subname, DB_QUEUE, flags, mode, &info) ; +#endif + } + OUTPUT: + RETVAL + +HV * +db_stat(db, flags=0) + BerkeleyDB::Common db + int flags + 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 ; + db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ; + 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) + BerkeleyDB::Common db + int flags + 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", (IV)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) + BerkeleyDB::Common db + u_int32_t flags + 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->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 ; + 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", (IV)RETVAL, 1) ; + } + } + OUTPUT: + RETVAL + +BerkeleyDB::Cursor::Raw +_db_join(db, cursors, flags=0) + BerkeleyDB::Common db + AV * cursors + u_int32_t flags + 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) ; + BerkeleyDB__Cursor cur = (BerkeleyDB__Cursor) getInnerObject(obj) ; + 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 ; + 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", (IV)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 + RETVAL = db->dbp->get_byteswapped(db->dbp) ; +#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: + setFilter(filter_fetch_key) ; + +SV * +filter_store_key(db, code) + BerkeleyDB::Common db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_store_key) ; + +SV * +filter_fetch_value(db, code) + BerkeleyDB::Common db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_fetch_value) ; + +SV * +filter_store_value(db, code) + BerkeleyDB::Common db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_store_value) ; + +#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) + BerkeleyDB::Common db + DBTKEY key + u_int flags + INIT: + ckActive_Database(db->active) ; + CurrentDB = db ; + + +#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) + BerkeleyDB::Common db + u_int flags + DBTKEY_B key + DBT_OPT data + INIT: + ckActive_Database(db->active) ; + CurrentDB = db ; + SetPartial(data,db) ; + OUTPUT: + key if (flagSet(DB_SET_RECNO)) OutputValue(ST(1), key) ; + 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) + BerkeleyDB::Common db + DBTKEY key + DBT data + u_int flags + INIT: + ckActive_Database(db->active) ; + CurrentDB = db ; + /* SetPartial(data,db) ; */ + OUTPUT: + 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) + BerkeleyDB::Common db + DBTKEY_B key + double less = NO_INIT + double equal = NO_INIT + double greater = NO_INIT + u_int32_t flags + 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) + BerkeleyDB::Common db + u_int flags + 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(%d in %d) active [%d]\n", txn->txn, txn, txn->active)); + ckActive_Transaction(txn->active) ; + db->txn = txn->txn ; + } + else { + Trace(("_Txn(undef) \n")); + db->txn = NULL ; + } + + + + +MODULE = BerkeleyDB::Cursor PACKAGE = BerkeleyDB::Cursor PREFIX = cu_ + +BerkeleyDB::Cursor::Raw +_c_dup(db, flags=0) + BerkeleyDB::Cursor db + u_int32_t flags + 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 ; + 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", (IV)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", (IV)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", (IV)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) + BerkeleyDB::Cursor db + int flags + 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) + BerkeleyDB::Cursor db + int flags + DBTKEY_B key + DBT_B data + INIT: + Trace(("c_get db [%d] flags [%d]\n", 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_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) + BerkeleyDB::Cursor db + DBTKEY key + DBT data + int flags + 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) + BerkeleyDB::Cursor db + u_int32_t count = NO_INIT + int flags + 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) + BerkeleyDB::TxnMgr txnmgr + BerkeleyDB::Txn pid + u_int32_t flags + 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 + txn_begin(txnmgr->env->Env, p_id, &txn, flags) ; +#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", (IV)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) txn_checkpoint(t->env->Env->tx_info, k, m) +#else +# ifdef AT_LEAST_DB_3_1 +# define xx_txn_checkpoint(t,k,m) txn_checkpoint(t->env->Env, k, m, 0) +# else +# define xx_txn_checkpoint(t,k,m) txn_checkpoint(t->env->Env, k, m) +# endif +#endif +DualType +xx_txn_checkpoint(txnp, kbyte, min) + BerkeleyDB::TxnMgr txnp + long kbyte + long min + +HV * +txn_stat(txnp) + BerkeleyDB::TxnMgr txnp + HV * RETVAL = NULL ; + CODE: + { + DB_TXN_STAT * stat ; +#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 + 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) + const char * dir + int flags + 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) + txn_abort(tid->txn) ; + RETVAL = (int)tid ; + hash_delete("BerkeleyDB::Term::Txn", (IV)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 + +#define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn)) +DualType +xx_txn_prepare(tid) + BerkeleyDB::Txn tid + INIT: + ckActive_Transaction(tid->active) ; + +#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 +DualType +_txn_commit(tid, flags=0) + BerkeleyDB::Txn tid + u_int32_t flags + INIT: + ckActive_Transaction(tid->active) ; + hash_delete("BerkeleyDB::Term::Txn", (IV)tid) ; + tid->active = FALSE ; + +#define _txn_abort(t) (t->Status = txn_abort(t->txn)) +DualType +_txn_abort(tid) + BerkeleyDB::Txn tid + INIT: + ckActive_Transaction(tid->active) ; + hash_delete("BerkeleyDB::Term::Txn", (IV)tid) ; + tid->active = FALSE ; + +#define xx_txn_id(t) txn_id(t->txn) +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 + CODE: + { + DBT value ; + + CurrentDB = db ; + 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 ; + + } + |